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)
783 write (iout,*) "gloc_sc before reduce"
786 write (iout,*) i,j,gloc_sc(j,i,icg)
792 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
796 call MPI_Barrier(FG_COMM,IERR)
797 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
799 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
800 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
801 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
802 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
803 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
804 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
805 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
806 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
807 time_reduce=time_reduce+MPI_Wtime()-time00
809 write (iout,*) "gloc_sc after reduce"
812 write (iout,*) i,j,gloc_sc(j,i,icg)
817 write (iout,*) "gloc after reduce"
819 write (iout,*) i,gloc(i,icg)
824 if (gnorm_check) then
826 c Compute the maximum elements of the gradient
836 gcorr3_turn_max=0.0d0
837 gcorr4_turn_max=0.0d0
840 gcorr6_turn_max=0.0d0
850 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
851 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
853 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
854 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
856 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
857 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
858 & gvdwc_scp_max=gvdwc_scp_norm
859 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
860 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
861 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
862 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
863 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
864 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
865 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
866 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
867 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
868 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
869 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
870 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
871 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
873 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
874 & gcorr3_turn_max=gcorr3_turn_norm
875 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
877 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
878 & gcorr4_turn_max=gcorr4_turn_norm
879 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
880 if (gradcorr5_norm.gt.gradcorr5_max)
881 & gradcorr5_max=gradcorr5_norm
882 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
883 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
884 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
886 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
887 & gcorr6_turn_max=gcorr6_turn_norm
888 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
889 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
890 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
891 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
892 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
893 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
895 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
896 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
898 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
899 if (gradx_scp_norm.gt.gradx_scp_max)
900 & gradx_scp_max=gradx_scp_norm
901 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
902 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
903 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
904 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
905 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
906 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
907 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
908 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
912 open(istat,file=statname,position="append")
914 open(istat,file=statname,access="append")
916 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
917 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
918 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
919 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
920 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
921 & gsccorx_max,gsclocx_max
923 if (gvdwc_max.gt.1.0d4) then
924 write (iout,*) "gvdwc gvdwx gradb gradbx"
926 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
927 & gradb(j,i),gradbx(j,i),j=1,3)
929 call pdbout(0.0d0,'cipiszcze',iout)
935 write (iout,*) "gradc gradx gloc"
937 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
938 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
943 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
945 time_sumgradient=time_sumgradient+tcpu()-time01
950 c-------------------------------------------------------------------------------
951 subroutine rescale_weights(t_bath)
952 implicit real*8 (a-h,o-z)
954 include 'COMMON.IOUNITS'
955 include 'COMMON.FFIELD'
956 include 'COMMON.SBRIDGE'
957 double precision kfac /2.4d0/
958 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
960 c facT=2*temp0/(t_bath+temp0)
961 if (rescale_mode.eq.0) then
967 else if (rescale_mode.eq.1) then
968 facT=kfac/(kfac-1.0d0+t_bath/temp0)
969 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
970 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
971 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
972 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
973 else if (rescale_mode.eq.2) then
979 facT=licznik/dlog(dexp(x)+dexp(-x))
980 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
981 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
982 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
983 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
985 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
986 write (*,*) "Wrong RESCALE_MODE",rescale_mode
988 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
992 welec=weights(3)*fact
993 wcorr=weights(4)*fact3
994 wcorr5=weights(5)*fact4
995 wcorr6=weights(6)*fact5
996 wel_loc=weights(7)*fact2
997 wturn3=weights(8)*fact2
998 wturn4=weights(9)*fact3
999 wturn6=weights(10)*fact5
1000 wtor=weights(13)*fact
1001 wtor_d=weights(14)*fact2
1002 wsccor=weights(21)*fact
1005 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1009 C------------------------------------------------------------------------
1010 subroutine enerprint(energia)
1011 implicit real*8 (a-h,o-z)
1012 include 'DIMENSIONS'
1013 include 'COMMON.IOUNITS'
1014 include 'COMMON.FFIELD'
1015 include 'COMMON.SBRIDGE'
1017 double precision energia(0:n_ene)
1020 evdw=energia(22)+wsct*energia(23)
1026 evdw2=energia(2)+energia(18)
1038 eello_turn3=energia(8)
1039 eello_turn4=energia(9)
1040 eello_turn6=energia(10)
1046 edihcnstr=energia(19)
1051 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1052 & estr,wbond,ebe,wang,
1053 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1055 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1056 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1057 & edihcnstr,ebr*nss,
1059 10 format (/'Virtual-chain energies:'//
1060 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1061 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1062 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1063 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1064 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1065 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1066 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1067 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1068 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1069 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1070 & ' (SS bridges & dist. cnstr.)'/
1071 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1072 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1073 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1074 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1075 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1076 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1077 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1078 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1079 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1080 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1081 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1082 & 'ETOT= ',1pE16.6,' (total)')
1084 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1085 & estr,wbond,ebe,wang,
1086 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1088 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1089 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1090 & ebr*nss,Uconst,etot
1091 10 format (/'Virtual-chain energies:'//
1092 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1093 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1094 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1095 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1096 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1097 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1098 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1099 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1100 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1101 & ' (SS bridges & dist. cnstr.)'/
1102 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1103 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1104 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1105 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1106 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1107 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1108 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1109 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1110 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1111 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1112 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1113 & 'ETOT= ',1pE16.6,' (total)')
1117 C-----------------------------------------------------------------------
1118 subroutine elj(evdw,evdw_p,evdw_m)
1120 C This subroutine calculates the interaction energy of nonbonded side chains
1121 C assuming the LJ potential of interaction.
1123 implicit real*8 (a-h,o-z)
1124 include 'DIMENSIONS'
1125 parameter (accur=1.0d-10)
1126 include 'COMMON.GEO'
1127 include 'COMMON.VAR'
1128 include 'COMMON.LOCAL'
1129 include 'COMMON.CHAIN'
1130 include 'COMMON.DERIV'
1131 include 'COMMON.INTERACT'
1132 include 'COMMON.TORSION'
1133 include 'COMMON.SBRIDGE'
1134 include 'COMMON.NAMES'
1135 include 'COMMON.IOUNITS'
1136 include 'COMMON.CONTACTS'
1138 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1140 do i=iatsc_s,iatsc_e
1149 C Calculate SC interaction energy.
1151 do iint=1,nint_gr(i)
1152 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1153 cd & 'iend=',iend(i,iint)
1154 do j=istart(i,iint),iend(i,iint)
1159 C Change 12/1/95 to calculate four-body interactions
1160 rij=xj*xj+yj*yj+zj*zj
1162 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1163 eps0ij=eps(itypi,itypj)
1165 e1=fac*fac*aa(itypi,itypj)
1166 e2=fac*bb(itypi,itypj)
1168 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1169 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1170 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1171 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1172 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1173 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1175 if (bb(itypi,itypj).gt.0) then
1176 evdw_p=evdw_p+evdwij
1178 evdw_m=evdw_m+evdwij
1184 C Calculate the components of the gradient in DC and X
1186 fac=-rrij*(e1+evdwij)
1191 if (bb(itypi,itypj).gt.0.0d0) then
1193 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1194 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1195 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1196 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1200 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1201 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1202 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1203 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1208 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1209 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1210 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1211 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1216 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1220 C 12/1/95, revised on 5/20/97
1222 C Calculate the contact function. The ith column of the array JCONT will
1223 C contain the numbers of atoms that make contacts with the atom I (of numbers
1224 C greater than I). The arrays FACONT and GACONT will contain the values of
1225 C the contact function and its derivative.
1227 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1228 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1229 C Uncomment next line, if the correlation interactions are contact function only
1230 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1232 sigij=sigma(itypi,itypj)
1233 r0ij=rs0(itypi,itypj)
1235 C Check whether the SC's are not too far to make a contact.
1238 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1239 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1241 if (fcont.gt.0.0D0) then
1242 C If the SC-SC distance if close to sigma, apply spline.
1243 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1244 cAdam & fcont1,fprimcont1)
1245 cAdam fcont1=1.0d0-fcont1
1246 cAdam if (fcont1.gt.0.0d0) then
1247 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1248 cAdam fcont=fcont*fcont1
1250 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1251 cga eps0ij=1.0d0/dsqrt(eps0ij)
1253 cga gg(k)=gg(k)*eps0ij
1255 cga eps0ij=-evdwij*eps0ij
1256 C Uncomment for AL's type of SC correlation interactions.
1257 cadam eps0ij=-evdwij
1258 num_conti=num_conti+1
1259 jcont(num_conti,i)=j
1260 facont(num_conti,i)=fcont*eps0ij
1261 fprimcont=eps0ij*fprimcont/rij
1263 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1264 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1265 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1266 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1267 gacont(1,num_conti,i)=-fprimcont*xj
1268 gacont(2,num_conti,i)=-fprimcont*yj
1269 gacont(3,num_conti,i)=-fprimcont*zj
1270 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1271 cd write (iout,'(2i3,3f10.5)')
1272 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1278 num_cont(i)=num_conti
1282 gvdwc(j,i)=expon*gvdwc(j,i)
1283 gvdwx(j,i)=expon*gvdwx(j,i)
1286 C******************************************************************************
1290 C To save time, the factor of EXPON has been extracted from ALL components
1291 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1294 C******************************************************************************
1297 C-----------------------------------------------------------------------------
1298 subroutine eljk(evdw,evdw_p,evdw_m)
1300 C This subroutine calculates the interaction energy of nonbonded side chains
1301 C assuming the LJK potential of interaction.
1303 implicit real*8 (a-h,o-z)
1304 include 'DIMENSIONS'
1305 include 'COMMON.GEO'
1306 include 'COMMON.VAR'
1307 include 'COMMON.LOCAL'
1308 include 'COMMON.CHAIN'
1309 include 'COMMON.DERIV'
1310 include 'COMMON.INTERACT'
1311 include 'COMMON.IOUNITS'
1312 include 'COMMON.NAMES'
1315 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1317 do i=iatsc_s,iatsc_e
1324 C Calculate SC interaction energy.
1326 do iint=1,nint_gr(i)
1327 do j=istart(i,iint),iend(i,iint)
1332 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1333 fac_augm=rrij**expon
1334 e_augm=augm(itypi,itypj)*fac_augm
1335 r_inv_ij=dsqrt(rrij)
1337 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1338 fac=r_shift_inv**expon
1339 e1=fac*fac*aa(itypi,itypj)
1340 e2=fac*bb(itypi,itypj)
1342 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1343 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1344 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1345 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1346 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1347 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1348 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1350 if (bb(itypi,itypj).gt.0) then
1351 evdw_p=evdw_p+evdwij
1353 evdw_m=evdw_m+evdwij
1359 C Calculate the components of the gradient in DC and X
1361 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1366 if (bb(itypi,itypj).gt.0.0d0) then
1368 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1369 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1370 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1371 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1375 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1376 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1377 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1378 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1383 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1384 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1385 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1386 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1391 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1399 gvdwc(j,i)=expon*gvdwc(j,i)
1400 gvdwx(j,i)=expon*gvdwx(j,i)
1405 C-----------------------------------------------------------------------------
1406 subroutine ebp(evdw,evdw_p,evdw_m)
1408 C This subroutine calculates the interaction energy of nonbonded side chains
1409 C assuming the Berne-Pechukas potential of interaction.
1411 implicit real*8 (a-h,o-z)
1412 include 'DIMENSIONS'
1413 include 'COMMON.GEO'
1414 include 'COMMON.VAR'
1415 include 'COMMON.LOCAL'
1416 include 'COMMON.CHAIN'
1417 include 'COMMON.DERIV'
1418 include 'COMMON.NAMES'
1419 include 'COMMON.INTERACT'
1420 include 'COMMON.IOUNITS'
1421 include 'COMMON.CALC'
1422 common /srutu/ icall
1423 c double precision rrsave(maxdim)
1426 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1428 c if (icall.eq.0) then
1434 do i=iatsc_s,iatsc_e
1440 dxi=dc_norm(1,nres+i)
1441 dyi=dc_norm(2,nres+i)
1442 dzi=dc_norm(3,nres+i)
1443 c dsci_inv=dsc_inv(itypi)
1444 dsci_inv=vbld_inv(i+nres)
1446 C Calculate SC interaction energy.
1448 do iint=1,nint_gr(i)
1449 do j=istart(i,iint),iend(i,iint)
1452 c dscj_inv=dsc_inv(itypj)
1453 dscj_inv=vbld_inv(j+nres)
1454 chi1=chi(itypi,itypj)
1455 chi2=chi(itypj,itypi)
1462 alf12=0.5D0*(alf1+alf2)
1463 C For diagnostics only!!!
1476 dxj=dc_norm(1,nres+j)
1477 dyj=dc_norm(2,nres+j)
1478 dzj=dc_norm(3,nres+j)
1479 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1480 cd if (icall.eq.0) then
1486 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1488 C Calculate whole angle-dependent part of epsilon and contributions
1489 C to its derivatives
1490 fac=(rrij*sigsq)**expon2
1491 e1=fac*fac*aa(itypi,itypj)
1492 e2=fac*bb(itypi,itypj)
1493 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1494 eps2der=evdwij*eps3rt
1495 eps3der=evdwij*eps2rt
1496 evdwij=evdwij*eps2rt*eps3rt
1498 if (bb(itypi,itypj).gt.0) then
1499 evdw_p=evdw_p+evdwij
1501 evdw_m=evdw_m+evdwij
1507 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1508 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1509 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1510 cd & restyp(itypi),i,restyp(itypj),j,
1511 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1512 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1513 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1516 C Calculate gradient components.
1517 e1=e1*eps1*eps2rt**2*eps3rt**2
1518 fac=-expon*(e1+evdwij)
1521 C Calculate radial part of the gradient
1525 C Calculate the angular part of the gradient and sum add the contributions
1526 C to the appropriate components of the Cartesian gradient.
1528 if (bb(itypi,itypj).gt.0) then
1542 C-----------------------------------------------------------------------------
1543 subroutine egb(evdw,evdw_p,evdw_m)
1545 C This subroutine calculates the interaction energy of nonbonded side chains
1546 C assuming the Gay-Berne potential of interaction.
1548 implicit real*8 (a-h,o-z)
1549 include 'DIMENSIONS'
1550 include 'COMMON.GEO'
1551 include 'COMMON.VAR'
1552 include 'COMMON.LOCAL'
1553 include 'COMMON.CHAIN'
1554 include 'COMMON.DERIV'
1555 include 'COMMON.NAMES'
1556 include 'COMMON.INTERACT'
1557 include 'COMMON.IOUNITS'
1558 include 'COMMON.CALC'
1559 include 'COMMON.CONTROL'
1560 include 'COMMON.SBRIDGE'
1563 ccccc energy_dec=.false.
1564 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1569 c if (icall.eq.0) lprn=.false.
1571 do i=iatsc_s,iatsc_e
1577 dxi=dc_norm(1,nres+i)
1578 dyi=dc_norm(2,nres+i)
1579 dzi=dc_norm(3,nres+i)
1580 c dsci_inv=dsc_inv(itypi)
1581 dsci_inv=vbld_inv(i+nres)
1582 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1583 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1585 C Calculate SC interaction energy.
1587 do iint=1,nint_gr(i)
1588 do j=istart(i,iint),iend(i,iint)
1589 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1590 call dyn_ssbond_ene(i,j,evdwij)
1595 c dscj_inv=dsc_inv(itypj)
1596 dscj_inv=vbld_inv(j+nres)
1597 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1598 c & 1.0d0/vbld(j+nres)
1599 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1600 sig0ij=sigma(itypi,itypj)
1601 chi1=chi(itypi,itypj)
1602 chi2=chi(itypj,itypi)
1609 alf12=0.5D0*(alf1+alf2)
1610 C For diagnostics only!!!
1623 dxj=dc_norm(1,nres+j)
1624 dyj=dc_norm(2,nres+j)
1625 dzj=dc_norm(3,nres+j)
1626 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1627 c write (iout,*) "j",j," dc_norm",
1628 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1629 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1631 C Calculate angle-dependent terms of energy and contributions to their
1635 sig=sig0ij*dsqrt(sigsq)
1636 rij_shift=1.0D0/rij-sig+sig0ij
1637 c for diagnostics; uncomment
1638 c rij_shift=1.2*sig0ij
1639 C I hate to put IF's in the loops, but here don't have another choice!!!!
1640 if (rij_shift.le.0.0D0) then
1642 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1643 cd & restyp(itypi),i,restyp(itypj),j,
1644 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1648 c---------------------------------------------------------------
1649 rij_shift=1.0D0/rij_shift
1650 fac=rij_shift**expon
1651 e1=fac*fac*aa(itypi,itypj)
1652 e2=fac*bb(itypi,itypj)
1653 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1654 eps2der=evdwij*eps3rt
1655 eps3der=evdwij*eps2rt
1656 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1657 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1658 evdwij=evdwij*eps2rt*eps3rt
1660 if (bb(itypi,itypj).gt.0) then
1661 evdw_p=evdw_p+evdwij
1663 evdw_m=evdw_m+evdwij
1669 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1670 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1671 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1672 & restyp(itypi),i,restyp(itypj),j,
1673 & epsi,sigm,chi1,chi2,chip1,chip2,
1674 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1675 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1679 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1682 C Calculate gradient components.
1683 e1=e1*eps1*eps2rt**2*eps3rt**2
1684 fac=-expon*(e1+evdwij)*rij_shift
1688 C Calculate the radial part of the gradient
1692 C Calculate angular part of the gradient.
1694 if (bb(itypi,itypj).gt.0) then
1706 c write (iout,*) "Number of loop steps in EGB:",ind
1707 cccc energy_dec=.false.
1710 C-----------------------------------------------------------------------------
1711 subroutine egbv(evdw,evdw_p,evdw_m)
1713 C This subroutine calculates the interaction energy of nonbonded side chains
1714 C assuming the Gay-Berne-Vorobjev potential of interaction.
1716 implicit real*8 (a-h,o-z)
1717 include 'DIMENSIONS'
1718 include 'COMMON.GEO'
1719 include 'COMMON.VAR'
1720 include 'COMMON.LOCAL'
1721 include 'COMMON.CHAIN'
1722 include 'COMMON.DERIV'
1723 include 'COMMON.NAMES'
1724 include 'COMMON.INTERACT'
1725 include 'COMMON.IOUNITS'
1726 include 'COMMON.CALC'
1727 common /srutu/ icall
1730 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1733 c if (icall.eq.0) lprn=.true.
1735 do i=iatsc_s,iatsc_e
1741 dxi=dc_norm(1,nres+i)
1742 dyi=dc_norm(2,nres+i)
1743 dzi=dc_norm(3,nres+i)
1744 c dsci_inv=dsc_inv(itypi)
1745 dsci_inv=vbld_inv(i+nres)
1747 C Calculate SC interaction energy.
1749 do iint=1,nint_gr(i)
1750 do j=istart(i,iint),iend(i,iint)
1753 c dscj_inv=dsc_inv(itypj)
1754 dscj_inv=vbld_inv(j+nres)
1755 sig0ij=sigma(itypi,itypj)
1756 r0ij=r0(itypi,itypj)
1757 chi1=chi(itypi,itypj)
1758 chi2=chi(itypj,itypi)
1765 alf12=0.5D0*(alf1+alf2)
1766 C For diagnostics only!!!
1779 dxj=dc_norm(1,nres+j)
1780 dyj=dc_norm(2,nres+j)
1781 dzj=dc_norm(3,nres+j)
1782 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1784 C Calculate angle-dependent terms of energy and contributions to their
1788 sig=sig0ij*dsqrt(sigsq)
1789 rij_shift=1.0D0/rij-sig+r0ij
1790 C I hate to put IF's in the loops, but here don't have another choice!!!!
1791 if (rij_shift.le.0.0D0) then
1796 c---------------------------------------------------------------
1797 rij_shift=1.0D0/rij_shift
1798 fac=rij_shift**expon
1799 e1=fac*fac*aa(itypi,itypj)
1800 e2=fac*bb(itypi,itypj)
1801 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1802 eps2der=evdwij*eps3rt
1803 eps3der=evdwij*eps2rt
1804 fac_augm=rrij**expon
1805 e_augm=augm(itypi,itypj)*fac_augm
1806 evdwij=evdwij*eps2rt*eps3rt
1808 if (bb(itypi,itypj).gt.0) then
1809 evdw_p=evdw_p+evdwij+e_augm
1811 evdw_m=evdw_m+evdwij+e_augm
1814 evdw=evdw+evdwij+e_augm
1817 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1818 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1819 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1820 & restyp(itypi),i,restyp(itypj),j,
1821 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1822 & chi1,chi2,chip1,chip2,
1823 & eps1,eps2rt**2,eps3rt**2,
1824 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1827 C Calculate gradient components.
1828 e1=e1*eps1*eps2rt**2*eps3rt**2
1829 fac=-expon*(e1+evdwij)*rij_shift
1831 fac=rij*fac-2*expon*rrij*e_augm
1832 C Calculate the radial part of the gradient
1836 C Calculate angular part of the gradient.
1838 if (bb(itypi,itypj).gt.0) then
1850 C-----------------------------------------------------------------------------
1851 subroutine sc_angular
1852 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1853 C om12. Called by ebp, egb, and egbv.
1855 include 'COMMON.CALC'
1856 include 'COMMON.IOUNITS'
1860 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1861 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1862 om12=dxi*dxj+dyi*dyj+dzi*dzj
1864 C Calculate eps1(om12) and its derivative in om12
1865 faceps1=1.0D0-om12*chiom12
1866 faceps1_inv=1.0D0/faceps1
1867 eps1=dsqrt(faceps1_inv)
1868 C Following variable is eps1*deps1/dom12
1869 eps1_om12=faceps1_inv*chiom12
1874 c write (iout,*) "om12",om12," eps1",eps1
1875 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1880 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1881 sigsq=1.0D0-facsig*faceps1_inv
1882 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1883 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1884 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1890 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1891 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1893 C Calculate eps2 and its derivatives in om1, om2, and om12.
1896 chipom12=chip12*om12
1897 facp=1.0D0-om12*chipom12
1899 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1900 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1901 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1902 C Following variable is the square root of eps2
1903 eps2rt=1.0D0-facp1*facp_inv
1904 C Following three variables are the derivatives of the square root of eps
1905 C in om1, om2, and om12.
1906 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1907 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1908 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1909 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1910 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1911 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1912 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1913 c & " eps2rt_om12",eps2rt_om12
1914 C Calculate whole angle-dependent part of epsilon and contributions
1915 C to its derivatives
1919 C----------------------------------------------------------------------------
1920 subroutine sc_grad_T
1921 implicit real*8 (a-h,o-z)
1922 include 'DIMENSIONS'
1923 include 'COMMON.CHAIN'
1924 include 'COMMON.DERIV'
1925 include 'COMMON.CALC'
1926 include 'COMMON.IOUNITS'
1927 double precision dcosom1(3),dcosom2(3)
1928 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1929 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1930 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1931 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1935 c eom12=evdwij*eps1_om12
1937 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1938 c & " sigder",sigder
1939 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1940 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1942 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1943 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1946 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1948 c write (iout,*) "gg",(gg(k),k=1,3)
1950 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1951 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1952 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1953 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1954 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1955 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1956 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1957 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1958 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1959 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1962 C Calculate the components of the gradient in DC and X
1966 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1970 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1971 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1976 C----------------------------------------------------------------------------
1978 implicit real*8 (a-h,o-z)
1979 include 'DIMENSIONS'
1980 include 'COMMON.CHAIN'
1981 include 'COMMON.DERIV'
1982 include 'COMMON.CALC'
1983 include 'COMMON.IOUNITS'
1984 double precision dcosom1(3),dcosom2(3)
1985 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1986 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1987 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1988 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1992 c eom12=evdwij*eps1_om12
1994 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1995 c & " sigder",sigder
1996 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1997 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1999 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2000 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2003 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2005 c write (iout,*) "gg",(gg(k),k=1,3)
2007 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2008 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2009 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2010 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2011 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2012 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2013 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2014 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2015 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2016 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2019 C Calculate the components of the gradient in DC and X
2023 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2027 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2028 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2032 C-----------------------------------------------------------------------
2033 subroutine e_softsphere(evdw)
2035 C This subroutine calculates the interaction energy of nonbonded side chains
2036 C assuming the LJ potential of interaction.
2038 implicit real*8 (a-h,o-z)
2039 include 'DIMENSIONS'
2040 parameter (accur=1.0d-10)
2041 include 'COMMON.GEO'
2042 include 'COMMON.VAR'
2043 include 'COMMON.LOCAL'
2044 include 'COMMON.CHAIN'
2045 include 'COMMON.DERIV'
2046 include 'COMMON.INTERACT'
2047 include 'COMMON.TORSION'
2048 include 'COMMON.SBRIDGE'
2049 include 'COMMON.NAMES'
2050 include 'COMMON.IOUNITS'
2051 include 'COMMON.CONTACTS'
2053 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2055 do i=iatsc_s,iatsc_e
2062 C Calculate SC interaction energy.
2064 do iint=1,nint_gr(i)
2065 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2066 cd & 'iend=',iend(i,iint)
2067 do j=istart(i,iint),iend(i,iint)
2072 rij=xj*xj+yj*yj+zj*zj
2073 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2074 r0ij=r0(itypi,itypj)
2076 c print *,i,j,r0ij,dsqrt(rij)
2077 if (rij.lt.r0ijsq) then
2078 evdwij=0.25d0*(rij-r0ijsq)**2
2086 C Calculate the components of the gradient in DC and X
2092 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2093 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2094 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2095 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2099 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2107 C--------------------------------------------------------------------------
2108 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2111 C Soft-sphere potential of p-p interaction
2113 implicit real*8 (a-h,o-z)
2114 include 'DIMENSIONS'
2115 include 'COMMON.CONTROL'
2116 include 'COMMON.IOUNITS'
2117 include 'COMMON.GEO'
2118 include 'COMMON.VAR'
2119 include 'COMMON.LOCAL'
2120 include 'COMMON.CHAIN'
2121 include 'COMMON.DERIV'
2122 include 'COMMON.INTERACT'
2123 include 'COMMON.CONTACTS'
2124 include 'COMMON.TORSION'
2125 include 'COMMON.VECTORS'
2126 include 'COMMON.FFIELD'
2128 cd write(iout,*) 'In EELEC_soft_sphere'
2135 do i=iatel_s,iatel_e
2139 xmedi=c(1,i)+0.5d0*dxi
2140 ymedi=c(2,i)+0.5d0*dyi
2141 zmedi=c(3,i)+0.5d0*dzi
2143 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2144 do j=ielstart(i),ielend(i)
2148 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2149 r0ij=rpp(iteli,itelj)
2154 xj=c(1,j)+0.5D0*dxj-xmedi
2155 yj=c(2,j)+0.5D0*dyj-ymedi
2156 zj=c(3,j)+0.5D0*dzj-zmedi
2157 rij=xj*xj+yj*yj+zj*zj
2158 if (rij.lt.r0ijsq) then
2159 evdw1ij=0.25d0*(rij-r0ijsq)**2
2167 C Calculate contributions to the Cartesian gradient.
2173 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2174 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2177 * Loop over residues i+1 thru j-1.
2181 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2186 cgrad do i=nnt,nct-1
2188 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2190 cgrad do j=i+1,nct-1
2192 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2198 c------------------------------------------------------------------------------
2199 subroutine vec_and_deriv
2200 implicit real*8 (a-h,o-z)
2201 include 'DIMENSIONS'
2205 include 'COMMON.IOUNITS'
2206 include 'COMMON.GEO'
2207 include 'COMMON.VAR'
2208 include 'COMMON.LOCAL'
2209 include 'COMMON.CHAIN'
2210 include 'COMMON.VECTORS'
2211 include 'COMMON.SETUP'
2212 include 'COMMON.TIME1'
2213 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2214 C Compute the local reference systems. For reference system (i), the
2215 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2216 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2218 do i=ivec_start,ivec_end
2222 if (i.eq.nres-1) then
2223 C Case of the last full residue
2224 C Compute the Z-axis
2225 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2226 costh=dcos(pi-theta(nres))
2227 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2231 C Compute the derivatives of uz
2233 uzder(2,1,1)=-dc_norm(3,i-1)
2234 uzder(3,1,1)= dc_norm(2,i-1)
2235 uzder(1,2,1)= dc_norm(3,i-1)
2237 uzder(3,2,1)=-dc_norm(1,i-1)
2238 uzder(1,3,1)=-dc_norm(2,i-1)
2239 uzder(2,3,1)= dc_norm(1,i-1)
2242 uzder(2,1,2)= dc_norm(3,i)
2243 uzder(3,1,2)=-dc_norm(2,i)
2244 uzder(1,2,2)=-dc_norm(3,i)
2246 uzder(3,2,2)= dc_norm(1,i)
2247 uzder(1,3,2)= dc_norm(2,i)
2248 uzder(2,3,2)=-dc_norm(1,i)
2250 C Compute the Y-axis
2253 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2255 C Compute the derivatives of uy
2258 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2259 & -dc_norm(k,i)*dc_norm(j,i-1)
2260 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2262 uyder(j,j,1)=uyder(j,j,1)-costh
2263 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2268 uygrad(l,k,j,i)=uyder(l,k,j)
2269 uzgrad(l,k,j,i)=uzder(l,k,j)
2273 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2274 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2275 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2276 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2279 C Compute the Z-axis
2280 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2281 costh=dcos(pi-theta(i+2))
2282 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2286 C Compute the derivatives of uz
2288 uzder(2,1,1)=-dc_norm(3,i+1)
2289 uzder(3,1,1)= dc_norm(2,i+1)
2290 uzder(1,2,1)= dc_norm(3,i+1)
2292 uzder(3,2,1)=-dc_norm(1,i+1)
2293 uzder(1,3,1)=-dc_norm(2,i+1)
2294 uzder(2,3,1)= dc_norm(1,i+1)
2297 uzder(2,1,2)= dc_norm(3,i)
2298 uzder(3,1,2)=-dc_norm(2,i)
2299 uzder(1,2,2)=-dc_norm(3,i)
2301 uzder(3,2,2)= dc_norm(1,i)
2302 uzder(1,3,2)= dc_norm(2,i)
2303 uzder(2,3,2)=-dc_norm(1,i)
2305 C Compute the Y-axis
2308 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2310 C Compute the derivatives of uy
2313 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2314 & -dc_norm(k,i)*dc_norm(j,i+1)
2315 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2317 uyder(j,j,1)=uyder(j,j,1)-costh
2318 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2323 uygrad(l,k,j,i)=uyder(l,k,j)
2324 uzgrad(l,k,j,i)=uzder(l,k,j)
2328 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2329 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2330 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2331 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2335 vbld_inv_temp(1)=vbld_inv(i+1)
2336 if (i.lt.nres-1) then
2337 vbld_inv_temp(2)=vbld_inv(i+2)
2339 vbld_inv_temp(2)=vbld_inv(i)
2344 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2345 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2350 #if defined(PARVEC) && defined(MPI)
2351 if (nfgtasks1.gt.1) then
2353 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2354 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2355 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2356 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2357 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2359 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2360 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2362 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2363 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2364 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2365 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2366 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2367 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2368 time_gather=time_gather+MPI_Wtime()-time00
2370 c if (fg_rank.eq.0) then
2371 c write (iout,*) "Arrays UY and UZ"
2373 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2380 C-----------------------------------------------------------------------------
2381 subroutine check_vecgrad
2382 implicit real*8 (a-h,o-z)
2383 include 'DIMENSIONS'
2384 include 'COMMON.IOUNITS'
2385 include 'COMMON.GEO'
2386 include 'COMMON.VAR'
2387 include 'COMMON.LOCAL'
2388 include 'COMMON.CHAIN'
2389 include 'COMMON.VECTORS'
2390 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2391 dimension uyt(3,maxres),uzt(3,maxres)
2392 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2393 double precision delta /1.0d-7/
2396 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2397 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2398 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2399 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2400 cd & (dc_norm(if90,i),if90=1,3)
2401 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2402 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2403 cd write(iout,'(a)')
2409 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2410 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2423 cd write (iout,*) 'i=',i
2425 erij(k)=dc_norm(k,i)
2429 dc_norm(k,i)=erij(k)
2431 dc_norm(j,i)=dc_norm(j,i)+delta
2432 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2434 c dc_norm(k,i)=dc_norm(k,i)/fac
2436 c write (iout,*) (dc_norm(k,i),k=1,3)
2437 c write (iout,*) (erij(k),k=1,3)
2440 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2441 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2442 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2443 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2445 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2446 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2447 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2450 dc_norm(k,i)=erij(k)
2453 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2454 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2455 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2456 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2457 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2458 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2459 cd write (iout,'(a)')
2464 C--------------------------------------------------------------------------
2465 subroutine set_matrices
2466 implicit real*8 (a-h,o-z)
2467 include 'DIMENSIONS'
2470 include "COMMON.SETUP"
2472 integer status(MPI_STATUS_SIZE)
2474 include 'COMMON.IOUNITS'
2475 include 'COMMON.GEO'
2476 include 'COMMON.VAR'
2477 include 'COMMON.LOCAL'
2478 include 'COMMON.CHAIN'
2479 include 'COMMON.DERIV'
2480 include 'COMMON.INTERACT'
2481 include 'COMMON.CONTACTS'
2482 include 'COMMON.TORSION'
2483 include 'COMMON.VECTORS'
2484 include 'COMMON.FFIELD'
2485 double precision auxvec(2),auxmat(2,2)
2487 C Compute the virtual-bond-torsional-angle dependent quantities needed
2488 C to calculate the el-loc multibody terms of various order.
2491 do i=ivec_start+2,ivec_end+2
2495 if (i .lt. nres+1) then
2532 if (i .gt. 3 .and. i .lt. nres+1) then
2533 obrot_der(1,i-2)=-sin1
2534 obrot_der(2,i-2)= cos1
2535 Ugder(1,1,i-2)= sin1
2536 Ugder(1,2,i-2)=-cos1
2537 Ugder(2,1,i-2)=-cos1
2538 Ugder(2,2,i-2)=-sin1
2541 obrot2_der(1,i-2)=-dwasin2
2542 obrot2_der(2,i-2)= dwacos2
2543 Ug2der(1,1,i-2)= dwasin2
2544 Ug2der(1,2,i-2)=-dwacos2
2545 Ug2der(2,1,i-2)=-dwacos2
2546 Ug2der(2,2,i-2)=-dwasin2
2548 obrot_der(1,i-2)=0.0d0
2549 obrot_der(2,i-2)=0.0d0
2550 Ugder(1,1,i-2)=0.0d0
2551 Ugder(1,2,i-2)=0.0d0
2552 Ugder(2,1,i-2)=0.0d0
2553 Ugder(2,2,i-2)=0.0d0
2554 obrot2_der(1,i-2)=0.0d0
2555 obrot2_der(2,i-2)=0.0d0
2556 Ug2der(1,1,i-2)=0.0d0
2557 Ug2der(1,2,i-2)=0.0d0
2558 Ug2der(2,1,i-2)=0.0d0
2559 Ug2der(2,2,i-2)=0.0d0
2561 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2562 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2563 iti = itortyp(itype(i-2))
2567 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2568 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2569 iti1 = itortyp(itype(i-1))
2573 cd write (iout,*) '*******i',i,' iti1',iti
2574 cd write (iout,*) 'b1',b1(:,iti)
2575 cd write (iout,*) 'b2',b2(:,iti)
2576 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2577 c if (i .gt. iatel_s+2) then
2578 if (i .gt. nnt+2) then
2579 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2580 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2581 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2583 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2584 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2585 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2586 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2587 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2598 DtUg2(l,k,i-2)=0.0d0
2602 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2603 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2605 muder(k,i-2)=Ub2der(k,i-2)
2607 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2608 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2609 iti1 = itortyp(itype(i-1))
2614 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2616 cd write (iout,*) 'mu ',mu(:,i-2)
2617 cd write (iout,*) 'mu1',mu1(:,i-2)
2618 cd write (iout,*) 'mu2',mu2(:,i-2)
2619 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2621 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2622 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2623 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2624 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2625 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2626 C Vectors and matrices dependent on a single virtual-bond dihedral.
2627 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2628 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2629 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2630 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2631 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2632 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2633 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2634 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2635 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2638 C Matrices dependent on two consecutive virtual-bond dihedrals.
2639 C The order of matrices is from left to right.
2640 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2642 c do i=max0(ivec_start,2),ivec_end
2644 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2645 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2646 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2647 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2648 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2649 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2650 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2651 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2654 #if defined(MPI) && defined(PARMAT)
2656 c if (fg_rank.eq.0) then
2657 write (iout,*) "Arrays UG and UGDER before GATHER"
2659 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2660 & ((ug(l,k,i),l=1,2),k=1,2),
2661 & ((ugder(l,k,i),l=1,2),k=1,2)
2663 write (iout,*) "Arrays UG2 and UG2DER"
2665 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2666 & ((ug2(l,k,i),l=1,2),k=1,2),
2667 & ((ug2der(l,k,i),l=1,2),k=1,2)
2669 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2671 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2672 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2673 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2675 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2677 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2678 & costab(i),sintab(i),costab2(i),sintab2(i)
2680 write (iout,*) "Array MUDER"
2682 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2686 if (nfgtasks.gt.1) then
2688 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2689 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2690 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2692 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2693 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2695 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2696 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2698 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2699 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2701 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2702 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2704 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2705 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2707 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2708 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2710 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2711 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2712 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2713 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2714 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2715 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2716 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2717 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2718 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2719 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2720 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2721 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2722 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2724 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2725 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2727 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2728 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2730 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2731 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2733 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2740 & ivec_count(fg_rank1),
2741 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2743 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2744 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2746 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2747 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2749 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2750 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2752 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2753 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2755 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2756 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2758 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2759 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2761 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2762 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2764 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2765 & ivec_count(fg_rank1),
2766 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2768 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2769 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2771 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2772 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2774 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2775 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2777 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2778 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2780 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2781 & ivec_count(fg_rank1),
2782 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2784 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2785 & ivec_count(fg_rank1),
2786 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2788 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2789 & ivec_count(fg_rank1),
2790 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2791 & MPI_MAT2,FG_COMM1,IERR)
2792 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2793 & ivec_count(fg_rank1),
2794 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2795 & MPI_MAT2,FG_COMM1,IERR)
2798 c Passes matrix info through the ring
2801 if (irecv.lt.0) irecv=nfgtasks1-1
2804 if (inext.ge.nfgtasks1) inext=0
2806 c write (iout,*) "isend",isend," irecv",irecv
2808 lensend=lentyp(isend)
2809 lenrecv=lentyp(irecv)
2810 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2811 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2812 c & MPI_ROTAT1(lensend),inext,2200+isend,
2813 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2814 c & iprev,2200+irecv,FG_COMM,status,IERR)
2815 c write (iout,*) "Gather ROTAT1"
2817 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2818 c & MPI_ROTAT2(lensend),inext,3300+isend,
2819 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2820 c & iprev,3300+irecv,FG_COMM,status,IERR)
2821 c write (iout,*) "Gather ROTAT2"
2823 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2824 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2825 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2826 & iprev,4400+irecv,FG_COMM,status,IERR)
2827 c write (iout,*) "Gather ROTAT_OLD"
2829 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2830 & MPI_PRECOMP11(lensend),inext,5500+isend,
2831 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2832 & iprev,5500+irecv,FG_COMM,status,IERR)
2833 c write (iout,*) "Gather PRECOMP11"
2835 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2836 & MPI_PRECOMP12(lensend),inext,6600+isend,
2837 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2838 & iprev,6600+irecv,FG_COMM,status,IERR)
2839 c write (iout,*) "Gather PRECOMP12"
2841 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2843 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2844 & MPI_ROTAT2(lensend),inext,7700+isend,
2845 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2846 & iprev,7700+irecv,FG_COMM,status,IERR)
2847 c write (iout,*) "Gather PRECOMP21"
2849 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2850 & MPI_PRECOMP22(lensend),inext,8800+isend,
2851 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2852 & iprev,8800+irecv,FG_COMM,status,IERR)
2853 c write (iout,*) "Gather PRECOMP22"
2855 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2856 & MPI_PRECOMP23(lensend),inext,9900+isend,
2857 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2858 & MPI_PRECOMP23(lenrecv),
2859 & iprev,9900+irecv,FG_COMM,status,IERR)
2860 c write (iout,*) "Gather PRECOMP23"
2865 if (irecv.lt.0) irecv=nfgtasks1-1
2868 time_gather=time_gather+MPI_Wtime()-time00
2871 c if (fg_rank.eq.0) then
2872 write (iout,*) "Arrays UG and UGDER"
2874 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2875 & ((ug(l,k,i),l=1,2),k=1,2),
2876 & ((ugder(l,k,i),l=1,2),k=1,2)
2878 write (iout,*) "Arrays UG2 and UG2DER"
2880 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2881 & ((ug2(l,k,i),l=1,2),k=1,2),
2882 & ((ug2der(l,k,i),l=1,2),k=1,2)
2884 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2886 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2887 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2888 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2890 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2892 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2893 & costab(i),sintab(i),costab2(i),sintab2(i)
2895 write (iout,*) "Array MUDER"
2897 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2903 cd iti = itortyp(itype(i))
2906 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2907 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2912 C--------------------------------------------------------------------------
2913 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2915 C This subroutine calculates the average interaction energy and its gradient
2916 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2917 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2918 C The potential depends both on the distance of peptide-group centers and on
2919 C the orientation of the CA-CA virtual bonds.
2921 implicit real*8 (a-h,o-z)
2925 include 'DIMENSIONS'
2926 include 'COMMON.CONTROL'
2927 include 'COMMON.SETUP'
2928 include 'COMMON.IOUNITS'
2929 include 'COMMON.GEO'
2930 include 'COMMON.VAR'
2931 include 'COMMON.LOCAL'
2932 include 'COMMON.CHAIN'
2933 include 'COMMON.DERIV'
2934 include 'COMMON.INTERACT'
2935 include 'COMMON.CONTACTS'
2936 include 'COMMON.TORSION'
2937 include 'COMMON.VECTORS'
2938 include 'COMMON.FFIELD'
2939 include 'COMMON.TIME1'
2940 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2941 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2942 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2943 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2944 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2945 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2947 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2949 double precision scal_el /1.0d0/
2951 double precision scal_el /0.5d0/
2954 C 13-go grudnia roku pamietnego...
2955 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2956 & 0.0d0,1.0d0,0.0d0,
2957 & 0.0d0,0.0d0,1.0d0/
2958 cd write(iout,*) 'In EELEC'
2960 cd write(iout,*) 'Type',i
2961 cd write(iout,*) 'B1',B1(:,i)
2962 cd write(iout,*) 'B2',B2(:,i)
2963 cd write(iout,*) 'CC',CC(:,:,i)
2964 cd write(iout,*) 'DD',DD(:,:,i)
2965 cd write(iout,*) 'EE',EE(:,:,i)
2967 cd call check_vecgrad
2969 if (icheckgrad.eq.1) then
2971 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2973 dc_norm(k,i)=dc(k,i)*fac
2975 c write (iout,*) 'i',i,' fac',fac
2978 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2979 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2980 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2981 c call vec_and_deriv
2987 time_mat=time_mat+MPI_Wtime()-time01
2991 cd write (iout,*) 'i=',i
2993 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2996 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2997 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3010 cd print '(a)','Enter EELEC'
3011 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3013 gel_loc_loc(i)=0.0d0
3018 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3020 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3022 do i=iturn3_start,iturn3_end
3026 dx_normi=dc_norm(1,i)
3027 dy_normi=dc_norm(2,i)
3028 dz_normi=dc_norm(3,i)
3029 xmedi=c(1,i)+0.5d0*dxi
3030 ymedi=c(2,i)+0.5d0*dyi
3031 zmedi=c(3,i)+0.5d0*dzi
3033 call eelecij(i,i+2,ees,evdw1,eel_loc)
3034 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3035 num_cont_hb(i)=num_conti
3037 do i=iturn4_start,iturn4_end
3041 dx_normi=dc_norm(1,i)
3042 dy_normi=dc_norm(2,i)
3043 dz_normi=dc_norm(3,i)
3044 xmedi=c(1,i)+0.5d0*dxi
3045 ymedi=c(2,i)+0.5d0*dyi
3046 zmedi=c(3,i)+0.5d0*dzi
3047 num_conti=num_cont_hb(i)
3048 call eelecij(i,i+3,ees,evdw1,eel_loc)
3049 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3050 num_cont_hb(i)=num_conti
3053 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3055 do i=iatel_s,iatel_e
3059 dx_normi=dc_norm(1,i)
3060 dy_normi=dc_norm(2,i)
3061 dz_normi=dc_norm(3,i)
3062 xmedi=c(1,i)+0.5d0*dxi
3063 ymedi=c(2,i)+0.5d0*dyi
3064 zmedi=c(3,i)+0.5d0*dzi
3065 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3066 num_conti=num_cont_hb(i)
3067 do j=ielstart(i),ielend(i)
3068 call eelecij(i,j,ees,evdw1,eel_loc)
3070 num_cont_hb(i)=num_conti
3072 c write (iout,*) "Number of loop steps in EELEC:",ind
3074 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3075 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3077 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3078 ccc eel_loc=eel_loc+eello_turn3
3079 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3082 C-------------------------------------------------------------------------------
3083 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3084 implicit real*8 (a-h,o-z)
3085 include 'DIMENSIONS'
3089 include 'COMMON.CONTROL'
3090 include 'COMMON.IOUNITS'
3091 include 'COMMON.GEO'
3092 include 'COMMON.VAR'
3093 include 'COMMON.LOCAL'
3094 include 'COMMON.CHAIN'
3095 include 'COMMON.DERIV'
3096 include 'COMMON.INTERACT'
3097 include 'COMMON.CONTACTS'
3098 include 'COMMON.TORSION'
3099 include 'COMMON.VECTORS'
3100 include 'COMMON.FFIELD'
3101 include 'COMMON.TIME1'
3102 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3103 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3104 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3105 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3106 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3107 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3109 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3111 double precision scal_el /1.0d0/
3113 double precision scal_el /0.5d0/
3116 C 13-go grudnia roku pamietnego...
3117 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3118 & 0.0d0,1.0d0,0.0d0,
3119 & 0.0d0,0.0d0,1.0d0/
3120 c time00=MPI_Wtime()
3121 cd write (iout,*) "eelecij",i,j
3125 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3126 aaa=app(iteli,itelj)
3127 bbb=bpp(iteli,itelj)
3128 ael6i=ael6(iteli,itelj)
3129 ael3i=ael3(iteli,itelj)
3133 dx_normj=dc_norm(1,j)
3134 dy_normj=dc_norm(2,j)
3135 dz_normj=dc_norm(3,j)
3136 xj=c(1,j)+0.5D0*dxj-xmedi
3137 yj=c(2,j)+0.5D0*dyj-ymedi
3138 zj=c(3,j)+0.5D0*dzj-zmedi
3139 rij=xj*xj+yj*yj+zj*zj
3145 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3146 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3147 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3148 fac=cosa-3.0D0*cosb*cosg
3150 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3151 if (j.eq.i+2) ev1=scal_el*ev1
3156 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3159 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3160 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3163 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3164 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3165 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3166 cd & xmedi,ymedi,zmedi,xj,yj,zj
3168 if (energy_dec) then
3169 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3170 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3174 C Calculate contributions to the Cartesian gradient.
3177 facvdw=-6*rrmij*(ev1+evdwij)
3178 facel=-3*rrmij*(el1+eesij)
3184 * Radial derivatives. First process both termini of the fragment (i,j)
3190 c ghalf=0.5D0*ggg(k)
3191 c gelc(k,i)=gelc(k,i)+ghalf
3192 c gelc(k,j)=gelc(k,j)+ghalf
3194 c 9/28/08 AL Gradient compotents will be summed only at the end
3196 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3197 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3200 * Loop over residues i+1 thru j-1.
3204 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3211 c ghalf=0.5D0*ggg(k)
3212 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3213 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3215 c 9/28/08 AL Gradient compotents will be summed only at the end
3217 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3218 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3221 * Loop over residues i+1 thru j-1.
3225 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3232 fac=-3*rrmij*(facvdw+facvdw+facel)
3237 * Radial derivatives. First process both termini of the fragment (i,j)
3243 c ghalf=0.5D0*ggg(k)
3244 c gelc(k,i)=gelc(k,i)+ghalf
3245 c gelc(k,j)=gelc(k,j)+ghalf
3247 c 9/28/08 AL Gradient compotents will be summed only at the end
3249 gelc_long(k,j)=gelc(k,j)+ggg(k)
3250 gelc_long(k,i)=gelc(k,i)-ggg(k)
3253 * Loop over residues i+1 thru j-1.
3257 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3260 c 9/28/08 AL Gradient compotents will be summed only at the end
3265 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3266 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3272 ecosa=2.0D0*fac3*fac1+fac4
3275 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3276 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3278 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3279 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3281 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3282 cd & (dcosg(k),k=1,3)
3284 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3287 c ghalf=0.5D0*ggg(k)
3288 c gelc(k,i)=gelc(k,i)+ghalf
3289 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3290 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3291 c gelc(k,j)=gelc(k,j)+ghalf
3292 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3293 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3297 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3302 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3303 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3305 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3306 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3307 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3308 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3310 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3311 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3312 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3314 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3315 C energy of a peptide unit is assumed in the form of a second-order
3316 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3317 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3318 C are computed for EVERY pair of non-contiguous peptide groups.
3320 if (j.lt.nres-1) then
3331 muij(kkk)=mu(k,i)*mu(l,j)
3334 cd write (iout,*) 'EELEC: i',i,' j',j
3335 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3336 cd write(iout,*) 'muij',muij
3337 ury=scalar(uy(1,i),erij)
3338 urz=scalar(uz(1,i),erij)
3339 vry=scalar(uy(1,j),erij)
3340 vrz=scalar(uz(1,j),erij)
3341 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3342 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3343 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3344 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3345 fac=dsqrt(-ael6i)*r3ij
3350 cd write (iout,'(4i5,4f10.5)')
3351 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3352 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3353 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3354 cd & uy(:,j),uz(:,j)
3355 cd write (iout,'(4f10.5)')
3356 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3357 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3358 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3359 cd write (iout,'(9f10.5/)')
3360 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3361 C Derivatives of the elements of A in virtual-bond vectors
3362 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3364 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3365 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3366 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3367 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3368 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3369 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3370 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3371 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3372 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3373 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3374 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3375 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3377 C Compute radial contributions to the gradient
3395 C Add the contributions coming from er
3398 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3399 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3400 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3401 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3404 C Derivatives in DC(i)
3405 cgrad ghalf1=0.5d0*agg(k,1)
3406 cgrad ghalf2=0.5d0*agg(k,2)
3407 cgrad ghalf3=0.5d0*agg(k,3)
3408 cgrad ghalf4=0.5d0*agg(k,4)
3409 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3410 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3411 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3412 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3413 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3414 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3415 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3416 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3417 C Derivatives in DC(i+1)
3418 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3419 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3420 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3421 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3422 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3423 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3424 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3425 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3426 C Derivatives in DC(j)
3427 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3428 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3429 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3430 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3431 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3432 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3433 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3434 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3435 C Derivatives in DC(j+1) or DC(nres-1)
3436 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3437 & -3.0d0*vryg(k,3)*ury)
3438 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3439 & -3.0d0*vrzg(k,3)*ury)
3440 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3441 & -3.0d0*vryg(k,3)*urz)
3442 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3443 & -3.0d0*vrzg(k,3)*urz)
3444 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3446 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3459 aggi(k,l)=-aggi(k,l)
3460 aggi1(k,l)=-aggi1(k,l)
3461 aggj(k,l)=-aggj(k,l)
3462 aggj1(k,l)=-aggj1(k,l)
3465 if (j.lt.nres-1) then
3471 aggi(k,l)=-aggi(k,l)
3472 aggi1(k,l)=-aggi1(k,l)
3473 aggj(k,l)=-aggj(k,l)
3474 aggj1(k,l)=-aggj1(k,l)
3485 aggi(k,l)=-aggi(k,l)
3486 aggi1(k,l)=-aggi1(k,l)
3487 aggj(k,l)=-aggj(k,l)
3488 aggj1(k,l)=-aggj1(k,l)
3493 IF (wel_loc.gt.0.0d0) THEN
3494 C Contribution to the local-electrostatic energy coming from the i-j pair
3495 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3497 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3499 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3500 & 'eelloc',i,j,eel_loc_ij
3502 eel_loc=eel_loc+eel_loc_ij
3503 C Partial derivatives in virtual-bond dihedral angles gamma
3505 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3506 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3507 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3508 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3509 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3510 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3511 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3513 ggg(l)=agg(l,1)*muij(1)+
3514 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3515 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3516 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3517 cgrad ghalf=0.5d0*ggg(l)
3518 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3519 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3523 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3526 C Remaining derivatives of eello
3528 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3529 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3530 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3531 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3532 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3533 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3534 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3535 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3538 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3539 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3540 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3541 & .and. num_conti.le.maxconts) then
3542 c write (iout,*) i,j," entered corr"
3544 C Calculate the contact function. The ith column of the array JCONT will
3545 C contain the numbers of atoms that make contacts with the atom I (of numbers
3546 C greater than I). The arrays FACONT and GACONT will contain the values of
3547 C the contact function and its derivative.
3548 c r0ij=1.02D0*rpp(iteli,itelj)
3549 c r0ij=1.11D0*rpp(iteli,itelj)
3550 r0ij=2.20D0*rpp(iteli,itelj)
3551 c r0ij=1.55D0*rpp(iteli,itelj)
3552 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3553 if (fcont.gt.0.0D0) then
3554 num_conti=num_conti+1
3555 if (num_conti.gt.maxconts) then
3556 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3557 & ' will skip next contacts for this conf.'
3559 jcont_hb(num_conti,i)=j
3560 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3561 cd & " jcont_hb",jcont_hb(num_conti,i)
3562 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3563 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3564 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3566 d_cont(num_conti,i)=rij
3567 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3568 C --- Electrostatic-interaction matrix ---
3569 a_chuj(1,1,num_conti,i)=a22
3570 a_chuj(1,2,num_conti,i)=a23
3571 a_chuj(2,1,num_conti,i)=a32
3572 a_chuj(2,2,num_conti,i)=a33
3573 C --- Gradient of rij
3575 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3582 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3583 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3584 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3585 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3586 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3591 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3592 C Calculate contact energies
3594 wij=cosa-3.0D0*cosb*cosg
3597 c fac3=dsqrt(-ael6i)/r0ij**3
3598 fac3=dsqrt(-ael6i)*r3ij
3599 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3600 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3601 if (ees0tmp.gt.0) then
3602 ees0pij=dsqrt(ees0tmp)
3606 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3607 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3608 if (ees0tmp.gt.0) then
3609 ees0mij=dsqrt(ees0tmp)
3614 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3615 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3616 C Diagnostics. Comment out or remove after debugging!
3617 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3618 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3619 c ees0m(num_conti,i)=0.0D0
3621 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3622 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3623 C Angular derivatives of the contact function
3624 ees0pij1=fac3/ees0pij
3625 ees0mij1=fac3/ees0mij
3626 fac3p=-3.0D0*fac3*rrmij
3627 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3628 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3630 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3631 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3632 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3633 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3634 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3635 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3636 ecosap=ecosa1+ecosa2
3637 ecosbp=ecosb1+ecosb2
3638 ecosgp=ecosg1+ecosg2
3639 ecosam=ecosa1-ecosa2
3640 ecosbm=ecosb1-ecosb2
3641 ecosgm=ecosg1-ecosg2
3650 facont_hb(num_conti,i)=fcont
3651 fprimcont=fprimcont/rij
3652 cd facont_hb(num_conti,i)=1.0D0
3653 C Following line is for diagnostics.
3656 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3657 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3660 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3661 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3663 gggp(1)=gggp(1)+ees0pijp*xj
3664 gggp(2)=gggp(2)+ees0pijp*yj
3665 gggp(3)=gggp(3)+ees0pijp*zj
3666 gggm(1)=gggm(1)+ees0mijp*xj
3667 gggm(2)=gggm(2)+ees0mijp*yj
3668 gggm(3)=gggm(3)+ees0mijp*zj
3669 C Derivatives due to the contact function
3670 gacont_hbr(1,num_conti,i)=fprimcont*xj
3671 gacont_hbr(2,num_conti,i)=fprimcont*yj
3672 gacont_hbr(3,num_conti,i)=fprimcont*zj
3675 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3676 c following the change of gradient-summation algorithm.
3678 cgrad ghalfp=0.5D0*gggp(k)
3679 cgrad ghalfm=0.5D0*gggm(k)
3680 gacontp_hb1(k,num_conti,i)=!ghalfp
3681 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3682 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3683 gacontp_hb2(k,num_conti,i)=!ghalfp
3684 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3685 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3686 gacontp_hb3(k,num_conti,i)=gggp(k)
3687 gacontm_hb1(k,num_conti,i)=!ghalfm
3688 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3689 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3690 gacontm_hb2(k,num_conti,i)=!ghalfm
3691 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3692 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3693 gacontm_hb3(k,num_conti,i)=gggm(k)
3695 C Diagnostics. Comment out or remove after debugging!
3697 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3698 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3699 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3700 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3701 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3702 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3705 endif ! num_conti.le.maxconts
3708 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3711 ghalf=0.5d0*agg(l,k)
3712 aggi(l,k)=aggi(l,k)+ghalf
3713 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3714 aggj(l,k)=aggj(l,k)+ghalf
3717 if (j.eq.nres-1 .and. i.lt.j-2) then
3720 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3725 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3728 C-----------------------------------------------------------------------------
3729 subroutine eturn3(i,eello_turn3)
3730 C Third- and fourth-order contributions from turns
3731 implicit real*8 (a-h,o-z)
3732 include 'DIMENSIONS'
3733 include 'COMMON.IOUNITS'
3734 include 'COMMON.GEO'
3735 include 'COMMON.VAR'
3736 include 'COMMON.LOCAL'
3737 include 'COMMON.CHAIN'
3738 include 'COMMON.DERIV'
3739 include 'COMMON.INTERACT'
3740 include 'COMMON.CONTACTS'
3741 include 'COMMON.TORSION'
3742 include 'COMMON.VECTORS'
3743 include 'COMMON.FFIELD'
3744 include 'COMMON.CONTROL'
3746 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3747 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3748 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3749 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3750 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3751 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3752 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3755 c write (iout,*) "eturn3",i,j,j1,j2
3760 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3762 C Third-order contributions
3769 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3770 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3771 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3772 call transpose2(auxmat(1,1),auxmat1(1,1))
3773 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3774 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3775 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3776 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3777 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3778 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3779 cd & ' eello_turn3_num',4*eello_turn3_num
3780 C Derivatives in gamma(i)
3781 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3782 call transpose2(auxmat2(1,1),auxmat3(1,1))
3783 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3784 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3785 C Derivatives in gamma(i+1)
3786 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3787 call transpose2(auxmat2(1,1),auxmat3(1,1))
3788 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3789 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3790 & +0.5d0*(pizda(1,1)+pizda(2,2))
3791 C Cartesian derivatives
3793 c ghalf1=0.5d0*agg(l,1)
3794 c ghalf2=0.5d0*agg(l,2)
3795 c ghalf3=0.5d0*agg(l,3)
3796 c ghalf4=0.5d0*agg(l,4)
3797 a_temp(1,1)=aggi(l,1)!+ghalf1
3798 a_temp(1,2)=aggi(l,2)!+ghalf2
3799 a_temp(2,1)=aggi(l,3)!+ghalf3
3800 a_temp(2,2)=aggi(l,4)!+ghalf4
3801 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3802 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3803 & +0.5d0*(pizda(1,1)+pizda(2,2))
3804 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3805 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3806 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3807 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3808 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3809 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3810 & +0.5d0*(pizda(1,1)+pizda(2,2))
3811 a_temp(1,1)=aggj(l,1)!+ghalf1
3812 a_temp(1,2)=aggj(l,2)!+ghalf2
3813 a_temp(2,1)=aggj(l,3)!+ghalf3
3814 a_temp(2,2)=aggj(l,4)!+ghalf4
3815 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3816 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3817 & +0.5d0*(pizda(1,1)+pizda(2,2))
3818 a_temp(1,1)=aggj1(l,1)
3819 a_temp(1,2)=aggj1(l,2)
3820 a_temp(2,1)=aggj1(l,3)
3821 a_temp(2,2)=aggj1(l,4)
3822 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3823 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3824 & +0.5d0*(pizda(1,1)+pizda(2,2))
3828 C-------------------------------------------------------------------------------
3829 subroutine eturn4(i,eello_turn4)
3830 C Third- and fourth-order contributions from turns
3831 implicit real*8 (a-h,o-z)
3832 include 'DIMENSIONS'
3833 include 'COMMON.IOUNITS'
3834 include 'COMMON.GEO'
3835 include 'COMMON.VAR'
3836 include 'COMMON.LOCAL'
3837 include 'COMMON.CHAIN'
3838 include 'COMMON.DERIV'
3839 include 'COMMON.INTERACT'
3840 include 'COMMON.CONTACTS'
3841 include 'COMMON.TORSION'
3842 include 'COMMON.VECTORS'
3843 include 'COMMON.FFIELD'
3844 include 'COMMON.CONTROL'
3846 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3847 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3848 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3849 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3850 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3851 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3852 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3855 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3857 C Fourth-order contributions
3865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3866 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3867 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3872 iti1=itortyp(itype(i+1))
3873 iti2=itortyp(itype(i+2))
3874 iti3=itortyp(itype(i+3))
3875 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3876 call transpose2(EUg(1,1,i+1),e1t(1,1))
3877 call transpose2(Eug(1,1,i+2),e2t(1,1))
3878 call transpose2(Eug(1,1,i+3),e3t(1,1))
3879 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3880 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3881 s1=scalar2(b1(1,iti2),auxvec(1))
3882 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3883 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3884 s2=scalar2(b1(1,iti1),auxvec(1))
3885 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3886 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3887 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3888 eello_turn4=eello_turn4-(s1+s2+s3)
3889 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3890 & 'eturn4',i,j,-(s1+s2+s3)
3891 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3892 cd & ' eello_turn4_num',8*eello_turn4_num
3893 C Derivatives in gamma(i)
3894 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3895 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3896 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3897 s1=scalar2(b1(1,iti2),auxvec(1))
3898 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3899 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3900 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3901 C Derivatives in gamma(i+1)
3902 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3903 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3904 s2=scalar2(b1(1,iti1),auxvec(1))
3905 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3906 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3907 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3908 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3909 C Derivatives in gamma(i+2)
3910 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3911 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3912 s1=scalar2(b1(1,iti2),auxvec(1))
3913 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3914 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3915 s2=scalar2(b1(1,iti1),auxvec(1))
3916 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3917 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3918 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3919 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3920 C Cartesian derivatives
3921 C Derivatives of this turn contributions in DC(i+2)
3922 if (j.lt.nres-1) then
3924 a_temp(1,1)=agg(l,1)
3925 a_temp(1,2)=agg(l,2)
3926 a_temp(2,1)=agg(l,3)
3927 a_temp(2,2)=agg(l,4)
3928 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3929 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3930 s1=scalar2(b1(1,iti2),auxvec(1))
3931 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3932 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3933 s2=scalar2(b1(1,iti1),auxvec(1))
3934 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3935 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3936 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3938 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3941 C Remaining derivatives of this turn contribution
3943 a_temp(1,1)=aggi(l,1)
3944 a_temp(1,2)=aggi(l,2)
3945 a_temp(2,1)=aggi(l,3)
3946 a_temp(2,2)=aggi(l,4)
3947 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3948 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3949 s1=scalar2(b1(1,iti2),auxvec(1))
3950 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3951 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3952 s2=scalar2(b1(1,iti1),auxvec(1))
3953 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3954 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3955 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3956 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3957 a_temp(1,1)=aggi1(l,1)
3958 a_temp(1,2)=aggi1(l,2)
3959 a_temp(2,1)=aggi1(l,3)
3960 a_temp(2,2)=aggi1(l,4)
3961 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3962 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3963 s1=scalar2(b1(1,iti2),auxvec(1))
3964 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3965 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3966 s2=scalar2(b1(1,iti1),auxvec(1))
3967 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3968 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3969 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3970 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3971 a_temp(1,1)=aggj(l,1)
3972 a_temp(1,2)=aggj(l,2)
3973 a_temp(2,1)=aggj(l,3)
3974 a_temp(2,2)=aggj(l,4)
3975 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3976 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3977 s1=scalar2(b1(1,iti2),auxvec(1))
3978 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3979 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3980 s2=scalar2(b1(1,iti1),auxvec(1))
3981 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3982 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3983 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3984 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3985 a_temp(1,1)=aggj1(l,1)
3986 a_temp(1,2)=aggj1(l,2)
3987 a_temp(2,1)=aggj1(l,3)
3988 a_temp(2,2)=aggj1(l,4)
3989 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3990 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3991 s1=scalar2(b1(1,iti2),auxvec(1))
3992 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3993 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3994 s2=scalar2(b1(1,iti1),auxvec(1))
3995 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3996 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3997 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3998 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3999 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4003 C-----------------------------------------------------------------------------
4004 subroutine vecpr(u,v,w)
4005 implicit real*8(a-h,o-z)
4006 dimension u(3),v(3),w(3)
4007 w(1)=u(2)*v(3)-u(3)*v(2)
4008 w(2)=-u(1)*v(3)+u(3)*v(1)
4009 w(3)=u(1)*v(2)-u(2)*v(1)
4012 C-----------------------------------------------------------------------------
4013 subroutine unormderiv(u,ugrad,unorm,ungrad)
4014 C This subroutine computes the derivatives of a normalized vector u, given
4015 C the derivatives computed without normalization conditions, ugrad. Returns
4018 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4019 double precision vec(3)
4020 double precision scalar
4022 c write (2,*) 'ugrad',ugrad
4025 vec(i)=scalar(ugrad(1,i),u(1))
4027 c write (2,*) 'vec',vec
4030 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4033 c write (2,*) 'ungrad',ungrad
4036 C-----------------------------------------------------------------------------
4037 subroutine escp_soft_sphere(evdw2,evdw2_14)
4039 C This subroutine calculates the excluded-volume interaction energy between
4040 C peptide-group centers and side chains and its gradient in virtual-bond and
4041 C side-chain vectors.
4043 implicit real*8 (a-h,o-z)
4044 include 'DIMENSIONS'
4045 include 'COMMON.GEO'
4046 include 'COMMON.VAR'
4047 include 'COMMON.LOCAL'
4048 include 'COMMON.CHAIN'
4049 include 'COMMON.DERIV'
4050 include 'COMMON.INTERACT'
4051 include 'COMMON.FFIELD'
4052 include 'COMMON.IOUNITS'
4053 include 'COMMON.CONTROL'
4058 cd print '(a)','Enter ESCP'
4059 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4060 do i=iatscp_s,iatscp_e
4062 xi=0.5D0*(c(1,i)+c(1,i+1))
4063 yi=0.5D0*(c(2,i)+c(2,i+1))
4064 zi=0.5D0*(c(3,i)+c(3,i+1))
4066 do iint=1,nscp_gr(i)
4068 do j=iscpstart(i,iint),iscpend(i,iint)
4070 C Uncomment following three lines for SC-p interactions
4074 C Uncomment following three lines for Ca-p interactions
4078 rij=xj*xj+yj*yj+zj*zj
4081 if (rij.lt.r0ijsq) then
4082 evdwij=0.25d0*(rij-r0ijsq)**2
4090 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4095 cgrad if (j.lt.i) then
4096 cd write (iout,*) 'j<i'
4097 C Uncomment following three lines for SC-p interactions
4099 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4102 cd write (iout,*) 'j>i'
4104 cgrad ggg(k)=-ggg(k)
4105 C Uncomment following line for SC-p interactions
4106 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4110 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4112 cgrad kstart=min0(i+1,j)
4113 cgrad kend=max0(i-1,j-1)
4114 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4115 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4116 cgrad do k=kstart,kend
4118 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4122 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4123 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4131 C-----------------------------------------------------------------------------
4132 subroutine escp(evdw2,evdw2_14)
4134 C This subroutine calculates the excluded-volume interaction energy between
4135 C peptide-group centers and side chains and its gradient in virtual-bond and
4136 C side-chain vectors.
4138 implicit real*8 (a-h,o-z)
4139 include 'DIMENSIONS'
4140 include 'COMMON.GEO'
4141 include 'COMMON.VAR'
4142 include 'COMMON.LOCAL'
4143 include 'COMMON.CHAIN'
4144 include 'COMMON.DERIV'
4145 include 'COMMON.INTERACT'
4146 include 'COMMON.FFIELD'
4147 include 'COMMON.IOUNITS'
4148 include 'COMMON.CONTROL'
4152 cd print '(a)','Enter ESCP'
4153 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4154 do i=iatscp_s,iatscp_e
4156 xi=0.5D0*(c(1,i)+c(1,i+1))
4157 yi=0.5D0*(c(2,i)+c(2,i+1))
4158 zi=0.5D0*(c(3,i)+c(3,i+1))
4160 do iint=1,nscp_gr(i)
4162 do j=iscpstart(i,iint),iscpend(i,iint)
4164 C Uncomment following three lines for SC-p interactions
4168 C Uncomment following three lines for Ca-p interactions
4172 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4174 e1=fac*fac*aad(itypj,iteli)
4175 e2=fac*bad(itypj,iteli)
4176 if (iabs(j-i) .le. 2) then
4179 evdw2_14=evdw2_14+e1+e2
4183 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4184 & 'evdw2',i,j,evdwij
4186 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4188 fac=-(evdwij+e1)*rrij
4192 cgrad if (j.lt.i) then
4193 cd write (iout,*) 'j<i'
4194 C Uncomment following three lines for SC-p interactions
4196 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4199 cd write (iout,*) 'j>i'
4201 cgrad ggg(k)=-ggg(k)
4202 C Uncomment following line for SC-p interactions
4203 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4204 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4208 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4210 cgrad kstart=min0(i+1,j)
4211 cgrad kend=max0(i-1,j-1)
4212 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4213 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4214 cgrad do k=kstart,kend
4216 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4220 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4221 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4229 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4230 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4231 gradx_scp(j,i)=expon*gradx_scp(j,i)
4234 C******************************************************************************
4238 C To save time the factor EXPON has been extracted from ALL components
4239 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4242 C******************************************************************************
4245 C--------------------------------------------------------------------------
4246 subroutine edis(ehpb)
4248 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4250 implicit real*8 (a-h,o-z)
4251 include 'DIMENSIONS'
4252 include 'COMMON.SBRIDGE'
4253 include 'COMMON.CHAIN'
4254 include 'COMMON.DERIV'
4255 include 'COMMON.VAR'
4256 include 'COMMON.INTERACT'
4257 include 'COMMON.IOUNITS'
4260 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4261 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4262 if (link_end.eq.0) return
4263 do i=link_start,link_end
4264 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4265 C CA-CA distance used in regularization of structure.
4268 C iii and jjj point to the residues for which the distance is assigned.
4269 if (ii.gt.nres) then
4276 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4277 c & dhpb(i),dhpb1(i),forcon(i)
4278 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4279 C distance and angle dependent SS bond potential.
4280 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4281 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4282 c if (.not.dyn_ss .and. i.le.nss) then
4283 C 15/02/13 CC dynamic SSbond
4284 if (.not.dyn_ss.and.
4285 & ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4286 call ssbond_ene(iii,jjj,eij)
4288 cd write (iout,*) "eij",eij
4289 else if (ii.gt.nres .and. jj.gt.nres) then
4290 c Restraints from contact prediction
4292 if (dhpb1(i).gt.0.0d0) then
4293 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4294 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4295 c write (iout,*) "beta nmr",
4296 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4300 C Get the force constant corresponding to this distance.
4302 C Calculate the contribution to energy.
4303 ehpb=ehpb+waga*rdis*rdis
4304 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4306 C Evaluate gradient.
4311 ggg(j)=fac*(c(j,jj)-c(j,ii))
4314 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4315 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4318 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4319 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4322 C Calculate the distance between the two points and its difference from the
4325 if (dhpb1(i).gt.0.0d0) then
4326 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4327 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4328 c write (iout,*) "alph nmr",
4329 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4332 C Get the force constant corresponding to this distance.
4334 C Calculate the contribution to energy.
4335 ehpb=ehpb+waga*rdis*rdis
4336 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4338 C Evaluate gradient.
4342 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4343 cd & ' waga=',waga,' fac=',fac
4345 ggg(j)=fac*(c(j,jj)-c(j,ii))
4347 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4348 C If this is a SC-SC distance, we need to calculate the contributions to the
4349 C Cartesian gradient in the SC vectors (ghpbx).
4352 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4353 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4356 cgrad do j=iii,jjj-1
4358 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4362 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4363 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4370 C--------------------------------------------------------------------------
4371 subroutine ssbond_ene(i,j,eij)
4373 C Calculate the distance and angle dependent SS-bond potential energy
4374 C using a free-energy function derived based on RHF/6-31G** ab initio
4375 C calculations of diethyl disulfide.
4377 C A. Liwo and U. Kozlowska, 11/24/03
4379 implicit real*8 (a-h,o-z)
4380 include 'DIMENSIONS'
4381 include 'COMMON.SBRIDGE'
4382 include 'COMMON.CHAIN'
4383 include 'COMMON.DERIV'
4384 include 'COMMON.LOCAL'
4385 include 'COMMON.INTERACT'
4386 include 'COMMON.VAR'
4387 include 'COMMON.IOUNITS'
4388 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4393 dxi=dc_norm(1,nres+i)
4394 dyi=dc_norm(2,nres+i)
4395 dzi=dc_norm(3,nres+i)
4396 c dsci_inv=dsc_inv(itypi)
4397 dsci_inv=vbld_inv(nres+i)
4399 c dscj_inv=dsc_inv(itypj)
4400 dscj_inv=vbld_inv(nres+j)
4404 dxj=dc_norm(1,nres+j)
4405 dyj=dc_norm(2,nres+j)
4406 dzj=dc_norm(3,nres+j)
4407 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4412 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4413 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4414 om12=dxi*dxj+dyi*dyj+dzi*dzj
4416 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4417 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4423 deltat12=om2-om1+2.0d0
4425 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4426 & +akct*deltad*deltat12
4427 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4428 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4429 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4430 c & " deltat12",deltat12," eij",eij
4431 ed=2*akcm*deltad+akct*deltat12
4433 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4434 eom1=-2*akth*deltat1-pom1-om2*pom2
4435 eom2= 2*akth*deltat2+pom1-om1*pom2
4438 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4439 ghpbx(k,i)=ghpbx(k,i)-ggk
4440 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4441 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4442 ghpbx(k,j)=ghpbx(k,j)+ggk
4443 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4444 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4445 ghpbc(k,i)=ghpbc(k,i)-ggk
4446 ghpbc(k,j)=ghpbc(k,j)+ggk
4449 C Calculate the components of the gradient in DC and X
4453 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4458 C--------------------------------------------------------------------------
4459 subroutine ebond(estr)
4461 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4463 implicit real*8 (a-h,o-z)
4464 include 'DIMENSIONS'
4465 include 'COMMON.LOCAL'
4466 include 'COMMON.GEO'
4467 include 'COMMON.INTERACT'
4468 include 'COMMON.DERIV'
4469 include 'COMMON.VAR'
4470 include 'COMMON.CHAIN'
4471 include 'COMMON.IOUNITS'
4472 include 'COMMON.NAMES'
4473 include 'COMMON.FFIELD'
4474 include 'COMMON.CONTROL'
4475 include 'COMMON.SETUP'
4476 double precision u(3),ud(3)
4478 do i=ibondp_start,ibondp_end
4479 diff = vbld(i)-vbldp0
4480 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4483 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4485 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4489 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4491 do i=ibond_start,ibond_end
4496 diff=vbld(i+nres)-vbldsc0(1,iti)
4497 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4498 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4499 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4501 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4505 diff=vbld(i+nres)-vbldsc0(j,iti)
4506 ud(j)=aksc(j,iti)*diff
4507 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4521 uprod2=uprod2*u(k)*u(k)
4525 usumsqder=usumsqder+ud(j)*uprod2
4527 estr=estr+uprod/usum
4529 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4537 C--------------------------------------------------------------------------
4538 subroutine ebend(etheta)
4540 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4541 C angles gamma and its derivatives in consecutive thetas and gammas.
4543 implicit real*8 (a-h,o-z)
4544 include 'DIMENSIONS'
4545 include 'COMMON.LOCAL'
4546 include 'COMMON.GEO'
4547 include 'COMMON.INTERACT'
4548 include 'COMMON.DERIV'
4549 include 'COMMON.VAR'
4550 include 'COMMON.CHAIN'
4551 include 'COMMON.IOUNITS'
4552 include 'COMMON.NAMES'
4553 include 'COMMON.FFIELD'
4554 include 'COMMON.CONTROL'
4555 common /calcthet/ term1,term2,termm,diffak,ratak,
4556 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4557 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4558 double precision y(2),z(2)
4560 c time11=dexp(-2*time)
4563 c write (*,'(a,i2)') 'EBEND ICG=',icg
4564 do i=ithet_start,ithet_end
4565 C Zero the energy function and its derivative at 0 or pi.
4566 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4571 if (phii.ne.phii) phii=150.0
4584 if (phii1.ne.phii1) phii1=150.0
4596 C Calculate the "mean" value of theta from the part of the distribution
4597 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4598 C In following comments this theta will be referred to as t_c.
4599 thet_pred_mean=0.0d0
4603 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4605 dthett=thet_pred_mean*ssd
4606 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4607 C Derivatives of the "mean" values in gamma1 and gamma2.
4608 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4609 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4610 if (theta(i).gt.pi-delta) then
4611 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4613 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4614 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4615 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4617 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4619 else if (theta(i).lt.delta) then
4620 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4621 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4622 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4624 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4625 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4628 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4631 etheta=etheta+ethetai
4632 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4634 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4635 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4636 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4638 C Ufff.... We've done all this!!!
4641 C---------------------------------------------------------------------------
4642 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4644 implicit real*8 (a-h,o-z)
4645 include 'DIMENSIONS'
4646 include 'COMMON.LOCAL'
4647 include 'COMMON.IOUNITS'
4648 common /calcthet/ term1,term2,termm,diffak,ratak,
4649 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4650 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4651 C Calculate the contributions to both Gaussian lobes.
4652 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4653 C The "polynomial part" of the "standard deviation" of this part of
4657 sig=sig*thet_pred_mean+polthet(j,it)
4659 C Derivative of the "interior part" of the "standard deviation of the"
4660 C gamma-dependent Gaussian lobe in t_c.
4661 sigtc=3*polthet(3,it)
4663 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4666 C Set the parameters of both Gaussian lobes of the distribution.
4667 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4668 fac=sig*sig+sigc0(it)
4671 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4672 sigsqtc=-4.0D0*sigcsq*sigtc
4673 c print *,i,sig,sigtc,sigsqtc
4674 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4675 sigtc=-sigtc/(fac*fac)
4676 C Following variable is sigma(t_c)**(-2)
4677 sigcsq=sigcsq*sigcsq
4679 sig0inv=1.0D0/sig0i**2
4680 delthec=thetai-thet_pred_mean
4681 delthe0=thetai-theta0i
4682 term1=-0.5D0*sigcsq*delthec*delthec
4683 term2=-0.5D0*sig0inv*delthe0*delthe0
4684 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4685 C NaNs in taking the logarithm. We extract the largest exponent which is added
4686 C to the energy (this being the log of the distribution) at the end of energy
4687 C term evaluation for this virtual-bond angle.
4688 if (term1.gt.term2) then
4690 term2=dexp(term2-termm)
4694 term1=dexp(term1-termm)
4697 C The ratio between the gamma-independent and gamma-dependent lobes of
4698 C the distribution is a Gaussian function of thet_pred_mean too.
4699 diffak=gthet(2,it)-thet_pred_mean
4700 ratak=diffak/gthet(3,it)**2
4701 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4702 C Let's differentiate it in thet_pred_mean NOW.
4704 C Now put together the distribution terms to make complete distribution.
4705 termexp=term1+ak*term2
4706 termpre=sigc+ak*sig0i
4707 C Contribution of the bending energy from this theta is just the -log of
4708 C the sum of the contributions from the two lobes and the pre-exponential
4709 C factor. Simple enough, isn't it?
4710 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4711 C NOW the derivatives!!!
4712 C 6/6/97 Take into account the deformation.
4713 E_theta=(delthec*sigcsq*term1
4714 & +ak*delthe0*sig0inv*term2)/termexp
4715 E_tc=((sigtc+aktc*sig0i)/termpre
4716 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4717 & aktc*term2)/termexp)
4720 c-----------------------------------------------------------------------------
4721 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4722 implicit real*8 (a-h,o-z)
4723 include 'DIMENSIONS'
4724 include 'COMMON.LOCAL'
4725 include 'COMMON.IOUNITS'
4726 common /calcthet/ term1,term2,termm,diffak,ratak,
4727 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4728 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4729 delthec=thetai-thet_pred_mean
4730 delthe0=thetai-theta0i
4731 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4732 t3 = thetai-thet_pred_mean
4736 t14 = t12+t6*sigsqtc
4738 t21 = thetai-theta0i
4744 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4745 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4746 & *(-t12*t9-ak*sig0inv*t27)
4750 C--------------------------------------------------------------------------
4751 subroutine ebend(etheta)
4753 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4754 C angles gamma and its derivatives in consecutive thetas and gammas.
4755 C ab initio-derived potentials from
4756 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4758 implicit real*8 (a-h,o-z)
4759 include 'DIMENSIONS'
4760 include 'COMMON.LOCAL'
4761 include 'COMMON.GEO'
4762 include 'COMMON.INTERACT'
4763 include 'COMMON.DERIV'
4764 include 'COMMON.VAR'
4765 include 'COMMON.CHAIN'
4766 include 'COMMON.IOUNITS'
4767 include 'COMMON.NAMES'
4768 include 'COMMON.FFIELD'
4769 include 'COMMON.CONTROL'
4770 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4771 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4772 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4773 & sinph1ph2(maxdouble,maxdouble)
4774 logical lprn /.false./, lprn1 /.false./
4776 do i=ithet_start,ithet_end
4780 theti2=0.5d0*theta(i)
4781 ityp2=ithetyp(itype(i-1))
4783 coskt(k)=dcos(k*theti2)
4784 sinkt(k)=dsin(k*theti2)
4789 if (phii.ne.phii) phii=150.0
4793 ityp1=ithetyp(itype(i-2))
4795 cosph1(k)=dcos(k*phii)
4796 sinph1(k)=dsin(k*phii)
4809 if (phii1.ne.phii1) phii1=150.0
4814 ityp3=ithetyp(itype(i))
4816 cosph2(k)=dcos(k*phii1)
4817 sinph2(k)=dsin(k*phii1)
4827 ethetai=aa0thet(ityp1,ityp2,ityp3)
4830 ccl=cosph1(l)*cosph2(k-l)
4831 ssl=sinph1(l)*sinph2(k-l)
4832 scl=sinph1(l)*cosph2(k-l)
4833 csl=cosph1(l)*sinph2(k-l)
4834 cosph1ph2(l,k)=ccl-ssl
4835 cosph1ph2(k,l)=ccl+ssl
4836 sinph1ph2(l,k)=scl+csl
4837 sinph1ph2(k,l)=scl-csl
4841 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4842 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4843 write (iout,*) "coskt and sinkt"
4845 write (iout,*) k,coskt(k),sinkt(k)
4849 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4850 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4853 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4854 & " ethetai",ethetai
4857 write (iout,*) "cosph and sinph"
4859 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4861 write (iout,*) "cosph1ph2 and sinph2ph2"
4864 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4865 & sinph1ph2(l,k),sinph1ph2(k,l)
4868 write(iout,*) "ethetai",ethetai
4872 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4873 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4874 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4875 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4876 ethetai=ethetai+sinkt(m)*aux
4877 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4878 dephii=dephii+k*sinkt(m)*(
4879 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4880 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4881 dephii1=dephii1+k*sinkt(m)*(
4882 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4883 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4885 & write (iout,*) "m",m," k",k," bbthet",
4886 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4887 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4888 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4889 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4893 & write(iout,*) "ethetai",ethetai
4897 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4898 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4899 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4900 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4901 ethetai=ethetai+sinkt(m)*aux
4902 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4903 dephii=dephii+l*sinkt(m)*(
4904 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4905 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4906 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4907 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4908 dephii1=dephii1+(k-l)*sinkt(m)*(
4909 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4910 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4911 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4912 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4914 write (iout,*) "m",m," k",k," l",l," ffthet",
4915 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4916 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4917 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4918 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4919 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4920 & cosph1ph2(k,l)*sinkt(m),
4921 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4927 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4928 & i,theta(i)*rad2deg,phii*rad2deg,
4929 & phii1*rad2deg,ethetai
4930 etheta=etheta+ethetai
4931 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4932 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4933 gloc(nphi+i-2,icg)=wang*dethetai
4939 c-----------------------------------------------------------------------------
4940 subroutine esc(escloc)
4941 C Calculate the local energy of a side chain and its derivatives in the
4942 C corresponding virtual-bond valence angles THETA and the spherical angles
4944 implicit real*8 (a-h,o-z)
4945 include 'DIMENSIONS'
4946 include 'COMMON.GEO'
4947 include 'COMMON.LOCAL'
4948 include 'COMMON.VAR'
4949 include 'COMMON.INTERACT'
4950 include 'COMMON.DERIV'
4951 include 'COMMON.CHAIN'
4952 include 'COMMON.IOUNITS'
4953 include 'COMMON.NAMES'
4954 include 'COMMON.FFIELD'
4955 include 'COMMON.CONTROL'
4956 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4957 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4958 common /sccalc/ time11,time12,time112,theti,it,nlobit
4961 c write (iout,'(a)') 'ESC'
4962 do i=loc_start,loc_end
4964 if (it.eq.10) goto 1
4966 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4967 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4968 theti=theta(i+1)-pipol
4973 if (x(2).gt.pi-delta) then
4977 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4979 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4980 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4982 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4983 & ddersc0(1),dersc(1))
4984 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4985 & ddersc0(3),dersc(3))
4987 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4989 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4990 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4991 & dersc0(2),esclocbi,dersc02)
4992 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4994 call splinthet(x(2),0.5d0*delta,ss,ssd)
4999 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5001 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5002 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5004 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5006 c write (iout,*) escloci
5007 else if (x(2).lt.delta) then
5011 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5013 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5014 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5016 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5017 & ddersc0(1),dersc(1))
5018 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5019 & ddersc0(3),dersc(3))
5021 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5023 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5024 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5025 & dersc0(2),esclocbi,dersc02)
5026 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5031 call splinthet(x(2),0.5d0*delta,ss,ssd)
5033 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5035 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5036 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5038 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5039 c write (iout,*) escloci
5041 call enesc(x,escloci,dersc,ddummy,.false.)
5044 escloc=escloc+escloci
5045 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5046 & 'escloc',i,escloci
5047 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5049 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5051 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5052 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5057 C---------------------------------------------------------------------------
5058 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5059 implicit real*8 (a-h,o-z)
5060 include 'DIMENSIONS'
5061 include 'COMMON.GEO'
5062 include 'COMMON.LOCAL'
5063 include 'COMMON.IOUNITS'
5064 common /sccalc/ time11,time12,time112,theti,it,nlobit
5065 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5066 double precision contr(maxlob,-1:1)
5068 c write (iout,*) 'it=',it,' nlobit=',nlobit
5072 if (mixed) ddersc(j)=0.0d0
5076 C Because of periodicity of the dependence of the SC energy in omega we have
5077 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5078 C To avoid underflows, first compute & store the exponents.
5086 z(k)=x(k)-censc(k,j,it)
5091 Axk=Axk+gaussc(l,k,j,it)*z(l)
5097 expfac=expfac+Ax(k,j,iii)*z(k)
5105 C As in the case of ebend, we want to avoid underflows in exponentiation and
5106 C subsequent NaNs and INFs in energy calculation.
5107 C Find the largest exponent
5111 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5115 cd print *,'it=',it,' emin=',emin
5117 C Compute the contribution to SC energy and derivatives
5122 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5123 if(adexp.ne.adexp) adexp=1.0
5126 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5128 cd print *,'j=',j,' expfac=',expfac
5129 escloc_i=escloc_i+expfac
5131 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5135 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5136 & +gaussc(k,2,j,it))*expfac
5143 dersc(1)=dersc(1)/cos(theti)**2
5144 ddersc(1)=ddersc(1)/cos(theti)**2
5147 escloci=-(dlog(escloc_i)-emin)
5149 dersc(j)=dersc(j)/escloc_i
5153 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5158 C------------------------------------------------------------------------------
5159 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5160 implicit real*8 (a-h,o-z)
5161 include 'DIMENSIONS'
5162 include 'COMMON.GEO'
5163 include 'COMMON.LOCAL'
5164 include 'COMMON.IOUNITS'
5165 common /sccalc/ time11,time12,time112,theti,it,nlobit
5166 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5167 double precision contr(maxlob)
5178 z(k)=x(k)-censc(k,j,it)
5184 Axk=Axk+gaussc(l,k,j,it)*z(l)
5190 expfac=expfac+Ax(k,j)*z(k)
5195 C As in the case of ebend, we want to avoid underflows in exponentiation and
5196 C subsequent NaNs and INFs in energy calculation.
5197 C Find the largest exponent
5200 if (emin.gt.contr(j)) emin=contr(j)
5204 C Compute the contribution to SC energy and derivatives
5208 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5209 escloc_i=escloc_i+expfac
5211 dersc(k)=dersc(k)+Ax(k,j)*expfac
5213 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5214 & +gaussc(1,2,j,it))*expfac
5218 dersc(1)=dersc(1)/cos(theti)**2
5219 dersc12=dersc12/cos(theti)**2
5220 escloci=-(dlog(escloc_i)-emin)
5222 dersc(j)=dersc(j)/escloc_i
5224 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5228 c----------------------------------------------------------------------------------
5229 subroutine esc(escloc)
5230 C Calculate the local energy of a side chain and its derivatives in the
5231 C corresponding virtual-bond valence angles THETA and the spherical angles
5232 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5233 C added by Urszula Kozlowska. 07/11/2007
5235 implicit real*8 (a-h,o-z)
5236 include 'DIMENSIONS'
5237 include 'COMMON.GEO'
5238 include 'COMMON.LOCAL'
5239 include 'COMMON.VAR'
5240 include 'COMMON.SCROT'
5241 include 'COMMON.INTERACT'
5242 include 'COMMON.DERIV'
5243 include 'COMMON.CHAIN'
5244 include 'COMMON.IOUNITS'
5245 include 'COMMON.NAMES'
5246 include 'COMMON.FFIELD'
5247 include 'COMMON.CONTROL'
5248 include 'COMMON.VECTORS'
5249 double precision x_prime(3),y_prime(3),z_prime(3)
5250 & , sumene,dsc_i,dp2_i,x(65),
5251 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5252 & de_dxx,de_dyy,de_dzz,de_dt
5253 double precision s1_t,s1_6_t,s2_t,s2_6_t
5255 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5256 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5257 & dt_dCi(3),dt_dCi1(3)
5258 common /sccalc/ time11,time12,time112,theti,it,nlobit
5261 do i=loc_start,loc_end
5262 costtab(i+1) =dcos(theta(i+1))
5263 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5264 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5265 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5266 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5267 cosfac=dsqrt(cosfac2)
5268 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5269 sinfac=dsqrt(sinfac2)
5271 if (it.eq.10) goto 1
5273 C Compute the axes of tghe local cartesian coordinates system; store in
5274 c x_prime, y_prime and z_prime
5281 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5282 C & dc_norm(3,i+nres)
5284 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5285 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5288 z_prime(j) = -uz(j,i-1)
5291 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5292 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5293 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5294 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5295 c & " xy",scalar(x_prime(1),y_prime(1)),
5296 c & " xz",scalar(x_prime(1),z_prime(1)),
5297 c & " yy",scalar(y_prime(1),y_prime(1)),
5298 c & " yz",scalar(y_prime(1),z_prime(1)),
5299 c & " zz",scalar(z_prime(1),z_prime(1))
5301 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5302 C to local coordinate system. Store in xx, yy, zz.
5308 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5309 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5310 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5317 C Compute the energy of the ith side cbain
5319 c write (2,*) "xx",xx," yy",yy," zz",zz
5322 x(j) = sc_parmin(j,it)
5325 Cc diagnostics - remove later
5327 yy1 = dsin(alph(2))*dcos(omeg(2))
5328 zz1 = -dsin(alph(2))*dsin(omeg(2))
5329 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5330 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5332 C," --- ", xx_w,yy_w,zz_w
5335 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5336 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5338 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5339 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5341 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5342 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5343 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5344 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5345 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5347 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5348 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5349 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5350 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5351 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5353 dsc_i = 0.743d0+x(61)
5355 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5356 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5357 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5358 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5359 s1=(1+x(63))/(0.1d0 + dscp1)
5360 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5361 s2=(1+x(65))/(0.1d0 + dscp2)
5362 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5363 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5364 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5365 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5367 c & dscp1,dscp2,sumene
5368 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5369 escloc = escloc + sumene
5370 c write (2,*) "i",i," escloc",sumene,escloc
5373 C This section to check the numerical derivatives of the energy of ith side
5374 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5375 C #define DEBUG in the code to turn it on.
5377 write (2,*) "sumene =",sumene
5381 write (2,*) xx,yy,zz
5382 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5383 de_dxx_num=(sumenep-sumene)/aincr
5385 write (2,*) "xx+ sumene from enesc=",sumenep
5388 write (2,*) xx,yy,zz
5389 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5390 de_dyy_num=(sumenep-sumene)/aincr
5392 write (2,*) "yy+ sumene from enesc=",sumenep
5395 write (2,*) xx,yy,zz
5396 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5397 de_dzz_num=(sumenep-sumene)/aincr
5399 write (2,*) "zz+ sumene from enesc=",sumenep
5400 costsave=cost2tab(i+1)
5401 sintsave=sint2tab(i+1)
5402 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5403 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5404 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5405 de_dt_num=(sumenep-sumene)/aincr
5406 write (2,*) " t+ sumene from enesc=",sumenep
5407 cost2tab(i+1)=costsave
5408 sint2tab(i+1)=sintsave
5409 C End of diagnostics section.
5412 C Compute the gradient of esc
5414 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5415 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5416 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5417 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5418 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5419 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5420 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5421 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5422 pom1=(sumene3*sint2tab(i+1)+sumene1)
5423 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5424 pom2=(sumene4*cost2tab(i+1)+sumene2)
5425 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5426 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5427 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5428 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5430 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5431 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5432 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5434 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5435 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5436 & +(pom1+pom2)*pom_dx
5438 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5441 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5442 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5443 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5445 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5446 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5447 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5448 & +x(59)*zz**2 +x(60)*xx*zz
5449 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5450 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5451 & +(pom1-pom2)*pom_dy
5453 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5456 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5457 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5458 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5459 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5460 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5461 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5462 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5463 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5465 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5468 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5469 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5470 & +pom1*pom_dt1+pom2*pom_dt2
5472 write(2,*), "de_dt = ", de_dt,de_dt_num
5476 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5477 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5478 cosfac2xx=cosfac2*xx
5479 sinfac2yy=sinfac2*yy
5481 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5483 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5485 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5486 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5487 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5488 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5489 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5490 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5491 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5492 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5493 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5494 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5498 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5499 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5502 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5503 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5504 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5506 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5507 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5511 dXX_Ctab(k,i)=dXX_Ci(k)
5512 dXX_C1tab(k,i)=dXX_Ci1(k)
5513 dYY_Ctab(k,i)=dYY_Ci(k)
5514 dYY_C1tab(k,i)=dYY_Ci1(k)
5515 dZZ_Ctab(k,i)=dZZ_Ci(k)
5516 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5517 dXX_XYZtab(k,i)=dXX_XYZ(k)
5518 dYY_XYZtab(k,i)=dYY_XYZ(k)
5519 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5523 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5524 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5525 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5526 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5527 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5529 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5530 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5531 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5532 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5533 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5534 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5535 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5536 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5538 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5539 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5541 C to check gradient call subroutine check_grad
5547 c------------------------------------------------------------------------------
5548 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5550 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5551 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5552 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5553 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5555 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5556 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5558 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5559 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5560 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5561 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5562 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5564 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5565 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5566 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5567 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5568 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5570 dsc_i = 0.743d0+x(61)
5572 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5573 & *(xx*cost2+yy*sint2))
5574 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5575 & *(xx*cost2-yy*sint2))
5576 s1=(1+x(63))/(0.1d0 + dscp1)
5577 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5578 s2=(1+x(65))/(0.1d0 + dscp2)
5579 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5580 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5581 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5586 c------------------------------------------------------------------------------
5587 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5589 C This procedure calculates two-body contact function g(rij) and its derivative:
5592 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5595 C where x=(rij-r0ij)/delta
5597 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5600 double precision rij,r0ij,eps0ij,fcont,fprimcont
5601 double precision x,x2,x4,delta
5605 if (x.lt.-1.0D0) then
5608 else if (x.le.1.0D0) then
5611 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5612 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5619 c------------------------------------------------------------------------------
5620 subroutine splinthet(theti,delta,ss,ssder)
5621 implicit real*8 (a-h,o-z)
5622 include 'DIMENSIONS'
5623 include 'COMMON.VAR'
5624 include 'COMMON.GEO'
5627 if (theti.gt.pipol) then
5628 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5630 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5635 c------------------------------------------------------------------------------
5636 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5638 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5639 double precision ksi,ksi2,ksi3,a1,a2,a3
5640 a1=fprim0*delta/(f1-f0)
5646 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5647 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5650 c------------------------------------------------------------------------------
5651 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5653 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5654 double precision ksi,ksi2,ksi3,a1,a2,a3
5659 a2=3*(f1x-f0x)-2*fprim0x*delta
5660 a3=fprim0x*delta-2*(f1x-f0x)
5661 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5664 C-----------------------------------------------------------------------------
5666 C-----------------------------------------------------------------------------
5667 subroutine etor(etors,edihcnstr)
5668 implicit real*8 (a-h,o-z)
5669 include 'DIMENSIONS'
5670 include 'COMMON.VAR'
5671 include 'COMMON.GEO'
5672 include 'COMMON.LOCAL'
5673 include 'COMMON.TORSION'
5674 include 'COMMON.INTERACT'
5675 include 'COMMON.DERIV'
5676 include 'COMMON.CHAIN'
5677 include 'COMMON.NAMES'
5678 include 'COMMON.IOUNITS'
5679 include 'COMMON.FFIELD'
5680 include 'COMMON.TORCNSTR'
5681 include 'COMMON.CONTROL'
5683 C Set lprn=.true. for debugging
5687 do i=iphi_start,iphi_end
5689 itori=itortyp(itype(i-2))
5690 itori1=itortyp(itype(i-1))
5693 C Proline-Proline pair is a special case...
5694 if (itori.eq.3 .and. itori1.eq.3) then
5695 if (phii.gt.-dwapi3) then
5697 fac=1.0D0/(1.0D0-cosphi)
5698 etorsi=v1(1,3,3)*fac
5699 etorsi=etorsi+etorsi
5700 etors=etors+etorsi-v1(1,3,3)
5701 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5702 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5705 v1ij=v1(j+1,itori,itori1)
5706 v2ij=v2(j+1,itori,itori1)
5709 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5710 if (energy_dec) etors_ii=etors_ii+
5711 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5712 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5716 v1ij=v1(j,itori,itori1)
5717 v2ij=v2(j,itori,itori1)
5720 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5721 if (energy_dec) etors_ii=etors_ii+
5722 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5723 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5726 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5729 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5730 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5731 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5732 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5733 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5735 ! 6/20/98 - dihedral angle constraints
5738 itori=idih_constr(i)
5741 if (difi.gt.drange(i)) then
5743 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5744 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5745 else if (difi.lt.-drange(i)) then
5747 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5748 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5750 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5751 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5753 ! write (iout,*) 'edihcnstr',edihcnstr
5756 c------------------------------------------------------------------------------
5757 subroutine etor_d(etors_d)
5761 c----------------------------------------------------------------------------
5763 subroutine etor(etors,edihcnstr)
5764 implicit real*8 (a-h,o-z)
5765 include 'DIMENSIONS'
5766 include 'COMMON.VAR'
5767 include 'COMMON.GEO'
5768 include 'COMMON.LOCAL'
5769 include 'COMMON.TORSION'
5770 include 'COMMON.INTERACT'
5771 include 'COMMON.DERIV'
5772 include 'COMMON.CHAIN'
5773 include 'COMMON.NAMES'
5774 include 'COMMON.IOUNITS'
5775 include 'COMMON.FFIELD'
5776 include 'COMMON.TORCNSTR'
5777 include 'COMMON.CONTROL'
5779 C Set lprn=.true. for debugging
5783 do i=iphi_start,iphi_end
5785 itori=itortyp(itype(i-2))
5786 itori1=itortyp(itype(i-1))
5789 C Regular cosine and sine terms
5790 do j=1,nterm(itori,itori1)
5791 v1ij=v1(j,itori,itori1)
5792 v2ij=v2(j,itori,itori1)
5795 etors=etors+v1ij*cosphi+v2ij*sinphi
5796 if (energy_dec) etors_ii=etors_ii+
5797 & v1ij*cosphi+v2ij*sinphi
5798 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5802 C E = SUM ----------------------------------- - v1
5803 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5805 cosphi=dcos(0.5d0*phii)
5806 sinphi=dsin(0.5d0*phii)
5807 do j=1,nlor(itori,itori1)
5808 vl1ij=vlor1(j,itori,itori1)
5809 vl2ij=vlor2(j,itori,itori1)
5810 vl3ij=vlor3(j,itori,itori1)
5811 pom=vl2ij*cosphi+vl3ij*sinphi
5812 pom1=1.0d0/(pom*pom+1.0d0)
5813 etors=etors+vl1ij*pom1
5814 if (energy_dec) etors_ii=etors_ii+
5817 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5819 C Subtract the constant term
5820 etors=etors-v0(itori,itori1)
5821 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5822 & 'etor',i,etors_ii-v0(itori,itori1)
5824 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5825 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5826 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5827 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5828 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5830 ! 6/20/98 - dihedral angle constraints
5832 c do i=1,ndih_constr
5833 do i=idihconstr_start,idihconstr_end
5834 itori=idih_constr(i)
5836 difi=pinorm(phii-phi0(i))
5837 if (difi.gt.drange(i)) then
5839 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5840 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5841 else if (difi.lt.-drange(i)) then
5843 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5844 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5848 c write (iout,*) "gloci", gloc(i-3,icg)
5849 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5850 cd & rad2deg*phi0(i), rad2deg*drange(i),
5851 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5853 cd write (iout,*) 'edihcnstr',edihcnstr
5856 c----------------------------------------------------------------------------
5857 subroutine etor_d(etors_d)
5858 C 6/23/01 Compute double torsional energy
5859 implicit real*8 (a-h,o-z)
5860 include 'DIMENSIONS'
5861 include 'COMMON.VAR'
5862 include 'COMMON.GEO'
5863 include 'COMMON.LOCAL'
5864 include 'COMMON.TORSION'
5865 include 'COMMON.INTERACT'
5866 include 'COMMON.DERIV'
5867 include 'COMMON.CHAIN'
5868 include 'COMMON.NAMES'
5869 include 'COMMON.IOUNITS'
5870 include 'COMMON.FFIELD'
5871 include 'COMMON.TORCNSTR'
5873 C Set lprn=.true. for debugging
5877 do i=iphid_start,iphid_end
5878 itori=itortyp(itype(i-2))
5879 itori1=itortyp(itype(i-1))
5880 itori2=itortyp(itype(i))
5885 do j=1,ntermd_1(itori,itori1,itori2)
5886 v1cij=v1c(1,j,itori,itori1,itori2)
5887 v1sij=v1s(1,j,itori,itori1,itori2)
5888 v2cij=v1c(2,j,itori,itori1,itori2)
5889 v2sij=v1s(2,j,itori,itori1,itori2)
5890 cosphi1=dcos(j*phii)
5891 sinphi1=dsin(j*phii)
5892 cosphi2=dcos(j*phii1)
5893 sinphi2=dsin(j*phii1)
5894 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5895 & v2cij*cosphi2+v2sij*sinphi2
5896 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5897 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5899 do k=2,ntermd_2(itori,itori1,itori2)
5901 v1cdij = v2c(k,l,itori,itori1,itori2)
5902 v2cdij = v2c(l,k,itori,itori1,itori2)
5903 v1sdij = v2s(k,l,itori,itori1,itori2)
5904 v2sdij = v2s(l,k,itori,itori1,itori2)
5905 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5906 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5907 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5908 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5909 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5910 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5911 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5912 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5913 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5914 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5917 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5918 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5919 c write (iout,*) "gloci", gloc(i-3,icg)
5924 c------------------------------------------------------------------------------
5925 subroutine eback_sc_corr(esccor)
5926 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5927 c conformational states; temporarily implemented as differences
5928 c between UNRES torsional potentials (dependent on three types of
5929 c residues) and the torsional potentials dependent on all 20 types
5930 c of residues computed from AM1 energy surfaces of terminally-blocked
5931 c amino-acid residues.
5932 implicit real*8 (a-h,o-z)
5933 include 'DIMENSIONS'
5934 include 'COMMON.VAR'
5935 include 'COMMON.GEO'
5936 include 'COMMON.LOCAL'
5937 include 'COMMON.TORSION'
5938 include 'COMMON.SCCOR'
5939 include 'COMMON.INTERACT'
5940 include 'COMMON.DERIV'
5941 include 'COMMON.CHAIN'
5942 include 'COMMON.NAMES'
5943 include 'COMMON.IOUNITS'
5944 include 'COMMON.FFIELD'
5945 include 'COMMON.CONTROL'
5947 C Set lprn=.true. for debugging
5950 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5952 do i=itau_start,itau_end
5954 isccori=isccortyp(itype(i-2))
5955 isccori1=isccortyp(itype(i-1))
5957 cccc Added 9 May 2012
5958 cc Tauangle is torsional engle depending on the value of first digit
5959 c(see comment below)
5960 cc Omicron is flat angle depending on the value of first digit
5961 c(see comment below)
5964 do intertyp=1,3 !intertyp
5965 cc Added 09 May 2012 (Adasko)
5966 cc Intertyp means interaction type of backbone mainchain correlation:
5967 c 1 = SC...Ca...Ca...Ca
5968 c 2 = Ca...Ca...Ca...SC
5969 c 3 = SC...Ca...Ca...SCi
5971 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5972 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5973 & (itype(i-1).eq.21)))
5974 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5975 & .or.(itype(i-2).eq.21)))
5976 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5977 & (itype(i-1).eq.21)))) cycle
5978 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5979 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5981 do j=1,nterm_sccor(isccori,isccori1)
5982 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5983 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5984 cosphi=dcos(j*tauangle(intertyp,i))
5985 sinphi=dsin(j*tauangle(intertyp,i))
5986 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5987 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5989 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5990 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5991 c &gloc_sc(intertyp,i-3,icg)
5993 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5994 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5995 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5996 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5997 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6001 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6005 c----------------------------------------------------------------------------
6006 subroutine multibody(ecorr)
6007 C This subroutine calculates multi-body contributions to energy following
6008 C the idea of Skolnick et al. If side chains I and J make a contact and
6009 C at the same time side chains I+1 and J+1 make a contact, an extra
6010 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6011 implicit real*8 (a-h,o-z)
6012 include 'DIMENSIONS'
6013 include 'COMMON.IOUNITS'
6014 include 'COMMON.DERIV'
6015 include 'COMMON.INTERACT'
6016 include 'COMMON.CONTACTS'
6017 double precision gx(3),gx1(3)
6020 C Set lprn=.true. for debugging
6024 write (iout,'(a)') 'Contact function values:'
6026 write (iout,'(i2,20(1x,i2,f10.5))')
6027 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6042 num_conti=num_cont(i)
6043 num_conti1=num_cont(i1)
6048 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6049 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6050 cd & ' ishift=',ishift
6051 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6052 C The system gains extra energy.
6053 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6054 endif ! j1==j+-ishift
6063 c------------------------------------------------------------------------------
6064 double precision function esccorr(i,j,k,l,jj,kk)
6065 implicit real*8 (a-h,o-z)
6066 include 'DIMENSIONS'
6067 include 'COMMON.IOUNITS'
6068 include 'COMMON.DERIV'
6069 include 'COMMON.INTERACT'
6070 include 'COMMON.CONTACTS'
6071 double precision gx(3),gx1(3)
6076 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6077 C Calculate the multi-body contribution to energy.
6078 C Calculate multi-body contributions to the gradient.
6079 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6080 cd & k,l,(gacont(m,kk,k),m=1,3)
6082 gx(m) =ekl*gacont(m,jj,i)
6083 gx1(m)=eij*gacont(m,kk,k)
6084 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6085 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6086 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6087 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6091 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6096 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6102 c------------------------------------------------------------------------------
6103 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6104 C This subroutine calculates multi-body contributions to hydrogen-bonding
6105 implicit real*8 (a-h,o-z)
6106 include 'DIMENSIONS'
6107 include 'COMMON.IOUNITS'
6110 parameter (max_cont=maxconts)
6111 parameter (max_dim=26)
6112 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6113 double precision zapas(max_dim,maxconts,max_fg_procs),
6114 & zapas_recv(max_dim,maxconts,max_fg_procs)
6115 common /przechowalnia/ zapas
6116 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6117 & status_array(MPI_STATUS_SIZE,maxconts*2)
6119 include 'COMMON.SETUP'
6120 include 'COMMON.FFIELD'
6121 include 'COMMON.DERIV'
6122 include 'COMMON.INTERACT'
6123 include 'COMMON.CONTACTS'
6124 include 'COMMON.CONTROL'
6125 include 'COMMON.LOCAL'
6126 double precision gx(3),gx1(3),time00
6129 C Set lprn=.true. for debugging
6134 if (nfgtasks.le.1) goto 30
6136 write (iout,'(a)') 'Contact function values before RECEIVE:'
6138 write (iout,'(2i3,50(1x,i2,f5.2))')
6139 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6140 & j=1,num_cont_hb(i))
6144 do i=1,ntask_cont_from
6147 do i=1,ntask_cont_to
6150 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6152 C Make the list of contacts to send to send to other procesors
6153 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6155 do i=iturn3_start,iturn3_end
6156 c write (iout,*) "make contact list turn3",i," num_cont",
6158 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6160 do i=iturn4_start,iturn4_end
6161 c write (iout,*) "make contact list turn4",i," num_cont",
6163 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6167 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6169 do j=1,num_cont_hb(i)
6172 iproc=iint_sent_local(k,jjc,ii)
6173 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6174 if (iproc.gt.0) then
6175 ncont_sent(iproc)=ncont_sent(iproc)+1
6176 nn=ncont_sent(iproc)
6178 zapas(2,nn,iproc)=jjc
6179 zapas(3,nn,iproc)=facont_hb(j,i)
6180 zapas(4,nn,iproc)=ees0p(j,i)
6181 zapas(5,nn,iproc)=ees0m(j,i)
6182 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6183 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6184 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6185 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6186 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6187 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6188 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6189 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6190 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6191 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6192 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6193 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6194 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6195 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6196 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6197 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6198 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6199 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6200 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6201 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6202 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6209 & "Numbers of contacts to be sent to other processors",
6210 & (ncont_sent(i),i=1,ntask_cont_to)
6211 write (iout,*) "Contacts sent"
6212 do ii=1,ntask_cont_to
6214 iproc=itask_cont_to(ii)
6215 write (iout,*) nn," contacts to processor",iproc,
6216 & " of CONT_TO_COMM group"
6218 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6226 CorrelID1=nfgtasks+fg_rank+1
6228 C Receive the numbers of needed contacts from other processors
6229 do ii=1,ntask_cont_from
6230 iproc=itask_cont_from(ii)
6232 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6233 & FG_COMM,req(ireq),IERR)
6235 c write (iout,*) "IRECV ended"
6237 C Send the number of contacts needed by other processors
6238 do ii=1,ntask_cont_to
6239 iproc=itask_cont_to(ii)
6241 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6242 & FG_COMM,req(ireq),IERR)
6244 c write (iout,*) "ISEND ended"
6245 c write (iout,*) "number of requests (nn)",ireq
6248 & call MPI_Waitall(ireq,req,status_array,ierr)
6250 c & "Numbers of contacts to be received from other processors",
6251 c & (ncont_recv(i),i=1,ntask_cont_from)
6255 do ii=1,ntask_cont_from
6256 iproc=itask_cont_from(ii)
6258 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6259 c & " of CONT_TO_COMM group"
6263 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6264 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6265 c write (iout,*) "ireq,req",ireq,req(ireq)
6268 C Send the contacts to processors that need them
6269 do ii=1,ntask_cont_to
6270 iproc=itask_cont_to(ii)
6272 c write (iout,*) nn," contacts to processor",iproc,
6273 c & " of CONT_TO_COMM group"
6276 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6277 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6278 c write (iout,*) "ireq,req",ireq,req(ireq)
6280 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6284 c write (iout,*) "number of requests (contacts)",ireq
6285 c write (iout,*) "req",(req(i),i=1,4)
6288 & call MPI_Waitall(ireq,req,status_array,ierr)
6289 do iii=1,ntask_cont_from
6290 iproc=itask_cont_from(iii)
6293 write (iout,*) "Received",nn," contacts from processor",iproc,
6294 & " of CONT_FROM_COMM group"
6297 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6302 ii=zapas_recv(1,i,iii)
6303 c Flag the received contacts to prevent double-counting
6304 jj=-zapas_recv(2,i,iii)
6305 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6307 nnn=num_cont_hb(ii)+1
6310 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6311 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6312 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6313 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6314 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6315 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6316 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6317 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6318 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6319 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6320 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6321 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6322 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6323 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6324 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6325 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6326 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6327 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6328 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6329 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6330 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6331 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6332 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6333 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6338 write (iout,'(a)') 'Contact function values after receive:'
6340 write (iout,'(2i3,50(1x,i3,f5.2))')
6341 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6342 & j=1,num_cont_hb(i))
6349 write (iout,'(a)') 'Contact function values:'
6351 write (iout,'(2i3,50(1x,i3,f5.2))')
6352 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6353 & j=1,num_cont_hb(i))
6357 C Remove the loop below after debugging !!!
6364 C Calculate the local-electrostatic correlation terms
6365 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6367 num_conti=num_cont_hb(i)
6368 num_conti1=num_cont_hb(i+1)
6375 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6376 c & ' jj=',jj,' kk=',kk
6377 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6378 & .or. j.lt.0 .and. j1.gt.0) .and.
6379 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6380 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6381 C The system gains extra energy.
6382 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6383 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6384 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6386 else if (j1.eq.j) then
6387 C Contacts I-J and I-(J+1) occur simultaneously.
6388 C The system loses extra energy.
6389 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6394 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6395 c & ' jj=',jj,' kk=',kk
6397 C Contacts I-J and (I+1)-J occur simultaneously.
6398 C The system loses extra energy.
6399 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6406 c------------------------------------------------------------------------------
6407 subroutine add_hb_contact(ii,jj,itask)
6408 implicit real*8 (a-h,o-z)
6409 include "DIMENSIONS"
6410 include "COMMON.IOUNITS"
6413 parameter (max_cont=maxconts)
6414 parameter (max_dim=26)
6415 include "COMMON.CONTACTS"
6416 double precision zapas(max_dim,maxconts,max_fg_procs),
6417 & zapas_recv(max_dim,maxconts,max_fg_procs)
6418 common /przechowalnia/ zapas
6419 integer i,j,ii,jj,iproc,itask(4),nn
6420 c write (iout,*) "itask",itask
6423 if (iproc.gt.0) then
6424 do j=1,num_cont_hb(ii)
6426 c write (iout,*) "i",ii," j",jj," jjc",jjc
6428 ncont_sent(iproc)=ncont_sent(iproc)+1
6429 nn=ncont_sent(iproc)
6430 zapas(1,nn,iproc)=ii
6431 zapas(2,nn,iproc)=jjc
6432 zapas(3,nn,iproc)=facont_hb(j,ii)
6433 zapas(4,nn,iproc)=ees0p(j,ii)
6434 zapas(5,nn,iproc)=ees0m(j,ii)
6435 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6436 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6437 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6438 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6439 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6440 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6441 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6442 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6443 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6444 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6445 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6446 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6447 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6448 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6449 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6450 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6451 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6452 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6453 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6454 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6455 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6463 c------------------------------------------------------------------------------
6464 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6466 C This subroutine calculates multi-body contributions to hydrogen-bonding
6467 implicit real*8 (a-h,o-z)
6468 include 'DIMENSIONS'
6469 include 'COMMON.IOUNITS'
6472 parameter (max_cont=maxconts)
6473 parameter (max_dim=70)
6474 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6475 double precision zapas(max_dim,maxconts,max_fg_procs),
6476 & zapas_recv(max_dim,maxconts,max_fg_procs)
6477 common /przechowalnia/ zapas
6478 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6479 & status_array(MPI_STATUS_SIZE,maxconts*2)
6481 include 'COMMON.SETUP'
6482 include 'COMMON.FFIELD'
6483 include 'COMMON.DERIV'
6484 include 'COMMON.LOCAL'
6485 include 'COMMON.INTERACT'
6486 include 'COMMON.CONTACTS'
6487 include 'COMMON.CHAIN'
6488 include 'COMMON.CONTROL'
6489 double precision gx(3),gx1(3)
6490 integer num_cont_hb_old(maxres)
6492 double precision eello4,eello5,eelo6,eello_turn6
6493 external eello4,eello5,eello6,eello_turn6
6494 C Set lprn=.true. for debugging
6499 num_cont_hb_old(i)=num_cont_hb(i)
6503 if (nfgtasks.le.1) goto 30
6505 write (iout,'(a)') 'Contact function values before RECEIVE:'
6507 write (iout,'(2i3,50(1x,i2,f5.2))')
6508 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6509 & j=1,num_cont_hb(i))
6513 do i=1,ntask_cont_from
6516 do i=1,ntask_cont_to
6519 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6521 C Make the list of contacts to send to send to other procesors
6522 do i=iturn3_start,iturn3_end
6523 c write (iout,*) "make contact list turn3",i," num_cont",
6525 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6527 do i=iturn4_start,iturn4_end
6528 c write (iout,*) "make contact list turn4",i," num_cont",
6530 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6534 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6536 do j=1,num_cont_hb(i)
6539 iproc=iint_sent_local(k,jjc,ii)
6540 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6541 if (iproc.ne.0) then
6542 ncont_sent(iproc)=ncont_sent(iproc)+1
6543 nn=ncont_sent(iproc)
6545 zapas(2,nn,iproc)=jjc
6546 zapas(3,nn,iproc)=d_cont(j,i)
6550 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6555 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6563 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6574 & "Numbers of contacts to be sent to other processors",
6575 & (ncont_sent(i),i=1,ntask_cont_to)
6576 write (iout,*) "Contacts sent"
6577 do ii=1,ntask_cont_to
6579 iproc=itask_cont_to(ii)
6580 write (iout,*) nn," contacts to processor",iproc,
6581 & " of CONT_TO_COMM group"
6583 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6591 CorrelID1=nfgtasks+fg_rank+1
6593 C Receive the numbers of needed contacts from other processors
6594 do ii=1,ntask_cont_from
6595 iproc=itask_cont_from(ii)
6597 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6598 & FG_COMM,req(ireq),IERR)
6600 c write (iout,*) "IRECV ended"
6602 C Send the number of contacts needed by other processors
6603 do ii=1,ntask_cont_to
6604 iproc=itask_cont_to(ii)
6606 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6607 & FG_COMM,req(ireq),IERR)
6609 c write (iout,*) "ISEND ended"
6610 c write (iout,*) "number of requests (nn)",ireq
6613 & call MPI_Waitall(ireq,req,status_array,ierr)
6615 c & "Numbers of contacts to be received from other processors",
6616 c & (ncont_recv(i),i=1,ntask_cont_from)
6620 do ii=1,ntask_cont_from
6621 iproc=itask_cont_from(ii)
6623 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6624 c & " of CONT_TO_COMM group"
6628 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6629 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6630 c write (iout,*) "ireq,req",ireq,req(ireq)
6633 C Send the contacts to processors that need them
6634 do ii=1,ntask_cont_to
6635 iproc=itask_cont_to(ii)
6637 c write (iout,*) nn," contacts to processor",iproc,
6638 c & " of CONT_TO_COMM group"
6641 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6642 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6643 c write (iout,*) "ireq,req",ireq,req(ireq)
6645 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6649 c write (iout,*) "number of requests (contacts)",ireq
6650 c write (iout,*) "req",(req(i),i=1,4)
6653 & call MPI_Waitall(ireq,req,status_array,ierr)
6654 do iii=1,ntask_cont_from
6655 iproc=itask_cont_from(iii)
6658 write (iout,*) "Received",nn," contacts from processor",iproc,
6659 & " of CONT_FROM_COMM group"
6662 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6667 ii=zapas_recv(1,i,iii)
6668 c Flag the received contacts to prevent double-counting
6669 jj=-zapas_recv(2,i,iii)
6670 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6672 nnn=num_cont_hb(ii)+1
6675 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6679 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6684 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6692 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6701 write (iout,'(a)') 'Contact function values after receive:'
6703 write (iout,'(2i3,50(1x,i3,5f6.3))')
6704 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6705 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6712 write (iout,'(a)') 'Contact function values:'
6714 write (iout,'(2i3,50(1x,i2,5f6.3))')
6715 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6716 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6722 C Remove the loop below after debugging !!!
6729 C Calculate the dipole-dipole interaction energies
6730 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6731 do i=iatel_s,iatel_e+1
6732 num_conti=num_cont_hb(i)
6741 C Calculate the local-electrostatic correlation terms
6742 c write (iout,*) "gradcorr5 in eello5 before loop"
6744 c write (iout,'(i5,3f10.5)')
6745 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6747 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6748 c write (iout,*) "corr loop i",i
6750 num_conti=num_cont_hb(i)
6751 num_conti1=num_cont_hb(i+1)
6758 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6759 c & ' jj=',jj,' kk=',kk
6760 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6761 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6762 & .or. j.lt.0 .and. j1.gt.0) .and.
6763 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6764 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6765 C The system gains extra energy.
6767 sqd1=dsqrt(d_cont(jj,i))
6768 sqd2=dsqrt(d_cont(kk,i1))
6769 sred_geom = sqd1*sqd2
6770 IF (sred_geom.lt.cutoff_corr) THEN
6771 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6773 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6774 cd & ' jj=',jj,' kk=',kk
6775 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6776 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6778 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6779 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6782 cd write (iout,*) 'sred_geom=',sred_geom,
6783 cd & ' ekont=',ekont,' fprim=',fprimcont,
6784 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6785 cd write (iout,*) "g_contij",g_contij
6786 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6787 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6788 call calc_eello(i,jp,i+1,jp1,jj,kk)
6789 if (wcorr4.gt.0.0d0)
6790 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6791 if (energy_dec.and.wcorr4.gt.0.0d0)
6792 1 write (iout,'(a6,4i5,0pf7.3)')
6793 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6794 c write (iout,*) "gradcorr5 before eello5"
6796 c write (iout,'(i5,3f10.5)')
6797 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6799 if (wcorr5.gt.0.0d0)
6800 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6801 c write (iout,*) "gradcorr5 after eello5"
6803 c write (iout,'(i5,3f10.5)')
6804 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6806 if (energy_dec.and.wcorr5.gt.0.0d0)
6807 1 write (iout,'(a6,4i5,0pf7.3)')
6808 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6809 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6810 cd write(2,*)'ijkl',i,jp,i+1,jp1
6811 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6812 & .or. wturn6.eq.0.0d0))then
6813 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6814 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6815 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6816 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6817 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6818 cd & 'ecorr6=',ecorr6
6819 cd write (iout,'(4e15.5)') sred_geom,
6820 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6821 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6822 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6823 else if (wturn6.gt.0.0d0
6824 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6825 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6826 eturn6=eturn6+eello_turn6(i,jj,kk)
6827 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6828 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6829 cd write (2,*) 'multibody_eello:eturn6',eturn6
6838 num_cont_hb(i)=num_cont_hb_old(i)
6840 c write (iout,*) "gradcorr5 in eello5"
6842 c write (iout,'(i5,3f10.5)')
6843 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6847 c------------------------------------------------------------------------------
6848 subroutine add_hb_contact_eello(ii,jj,itask)
6849 implicit real*8 (a-h,o-z)
6850 include "DIMENSIONS"
6851 include "COMMON.IOUNITS"
6854 parameter (max_cont=maxconts)
6855 parameter (max_dim=70)
6856 include "COMMON.CONTACTS"
6857 double precision zapas(max_dim,maxconts,max_fg_procs),
6858 & zapas_recv(max_dim,maxconts,max_fg_procs)
6859 common /przechowalnia/ zapas
6860 integer i,j,ii,jj,iproc,itask(4),nn
6861 c write (iout,*) "itask",itask
6864 if (iproc.gt.0) then
6865 do j=1,num_cont_hb(ii)
6867 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6869 ncont_sent(iproc)=ncont_sent(iproc)+1
6870 nn=ncont_sent(iproc)
6871 zapas(1,nn,iproc)=ii
6872 zapas(2,nn,iproc)=jjc
6873 zapas(3,nn,iproc)=d_cont(j,ii)
6877 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6882 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6890 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6902 c------------------------------------------------------------------------------
6903 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6904 implicit real*8 (a-h,o-z)
6905 include 'DIMENSIONS'
6906 include 'COMMON.IOUNITS'
6907 include 'COMMON.DERIV'
6908 include 'COMMON.INTERACT'
6909 include 'COMMON.CONTACTS'
6910 double precision gx(3),gx1(3)
6920 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6921 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6922 C Following 4 lines for diagnostics.
6927 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6928 c & 'Contacts ',i,j,
6929 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6930 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6932 C Calculate the multi-body contribution to energy.
6933 c ecorr=ecorr+ekont*ees
6934 C Calculate multi-body contributions to the gradient.
6935 coeffpees0pij=coeffp*ees0pij
6936 coeffmees0mij=coeffm*ees0mij
6937 coeffpees0pkl=coeffp*ees0pkl
6938 coeffmees0mkl=coeffm*ees0mkl
6940 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6941 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6942 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6943 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6944 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6945 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6946 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6947 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6948 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6949 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6950 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6951 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6952 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6953 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6954 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6955 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6956 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6957 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6958 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6959 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6960 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6961 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6962 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6963 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6964 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6969 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6970 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6971 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6972 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6977 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6978 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6979 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6980 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6983 c write (iout,*) "ehbcorr",ekont*ees
6988 C---------------------------------------------------------------------------
6989 subroutine dipole(i,j,jj)
6990 implicit real*8 (a-h,o-z)
6991 include 'DIMENSIONS'
6992 include 'COMMON.IOUNITS'
6993 include 'COMMON.CHAIN'
6994 include 'COMMON.FFIELD'
6995 include 'COMMON.DERIV'
6996 include 'COMMON.INTERACT'
6997 include 'COMMON.CONTACTS'
6998 include 'COMMON.TORSION'
6999 include 'COMMON.VAR'
7000 include 'COMMON.GEO'
7001 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7003 iti1 = itortyp(itype(i+1))
7004 if (j.lt.nres-1) then
7005 itj1 = itortyp(itype(j+1))
7010 dipi(iii,1)=Ub2(iii,i)
7011 dipderi(iii)=Ub2der(iii,i)
7012 dipi(iii,2)=b1(iii,iti1)
7013 dipj(iii,1)=Ub2(iii,j)
7014 dipderj(iii)=Ub2der(iii,j)
7015 dipj(iii,2)=b1(iii,itj1)
7019 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7022 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7029 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7033 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7038 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7039 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7041 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7043 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7045 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7050 C---------------------------------------------------------------------------
7051 subroutine calc_eello(i,j,k,l,jj,kk)
7053 C This subroutine computes matrices and vectors needed to calculate
7054 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7056 implicit real*8 (a-h,o-z)
7057 include 'DIMENSIONS'
7058 include 'COMMON.IOUNITS'
7059 include 'COMMON.CHAIN'
7060 include 'COMMON.DERIV'
7061 include 'COMMON.INTERACT'
7062 include 'COMMON.CONTACTS'
7063 include 'COMMON.TORSION'
7064 include 'COMMON.VAR'
7065 include 'COMMON.GEO'
7066 include 'COMMON.FFIELD'
7067 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7068 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7071 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7072 cd & ' jj=',jj,' kk=',kk
7073 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7074 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7075 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7078 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7079 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7082 call transpose2(aa1(1,1),aa1t(1,1))
7083 call transpose2(aa2(1,1),aa2t(1,1))
7086 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7087 & aa1tder(1,1,lll,kkk))
7088 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7089 & aa2tder(1,1,lll,kkk))
7093 C parallel orientation of the two CA-CA-CA frames.
7095 iti=itortyp(itype(i))
7099 itk1=itortyp(itype(k+1))
7100 itj=itortyp(itype(j))
7101 if (l.lt.nres-1) then
7102 itl1=itortyp(itype(l+1))
7106 C A1 kernel(j+1) A2T
7108 cd write (iout,'(3f10.5,5x,3f10.5)')
7109 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7111 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7112 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7113 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7114 C Following matrices are needed only for 6-th order cumulants
7115 IF (wcorr6.gt.0.0d0) THEN
7116 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7117 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7118 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7119 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7120 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7121 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7122 & ADtEAderx(1,1,1,1,1,1))
7124 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7125 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7126 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7127 & ADtEA1derx(1,1,1,1,1,1))
7129 C End 6-th order cumulants
7132 cd write (2,*) 'In calc_eello6'
7134 cd write (2,*) 'iii=',iii
7136 cd write (2,*) 'kkk=',kkk
7138 cd write (2,'(3(2f10.5),5x)')
7139 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7144 call transpose2(EUgder(1,1,k),auxmat(1,1))
7145 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7146 call transpose2(EUg(1,1,k),auxmat(1,1))
7147 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7148 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7152 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7153 & EAEAderx(1,1,lll,kkk,iii,1))
7157 C A1T kernel(i+1) A2
7158 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7159 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7160 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7161 C Following matrices are needed only for 6-th order cumulants
7162 IF (wcorr6.gt.0.0d0) THEN
7163 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7164 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7165 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7166 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7167 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7168 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7169 & ADtEAderx(1,1,1,1,1,2))
7170 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7171 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7172 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7173 & ADtEA1derx(1,1,1,1,1,2))
7175 C End 6-th order cumulants
7176 call transpose2(EUgder(1,1,l),auxmat(1,1))
7177 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7178 call transpose2(EUg(1,1,l),auxmat(1,1))
7179 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7180 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7184 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7185 & EAEAderx(1,1,lll,kkk,iii,2))
7190 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7191 C They are needed only when the fifth- or the sixth-order cumulants are
7193 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7194 call transpose2(AEA(1,1,1),auxmat(1,1))
7195 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7196 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7197 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7198 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7199 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7200 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7201 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7202 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7203 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7204 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7205 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7206 call transpose2(AEA(1,1,2),auxmat(1,1))
7207 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7208 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7209 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7210 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7211 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7212 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7213 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7214 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7215 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7216 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7217 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7218 C Calculate the Cartesian derivatives of the vectors.
7222 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7223 call matvec2(auxmat(1,1),b1(1,iti),
7224 & AEAb1derx(1,lll,kkk,iii,1,1))
7225 call matvec2(auxmat(1,1),Ub2(1,i),
7226 & AEAb2derx(1,lll,kkk,iii,1,1))
7227 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7228 & AEAb1derx(1,lll,kkk,iii,2,1))
7229 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7230 & AEAb2derx(1,lll,kkk,iii,2,1))
7231 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7232 call matvec2(auxmat(1,1),b1(1,itj),
7233 & AEAb1derx(1,lll,kkk,iii,1,2))
7234 call matvec2(auxmat(1,1),Ub2(1,j),
7235 & AEAb2derx(1,lll,kkk,iii,1,2))
7236 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7237 & AEAb1derx(1,lll,kkk,iii,2,2))
7238 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7239 & AEAb2derx(1,lll,kkk,iii,2,2))
7246 C Antiparallel orientation of the two CA-CA-CA frames.
7248 iti=itortyp(itype(i))
7252 itk1=itortyp(itype(k+1))
7253 itl=itortyp(itype(l))
7254 itj=itortyp(itype(j))
7255 if (j.lt.nres-1) then
7256 itj1=itortyp(itype(j+1))
7260 C A2 kernel(j-1)T A1T
7261 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7262 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7263 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7264 C Following matrices are needed only for 6-th order cumulants
7265 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7266 & j.eq.i+4 .and. l.eq.i+3)) THEN
7267 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7268 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7269 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7270 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7271 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7272 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7273 & ADtEAderx(1,1,1,1,1,1))
7274 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7275 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7276 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7277 & ADtEA1derx(1,1,1,1,1,1))
7279 C End 6-th order cumulants
7280 call transpose2(EUgder(1,1,k),auxmat(1,1))
7281 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7282 call transpose2(EUg(1,1,k),auxmat(1,1))
7283 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7284 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7288 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7289 & EAEAderx(1,1,lll,kkk,iii,1))
7293 C A2T kernel(i+1)T A1
7294 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7295 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7296 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7297 C Following matrices are needed only for 6-th order cumulants
7298 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7299 & j.eq.i+4 .and. l.eq.i+3)) THEN
7300 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7301 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7302 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7303 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7304 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7305 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7306 & ADtEAderx(1,1,1,1,1,2))
7307 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7308 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7309 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7310 & ADtEA1derx(1,1,1,1,1,2))
7312 C End 6-th order cumulants
7313 call transpose2(EUgder(1,1,j),auxmat(1,1))
7314 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7315 call transpose2(EUg(1,1,j),auxmat(1,1))
7316 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7317 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7321 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7322 & EAEAderx(1,1,lll,kkk,iii,2))
7327 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7328 C They are needed only when the fifth- or the sixth-order cumulants are
7330 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7331 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7332 call transpose2(AEA(1,1,1),auxmat(1,1))
7333 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7334 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7335 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7336 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7337 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7338 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7339 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7340 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7341 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7342 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7343 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7344 call transpose2(AEA(1,1,2),auxmat(1,1))
7345 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7346 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7347 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7348 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7349 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7350 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7351 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7352 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7353 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7354 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7355 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7356 C Calculate the Cartesian derivatives of the vectors.
7360 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7361 call matvec2(auxmat(1,1),b1(1,iti),
7362 & AEAb1derx(1,lll,kkk,iii,1,1))
7363 call matvec2(auxmat(1,1),Ub2(1,i),
7364 & AEAb2derx(1,lll,kkk,iii,1,1))
7365 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7366 & AEAb1derx(1,lll,kkk,iii,2,1))
7367 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7368 & AEAb2derx(1,lll,kkk,iii,2,1))
7369 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7370 call matvec2(auxmat(1,1),b1(1,itl),
7371 & AEAb1derx(1,lll,kkk,iii,1,2))
7372 call matvec2(auxmat(1,1),Ub2(1,l),
7373 & AEAb2derx(1,lll,kkk,iii,1,2))
7374 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7375 & AEAb1derx(1,lll,kkk,iii,2,2))
7376 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7377 & AEAb2derx(1,lll,kkk,iii,2,2))
7386 C---------------------------------------------------------------------------
7387 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7388 & KK,KKderg,AKA,AKAderg,AKAderx)
7392 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7393 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7394 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7399 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7401 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7404 cd if (lprn) write (2,*) 'In kernel'
7406 cd if (lprn) write (2,*) 'kkk=',kkk
7408 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7409 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7411 cd write (2,*) 'lll=',lll
7412 cd write (2,*) 'iii=1'
7414 cd write (2,'(3(2f10.5),5x)')
7415 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7418 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7419 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7421 cd write (2,*) 'lll=',lll
7422 cd write (2,*) 'iii=2'
7424 cd write (2,'(3(2f10.5),5x)')
7425 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7432 C---------------------------------------------------------------------------
7433 double precision function eello4(i,j,k,l,jj,kk)
7434 implicit real*8 (a-h,o-z)
7435 include 'DIMENSIONS'
7436 include 'COMMON.IOUNITS'
7437 include 'COMMON.CHAIN'
7438 include 'COMMON.DERIV'
7439 include 'COMMON.INTERACT'
7440 include 'COMMON.CONTACTS'
7441 include 'COMMON.TORSION'
7442 include 'COMMON.VAR'
7443 include 'COMMON.GEO'
7444 double precision pizda(2,2),ggg1(3),ggg2(3)
7445 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7449 cd print *,'eello4:',i,j,k,l,jj,kk
7450 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7451 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7452 cold eij=facont_hb(jj,i)
7453 cold ekl=facont_hb(kk,k)
7455 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7456 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7457 gcorr_loc(k-1)=gcorr_loc(k-1)
7458 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7460 gcorr_loc(l-1)=gcorr_loc(l-1)
7461 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7463 gcorr_loc(j-1)=gcorr_loc(j-1)
7464 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7469 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7470 & -EAEAderx(2,2,lll,kkk,iii,1)
7471 cd derx(lll,kkk,iii)=0.0d0
7475 cd gcorr_loc(l-1)=0.0d0
7476 cd gcorr_loc(j-1)=0.0d0
7477 cd gcorr_loc(k-1)=0.0d0
7479 cd write (iout,*)'Contacts have occurred for peptide groups',
7480 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7481 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7482 if (j.lt.nres-1) then
7489 if (l.lt.nres-1) then
7497 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7498 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7499 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7500 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7501 cgrad ghalf=0.5d0*ggg1(ll)
7502 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7503 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7504 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7505 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7506 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7507 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7508 cgrad ghalf=0.5d0*ggg2(ll)
7509 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7510 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7511 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7512 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7513 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7514 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7518 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7523 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7528 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7533 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7537 cd write (2,*) iii,gcorr_loc(iii)
7540 cd write (2,*) 'ekont',ekont
7541 cd write (iout,*) 'eello4',ekont*eel4
7544 C---------------------------------------------------------------------------
7545 double precision function eello5(i,j,k,l,jj,kk)
7546 implicit real*8 (a-h,o-z)
7547 include 'DIMENSIONS'
7548 include 'COMMON.IOUNITS'
7549 include 'COMMON.CHAIN'
7550 include 'COMMON.DERIV'
7551 include 'COMMON.INTERACT'
7552 include 'COMMON.CONTACTS'
7553 include 'COMMON.TORSION'
7554 include 'COMMON.VAR'
7555 include 'COMMON.GEO'
7556 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7557 double precision ggg1(3),ggg2(3)
7558 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7563 C /l\ / \ \ / \ / \ / C
7564 C / \ / \ \ / \ / \ / C
7565 C j| o |l1 | o | o| o | | o |o C
7566 C \ |/k\| |/ \| / |/ \| |/ \| C
7567 C \i/ \ / \ / / \ / \ C
7569 C (I) (II) (III) (IV) C
7571 C eello5_1 eello5_2 eello5_3 eello5_4 C
7573 C Antiparallel chains C
7576 C /j\ / \ \ / \ / \ / C
7577 C / \ / \ \ / \ / \ / C
7578 C j1| o |l | o | o| o | | o |o C
7579 C \ |/k\| |/ \| / |/ \| |/ \| C
7580 C \i/ \ / \ / / \ / \ C
7582 C (I) (II) (III) (IV) C
7584 C eello5_1 eello5_2 eello5_3 eello5_4 C
7586 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7589 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7594 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7596 itk=itortyp(itype(k))
7597 itl=itortyp(itype(l))
7598 itj=itortyp(itype(j))
7603 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7604 cd & eel5_3_num,eel5_4_num)
7608 derx(lll,kkk,iii)=0.0d0
7612 cd eij=facont_hb(jj,i)
7613 cd ekl=facont_hb(kk,k)
7615 cd write (iout,*)'Contacts have occurred for peptide groups',
7616 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7618 C Contribution from the graph I.
7619 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7620 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7621 call transpose2(EUg(1,1,k),auxmat(1,1))
7622 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7623 vv(1)=pizda(1,1)-pizda(2,2)
7624 vv(2)=pizda(1,2)+pizda(2,1)
7625 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7626 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7627 C Explicit gradient in virtual-dihedral angles.
7628 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7629 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7630 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7631 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7632 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7633 vv(1)=pizda(1,1)-pizda(2,2)
7634 vv(2)=pizda(1,2)+pizda(2,1)
7635 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7636 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7637 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7638 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7639 vv(1)=pizda(1,1)-pizda(2,2)
7640 vv(2)=pizda(1,2)+pizda(2,1)
7642 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7643 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7644 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7646 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7647 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7648 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7650 C Cartesian gradient
7654 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7656 vv(1)=pizda(1,1)-pizda(2,2)
7657 vv(2)=pizda(1,2)+pizda(2,1)
7658 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7659 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7666 C Contribution from graph II
7667 call transpose2(EE(1,1,itk),auxmat(1,1))
7668 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7669 vv(1)=pizda(1,1)+pizda(2,2)
7670 vv(2)=pizda(2,1)-pizda(1,2)
7671 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7672 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7673 C Explicit gradient in virtual-dihedral angles.
7674 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7675 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7676 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7677 vv(1)=pizda(1,1)+pizda(2,2)
7678 vv(2)=pizda(2,1)-pizda(1,2)
7680 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7681 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7682 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7684 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7685 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7686 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7688 C Cartesian gradient
7692 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7694 vv(1)=pizda(1,1)+pizda(2,2)
7695 vv(2)=pizda(2,1)-pizda(1,2)
7696 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7697 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7698 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7706 C Parallel orientation
7707 C Contribution from graph III
7708 call transpose2(EUg(1,1,l),auxmat(1,1))
7709 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)-pizda(2,2)
7711 vv(2)=pizda(1,2)+pizda(2,1)
7712 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7713 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7714 C Explicit gradient in virtual-dihedral angles.
7715 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7716 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7717 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7718 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7719 vv(1)=pizda(1,1)-pizda(2,2)
7720 vv(2)=pizda(1,2)+pizda(2,1)
7721 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7722 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7723 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7724 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7725 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7726 vv(1)=pizda(1,1)-pizda(2,2)
7727 vv(2)=pizda(1,2)+pizda(2,1)
7728 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7729 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7730 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7731 C Cartesian gradient
7735 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7737 vv(1)=pizda(1,1)-pizda(2,2)
7738 vv(2)=pizda(1,2)+pizda(2,1)
7739 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7740 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7741 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7746 C Contribution from graph IV
7748 call transpose2(EE(1,1,itl),auxmat(1,1))
7749 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7750 vv(1)=pizda(1,1)+pizda(2,2)
7751 vv(2)=pizda(2,1)-pizda(1,2)
7752 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7753 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7754 C Explicit gradient in virtual-dihedral angles.
7755 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7756 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7757 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7758 vv(1)=pizda(1,1)+pizda(2,2)
7759 vv(2)=pizda(2,1)-pizda(1,2)
7760 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7761 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7762 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7763 C Cartesian gradient
7767 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7769 vv(1)=pizda(1,1)+pizda(2,2)
7770 vv(2)=pizda(2,1)-pizda(1,2)
7771 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7772 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7773 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7778 C Antiparallel orientation
7779 C Contribution from graph III
7781 call transpose2(EUg(1,1,j),auxmat(1,1))
7782 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7783 vv(1)=pizda(1,1)-pizda(2,2)
7784 vv(2)=pizda(1,2)+pizda(2,1)
7785 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7786 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7787 C Explicit gradient in virtual-dihedral angles.
7788 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7789 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7790 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7791 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7792 vv(1)=pizda(1,1)-pizda(2,2)
7793 vv(2)=pizda(1,2)+pizda(2,1)
7794 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7795 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7796 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7797 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7798 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7799 vv(1)=pizda(1,1)-pizda(2,2)
7800 vv(2)=pizda(1,2)+pizda(2,1)
7801 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7802 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7803 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7804 C Cartesian gradient
7808 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7810 vv(1)=pizda(1,1)-pizda(2,2)
7811 vv(2)=pizda(1,2)+pizda(2,1)
7812 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7813 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7814 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7819 C Contribution from graph IV
7821 call transpose2(EE(1,1,itj),auxmat(1,1))
7822 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7823 vv(1)=pizda(1,1)+pizda(2,2)
7824 vv(2)=pizda(2,1)-pizda(1,2)
7825 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7826 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7827 C Explicit gradient in virtual-dihedral angles.
7828 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7829 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7830 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7831 vv(1)=pizda(1,1)+pizda(2,2)
7832 vv(2)=pizda(2,1)-pizda(1,2)
7833 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7834 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7835 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7836 C Cartesian gradient
7840 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7842 vv(1)=pizda(1,1)+pizda(2,2)
7843 vv(2)=pizda(2,1)-pizda(1,2)
7844 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7845 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7846 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7852 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7853 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7854 cd write (2,*) 'ijkl',i,j,k,l
7855 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7856 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7858 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7859 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7860 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7861 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7862 if (j.lt.nres-1) then
7869 if (l.lt.nres-1) then
7879 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7880 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7881 C summed up outside the subrouine as for the other subroutines
7882 C handling long-range interactions. The old code is commented out
7883 C with "cgrad" to keep track of changes.
7885 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7886 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7887 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7888 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7889 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7890 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7891 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7892 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7893 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7894 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7896 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7897 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7898 cgrad ghalf=0.5d0*ggg1(ll)
7900 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7901 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7902 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7903 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7904 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7905 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7906 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7907 cgrad ghalf=0.5d0*ggg2(ll)
7909 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7910 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7911 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7912 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7913 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7914 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7919 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7920 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7925 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7926 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7932 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7937 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7941 cd write (2,*) iii,g_corr5_loc(iii)
7944 cd write (2,*) 'ekont',ekont
7945 cd write (iout,*) 'eello5',ekont*eel5
7948 c--------------------------------------------------------------------------
7949 double precision function eello6(i,j,k,l,jj,kk)
7950 implicit real*8 (a-h,o-z)
7951 include 'DIMENSIONS'
7952 include 'COMMON.IOUNITS'
7953 include 'COMMON.CHAIN'
7954 include 'COMMON.DERIV'
7955 include 'COMMON.INTERACT'
7956 include 'COMMON.CONTACTS'
7957 include 'COMMON.TORSION'
7958 include 'COMMON.VAR'
7959 include 'COMMON.GEO'
7960 include 'COMMON.FFIELD'
7961 double precision ggg1(3),ggg2(3)
7962 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7967 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7975 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7976 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7980 derx(lll,kkk,iii)=0.0d0
7984 cd eij=facont_hb(jj,i)
7985 cd ekl=facont_hb(kk,k)
7991 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7992 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7993 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7994 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7995 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7996 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7998 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7999 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8000 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8001 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8002 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8003 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8007 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8009 C If turn contributions are considered, they will be handled separately.
8010 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8011 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8012 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8013 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8014 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8015 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8016 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8018 if (j.lt.nres-1) then
8025 if (l.lt.nres-1) then
8033 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8034 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8035 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8036 cgrad ghalf=0.5d0*ggg1(ll)
8038 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8039 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8040 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8041 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8042 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8043 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8044 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8045 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8046 cgrad ghalf=0.5d0*ggg2(ll)
8047 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8049 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8050 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8051 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8052 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8053 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8054 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8059 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8060 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8065 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8066 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8072 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8077 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8081 cd write (2,*) iii,g_corr6_loc(iii)
8084 cd write (2,*) 'ekont',ekont
8085 cd write (iout,*) 'eello6',ekont*eel6
8088 c--------------------------------------------------------------------------
8089 double precision function eello6_graph1(i,j,k,l,imat,swap)
8090 implicit real*8 (a-h,o-z)
8091 include 'DIMENSIONS'
8092 include 'COMMON.IOUNITS'
8093 include 'COMMON.CHAIN'
8094 include 'COMMON.DERIV'
8095 include 'COMMON.INTERACT'
8096 include 'COMMON.CONTACTS'
8097 include 'COMMON.TORSION'
8098 include 'COMMON.VAR'
8099 include 'COMMON.GEO'
8100 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8104 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8106 C Parallel Antiparallel
8112 C \ j|/k\| / \ |/k\|l /
8117 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8118 itk=itortyp(itype(k))
8119 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8120 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8121 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8122 call transpose2(EUgC(1,1,k),auxmat(1,1))
8123 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8124 vv1(1)=pizda1(1,1)-pizda1(2,2)
8125 vv1(2)=pizda1(1,2)+pizda1(2,1)
8126 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8127 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8128 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8129 s5=scalar2(vv(1),Dtobr2(1,i))
8130 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8131 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8132 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8133 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8134 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8135 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8136 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8137 & +scalar2(vv(1),Dtobr2der(1,i)))
8138 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8139 vv1(1)=pizda1(1,1)-pizda1(2,2)
8140 vv1(2)=pizda1(1,2)+pizda1(2,1)
8141 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8142 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8144 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8145 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8146 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8147 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8148 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8150 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8151 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8152 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8153 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8154 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8156 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8157 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8158 vv1(1)=pizda1(1,1)-pizda1(2,2)
8159 vv1(2)=pizda1(1,2)+pizda1(2,1)
8160 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8161 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8162 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8163 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8172 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8173 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8174 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8175 call transpose2(EUgC(1,1,k),auxmat(1,1))
8176 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8178 vv1(1)=pizda1(1,1)-pizda1(2,2)
8179 vv1(2)=pizda1(1,2)+pizda1(2,1)
8180 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8181 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8182 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8183 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8184 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8185 s5=scalar2(vv(1),Dtobr2(1,i))
8186 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8192 c----------------------------------------------------------------------------
8193 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8194 implicit real*8 (a-h,o-z)
8195 include 'DIMENSIONS'
8196 include 'COMMON.IOUNITS'
8197 include 'COMMON.CHAIN'
8198 include 'COMMON.DERIV'
8199 include 'COMMON.INTERACT'
8200 include 'COMMON.CONTACTS'
8201 include 'COMMON.TORSION'
8202 include 'COMMON.VAR'
8203 include 'COMMON.GEO'
8205 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8206 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8209 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8211 C Parallel Antiparallel C
8217 C \ j|/k\| \ |/k\|l C
8222 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8223 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8224 C AL 7/4/01 s1 would occur in the sixth-order moment,
8225 C but not in a cluster cumulant
8227 s1=dip(1,jj,i)*dip(1,kk,k)
8229 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8230 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8231 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8232 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8233 call transpose2(EUg(1,1,k),auxmat(1,1))
8234 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8235 vv(1)=pizda(1,1)-pizda(2,2)
8236 vv(2)=pizda(1,2)+pizda(2,1)
8237 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8238 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8240 eello6_graph2=-(s1+s2+s3+s4)
8242 eello6_graph2=-(s2+s3+s4)
8245 C Derivatives in gamma(i-1)
8248 s1=dipderg(1,jj,i)*dip(1,kk,k)
8250 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8251 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8252 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8253 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8255 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8257 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8259 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8261 C Derivatives in gamma(k-1)
8263 s1=dip(1,jj,i)*dipderg(1,kk,k)
8265 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8266 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8267 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8268 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8269 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8270 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8271 vv(1)=pizda(1,1)-pizda(2,2)
8272 vv(2)=pizda(1,2)+pizda(2,1)
8273 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8275 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8277 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8279 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8280 C Derivatives in gamma(j-1) or gamma(l-1)
8283 s1=dipderg(3,jj,i)*dip(1,kk,k)
8285 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8286 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8287 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8288 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8289 vv(1)=pizda(1,1)-pizda(2,2)
8290 vv(2)=pizda(1,2)+pizda(2,1)
8291 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8294 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8296 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8299 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8300 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8302 C Derivatives in gamma(l-1) or gamma(j-1)
8305 s1=dip(1,jj,i)*dipderg(3,kk,k)
8307 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8308 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8309 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8310 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8311 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8312 vv(1)=pizda(1,1)-pizda(2,2)
8313 vv(2)=pizda(1,2)+pizda(2,1)
8314 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8317 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8319 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8322 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8323 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8325 C Cartesian derivatives.
8327 write (2,*) 'In eello6_graph2'
8329 write (2,*) 'iii=',iii
8331 write (2,*) 'kkk=',kkk
8333 write (2,'(3(2f10.5),5x)')
8334 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8344 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8346 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8349 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8351 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8352 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8354 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8355 call transpose2(EUg(1,1,k),auxmat(1,1))
8356 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8358 vv(1)=pizda(1,1)-pizda(2,2)
8359 vv(2)=pizda(1,2)+pizda(2,1)
8360 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8361 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8363 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8368 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8370 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8377 c----------------------------------------------------------------------------
8378 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8379 implicit real*8 (a-h,o-z)
8380 include 'DIMENSIONS'
8381 include 'COMMON.IOUNITS'
8382 include 'COMMON.CHAIN'
8383 include 'COMMON.DERIV'
8384 include 'COMMON.INTERACT'
8385 include 'COMMON.CONTACTS'
8386 include 'COMMON.TORSION'
8387 include 'COMMON.VAR'
8388 include 'COMMON.GEO'
8389 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8391 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8393 C Parallel Antiparallel C
8399 C j|/k\| / |/k\|l / C
8404 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8406 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8407 C energy moment and not to the cluster cumulant.
8408 iti=itortyp(itype(i))
8409 if (j.lt.nres-1) then
8410 itj1=itortyp(itype(j+1))
8414 itk=itortyp(itype(k))
8415 itk1=itortyp(itype(k+1))
8416 if (l.lt.nres-1) then
8417 itl1=itortyp(itype(l+1))
8422 s1=dip(4,jj,i)*dip(4,kk,k)
8424 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8425 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8426 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8427 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8428 call transpose2(EE(1,1,itk),auxmat(1,1))
8429 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8430 vv(1)=pizda(1,1)+pizda(2,2)
8431 vv(2)=pizda(2,1)-pizda(1,2)
8432 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8433 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8434 cd & "sum",-(s2+s3+s4)
8436 eello6_graph3=-(s1+s2+s3+s4)
8438 eello6_graph3=-(s2+s3+s4)
8441 C Derivatives in gamma(k-1)
8442 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8443 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8444 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8445 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8446 C Derivatives in gamma(l-1)
8447 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8448 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8449 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8450 vv(1)=pizda(1,1)+pizda(2,2)
8451 vv(2)=pizda(2,1)-pizda(1,2)
8452 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8453 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8454 C Cartesian derivatives.
8460 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8462 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8465 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8467 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8468 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8470 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8471 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8473 vv(1)=pizda(1,1)+pizda(2,2)
8474 vv(2)=pizda(2,1)-pizda(1,2)
8475 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8477 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8479 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8482 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8484 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8486 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8492 c----------------------------------------------------------------------------
8493 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8494 implicit real*8 (a-h,o-z)
8495 include 'DIMENSIONS'
8496 include 'COMMON.IOUNITS'
8497 include 'COMMON.CHAIN'
8498 include 'COMMON.DERIV'
8499 include 'COMMON.INTERACT'
8500 include 'COMMON.CONTACTS'
8501 include 'COMMON.TORSION'
8502 include 'COMMON.VAR'
8503 include 'COMMON.GEO'
8504 include 'COMMON.FFIELD'
8505 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8506 & auxvec1(2),auxmat1(2,2)
8508 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8510 C Parallel Antiparallel C
8516 C \ j|/k\| \ |/k\|l C
8521 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8523 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8524 C energy moment and not to the cluster cumulant.
8525 cd write (2,*) 'eello_graph4: wturn6',wturn6
8526 iti=itortyp(itype(i))
8527 itj=itortyp(itype(j))
8528 if (j.lt.nres-1) then
8529 itj1=itortyp(itype(j+1))
8533 itk=itortyp(itype(k))
8534 if (k.lt.nres-1) then
8535 itk1=itortyp(itype(k+1))
8539 itl=itortyp(itype(l))
8540 if (l.lt.nres-1) then
8541 itl1=itortyp(itype(l+1))
8545 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8546 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8547 cd & ' itl',itl,' itl1',itl1
8550 s1=dip(3,jj,i)*dip(3,kk,k)
8552 s1=dip(2,jj,j)*dip(2,kk,l)
8555 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8556 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8558 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8559 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8561 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8562 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8564 call transpose2(EUg(1,1,k),auxmat(1,1))
8565 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8566 vv(1)=pizda(1,1)-pizda(2,2)
8567 vv(2)=pizda(2,1)+pizda(1,2)
8568 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8569 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8571 eello6_graph4=-(s1+s2+s3+s4)
8573 eello6_graph4=-(s2+s3+s4)
8575 C Derivatives in gamma(i-1)
8579 s1=dipderg(2,jj,i)*dip(3,kk,k)
8581 s1=dipderg(4,jj,j)*dip(2,kk,l)
8584 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8586 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8587 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8589 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8590 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8592 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8593 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8594 cd write (2,*) 'turn6 derivatives'
8596 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8598 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8602 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8604 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8608 C Derivatives in gamma(k-1)
8611 s1=dip(3,jj,i)*dipderg(2,kk,k)
8613 s1=dip(2,jj,j)*dipderg(4,kk,l)
8616 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8617 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8619 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8620 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8622 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8623 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8625 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8626 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8627 vv(1)=pizda(1,1)-pizda(2,2)
8628 vv(2)=pizda(2,1)+pizda(1,2)
8629 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8630 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8632 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8634 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8638 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8640 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8643 C Derivatives in gamma(j-1) or gamma(l-1)
8644 if (l.eq.j+1 .and. l.gt.1) then
8645 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8646 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8647 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8648 vv(1)=pizda(1,1)-pizda(2,2)
8649 vv(2)=pizda(2,1)+pizda(1,2)
8650 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8651 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8652 else if (j.gt.1) then
8653 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8654 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8655 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8656 vv(1)=pizda(1,1)-pizda(2,2)
8657 vv(2)=pizda(2,1)+pizda(1,2)
8658 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8659 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8660 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8662 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8665 C Cartesian derivatives.
8672 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8674 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8678 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8680 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8684 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8686 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8688 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8689 & b1(1,itj1),auxvec(1))
8690 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8692 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8693 & b1(1,itl1),auxvec(1))
8694 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8696 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8698 vv(1)=pizda(1,1)-pizda(2,2)
8699 vv(2)=pizda(2,1)+pizda(1,2)
8700 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8702 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8704 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8707 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8710 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8713 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8715 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8717 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8721 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8723 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8726 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8728 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8736 c----------------------------------------------------------------------------
8737 double precision function eello_turn6(i,jj,kk)
8738 implicit real*8 (a-h,o-z)
8739 include 'DIMENSIONS'
8740 include 'COMMON.IOUNITS'
8741 include 'COMMON.CHAIN'
8742 include 'COMMON.DERIV'
8743 include 'COMMON.INTERACT'
8744 include 'COMMON.CONTACTS'
8745 include 'COMMON.TORSION'
8746 include 'COMMON.VAR'
8747 include 'COMMON.GEO'
8748 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8749 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8751 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8752 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8753 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8754 C the respective energy moment and not to the cluster cumulant.
8763 iti=itortyp(itype(i))
8764 itk=itortyp(itype(k))
8765 itk1=itortyp(itype(k+1))
8766 itl=itortyp(itype(l))
8767 itj=itortyp(itype(j))
8768 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8769 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8770 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8775 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8777 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8781 derx_turn(lll,kkk,iii)=0.0d0
8788 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8790 cd write (2,*) 'eello6_5',eello6_5
8792 call transpose2(AEA(1,1,1),auxmat(1,1))
8793 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8794 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8795 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8797 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8798 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8799 s2 = scalar2(b1(1,itk),vtemp1(1))
8801 call transpose2(AEA(1,1,2),atemp(1,1))
8802 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8803 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8804 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8806 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8807 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8808 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8810 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8811 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8812 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8813 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8814 ss13 = scalar2(b1(1,itk),vtemp4(1))
8815 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8817 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8823 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8824 C Derivatives in gamma(i+2)
8828 call transpose2(AEA(1,1,1),auxmatd(1,1))
8829 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8830 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8831 call transpose2(AEAderg(1,1,2),atempd(1,1))
8832 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8833 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8835 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8836 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8837 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8843 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8844 C Derivatives in gamma(i+3)
8846 call transpose2(AEA(1,1,1),auxmatd(1,1))
8847 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8848 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8849 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8851 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8852 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8853 s2d = scalar2(b1(1,itk),vtemp1d(1))
8855 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8856 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8858 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8860 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8861 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8862 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8870 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8871 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8873 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8874 & -0.5d0*ekont*(s2d+s12d)
8876 C Derivatives in gamma(i+4)
8877 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8878 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8879 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8881 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8882 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8883 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8891 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8893 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8895 C Derivatives in gamma(i+5)
8897 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8898 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8899 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8901 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8902 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8903 s2d = scalar2(b1(1,itk),vtemp1d(1))
8905 call transpose2(AEA(1,1,2),atempd(1,1))
8906 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8907 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8909 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8910 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8912 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8913 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8914 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8922 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8923 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8925 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8926 & -0.5d0*ekont*(s2d+s12d)
8928 C Cartesian derivatives
8933 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8934 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8935 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8937 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8938 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8940 s2d = scalar2(b1(1,itk),vtemp1d(1))
8942 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8943 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8944 s8d = -(atempd(1,1)+atempd(2,2))*
8945 & scalar2(cc(1,1,itl),vtemp2(1))
8947 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8949 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8950 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8957 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8960 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8964 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8965 & - 0.5d0*(s8d+s12d)
8967 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8976 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8978 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8979 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8980 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8981 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8982 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8984 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8985 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8986 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8990 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8991 cd & 16*eel_turn6_num
8993 if (j.lt.nres-1) then
9000 if (l.lt.nres-1) then
9008 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9009 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9010 cgrad ghalf=0.5d0*ggg1(ll)
9012 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9013 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9014 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9015 & +ekont*derx_turn(ll,2,1)
9016 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9017 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9018 & +ekont*derx_turn(ll,4,1)
9019 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9020 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9021 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9022 cgrad ghalf=0.5d0*ggg2(ll)
9024 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9025 & +ekont*derx_turn(ll,2,2)
9026 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9027 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9028 & +ekont*derx_turn(ll,4,2)
9029 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9030 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9031 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9036 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9041 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9047 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9052 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9056 cd write (2,*) iii,g_corr6_loc(iii)
9058 eello_turn6=ekont*eel_turn6
9059 cd write (2,*) 'ekont',ekont
9060 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9064 C-----------------------------------------------------------------------------
9065 double precision function scalar(u,v)
9066 !DIR$ INLINEALWAYS scalar
9068 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9071 double precision u(3),v(3)
9072 cd double precision sc
9080 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9083 crc-------------------------------------------------
9084 SUBROUTINE MATVEC2(A1,V1,V2)
9085 !DIR$ INLINEALWAYS MATVEC2
9087 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9089 implicit real*8 (a-h,o-z)
9090 include 'DIMENSIONS'
9091 DIMENSION A1(2,2),V1(2),V2(2)
9095 c 3 VI=VI+A1(I,K)*V1(K)
9099 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9100 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9105 C---------------------------------------
9106 SUBROUTINE MATMAT2(A1,A2,A3)
9108 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9110 implicit real*8 (a-h,o-z)
9111 include 'DIMENSIONS'
9112 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9113 c DIMENSION AI3(2,2)
9117 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9123 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9124 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9125 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9126 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9134 c-------------------------------------------------------------------------
9135 double precision function scalar2(u,v)
9136 !DIR$ INLINEALWAYS scalar2
9138 double precision u(2),v(2)
9141 scalar2=u(1)*v(1)+u(2)*v(2)
9145 C-----------------------------------------------------------------------------
9147 subroutine transpose2(a,at)
9148 !DIR$ INLINEALWAYS transpose2
9150 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9153 double precision a(2,2),at(2,2)
9160 c--------------------------------------------------------------------------
9161 subroutine transpose(n,a,at)
9164 double precision a(n,n),at(n,n)
9172 C---------------------------------------------------------------------------
9173 subroutine prodmat3(a1,a2,kk,transp,prod)
9174 !DIR$ INLINEALWAYS prodmat3
9176 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9180 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9182 crc double precision auxmat(2,2),prod_(2,2)
9185 crc call transpose2(kk(1,1),auxmat(1,1))
9186 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9187 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9189 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9190 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9191 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9192 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9193 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9194 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9195 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9196 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9199 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9200 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9202 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9203 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9204 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9205 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9206 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9207 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9208 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9209 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9212 c call transpose2(a2(1,1),a2t(1,1))
9215 crc print *,((prod_(i,j),i=1,2),j=1,2)
9216 crc print *,((prod(i,j),i=1,2),j=1,2)