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'
27 include "COMMON.ECOMPON"
38 sccorcompon(i,j)=0.0d0
42 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
43 c & " nfgtasks",nfgtasks
44 if (nfgtasks.gt.1) then
50 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
51 if (fg_rank.eq.0) then
52 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
53 c print *,"Processor",myrank," BROADCAST iorder"
54 C FG master sets up the WEIGHTS_ array which will be broadcast to the
55 C FG slaves as WEIGHTS array.
76 C FG Master broadcasts the WEIGHTS_ array
77 call MPI_Bcast(weights_(1),n_ene,
78 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
80 C FG slaves receive the WEIGHTS array
81 call MPI_Bcast(weights(1),n_ene,
82 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
104 time_Bcast=time_Bcast+MPI_Wtime()-time00
105 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
106 c call chainbuild_cart
108 c print *,'Processor',myrank,' calling etotal ipot=',ipot
109 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
111 c if (modecalc.eq.12.or.modecalc.eq.14) then
112 c call int_from_cart1(.false.)
123 C Compute the side-chain and electrostatic interaction energy
125 goto (101,102,103,104,105,106) ipot
126 C Lennard-Jones potential.
127 101 call elj(evdw,evdw_p,evdw_m)
128 cd print '(a)','Exit ELJ'
130 C Lennard-Jones-Kihara potential (shifted).
131 102 call eljk(evdw,evdw_p,evdw_m)
133 C Berne-Pechukas potential (dilated LJ, angular dependence).
134 103 call ebp(evdw,evdw_p,evdw_m)
136 C Gay-Berne potential (shifted LJ, angular dependence).
137 104 call egb(evdw,evdw_p,evdw_m)
139 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
140 105 call egbv(evdw,evdw_p,evdw_m)
142 C Soft-sphere potential
143 106 call e_softsphere(evdw)
145 C Calculate electrostatic (H-bonding) energy of the main chain.
148 c print *,"Processor",myrank," computed USCSC"
159 time_vec=time_vec+MPI_Wtime()-time01
161 time_vec=time_vec+tcpu()-time01
164 c print *,"Processor",myrank," left VEC_AND_DERIV"
167 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
168 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
169 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
170 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
172 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
173 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
174 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
175 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
177 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
186 c write (iout,*) "Soft-spheer ELEC potential"
187 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
190 c print *,"Processor",myrank," computed UELEC"
192 C Calculate excluded-volume interaction energy between peptide groups
197 call escp(evdw2,evdw2_14)
203 c write (iout,*) "Soft-sphere SCP potential"
204 call escp_soft_sphere(evdw2,evdw2_14)
207 c Calculate the bond-stretching energy
211 C Calculate the disulfide-bridge and other energy and the contributions
212 C from other distance constraints.
213 cd print *,'Calling EHPB'
215 cd print *,'EHPB exitted succesfully.'
217 C Calculate the virtual-bond-angle energy.
219 if (wang.gt.0d0) then
224 c print *,"Processor",myrank," computed UB"
226 C Calculate the SC local energy.
229 c print *,"Processor",myrank," computed USC"
231 C Calculate the virtual-bond torsional energy.
233 cd print *,'nterm=',nterm
235 call etor(etors,edihcnstr)
240 c print *,"Processor",myrank," computed Utor"
242 C 6/23/01 Calculate double-torsional energy
244 if (wtor_d.gt.0) then
249 c print *,"Processor",myrank," computed Utord"
251 C 21/5/07 Calculate local sicdechain correlation energy
253 c if (wsccor.gt.0.0d0) then
254 call eback_sc_corr(esccor)
258 c print *,"Processor",myrank," computed Usccorr"
260 C 12/1/95 Multi-body terms
264 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
265 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
266 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
267 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
268 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
275 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
276 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
277 cd write (iout,*) "multibody_hb ecorr",ecorr
279 c print *,"Processor",myrank," computed Ucorr"
281 C If performing constraint dynamics, call the constraint energy
282 C after the equilibration time
283 c if(usampl.and.totT.gt.eq_time) then
292 time_enecalc=time_enecalc+MPI_Wtime()-time00
294 time_enecalc=time_enecalc+tcpu()-time00
297 c print *,"Processor",myrank," computed Uconstr"
310 energia(2)=evdw2-evdw2_14
327 energia(8)=eello_turn3
328 energia(9)=eello_turn4
335 energia(19)=edihcnstr
337 energia(20)=Uconst+Uconst_back
341 c print *," Processor",myrank," calls SUM_ENERGY"
342 call sum_energy(energia,.true.)
343 c print *," Processor",myrank," left SUM_ENERGY"
346 time_sumene=time_sumene+MPI_Wtime()-time00
348 time_sumene=time_sumene+tcpu()-time00
353 c-------------------------------------------------------------------------------
354 subroutine sum_energy(energia,reduce)
355 implicit real*8 (a-h,o-z)
360 cMS$ATTRIBUTES C :: proc_proc
366 include 'COMMON.SETUP'
367 include 'COMMON.IOUNITS'
368 double precision energia(0:n_ene),enebuff(0:n_ene+1)
369 include 'COMMON.FFIELD'
370 include 'COMMON.DERIV'
371 include 'COMMON.INTERACT'
372 include 'COMMON.SBRIDGE'
373 include 'COMMON.CHAIN'
375 include 'COMMON.CONTROL'
376 include 'COMMON.TIME1'
379 if (nfgtasks.gt.1 .and. reduce) then
381 write (iout,*) "energies before REDUCE"
382 call enerprint(energia)
386 enebuff(i)=energia(i)
389 call MPI_Barrier(FG_COMM,IERR)
390 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
392 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
393 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
395 write (iout,*) "energies after REDUCE"
396 call enerprint(energia)
399 time_Reduce=time_Reduce+MPI_Wtime()-time00
401 if (fg_rank.eq.0) then
404 evdw=energia(22)+wsct*energia(23)
409 evdw2=energia(2)+energia(18)
425 eello_turn3=energia(8)
426 eello_turn4=energia(9)
433 edihcnstr=energia(19)
438 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
439 & +wang*ebe+wtor*etors+wscloc*escloc
440 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
441 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
442 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
443 & +wbond*estr+Uconst+wsccor*esccor
445 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
446 & +wang*ebe+wtor*etors+wscloc*escloc
447 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
448 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
449 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
450 & +wbond*estr+Uconst+wsccor*esccor
456 if (isnan(etot).ne.0) energia(0)=1.0d+99
458 if (isnan(etot)) energia(0)=1.0d+99
463 idumm=proc_proc(etot,i)
465 call proc_proc(etot,i)
467 if(i.eq.1)energia(0)=1.0d+99
474 c-------------------------------------------------------------------------------
475 subroutine sum_gradient
476 implicit real*8 (a-h,o-z)
481 cMS$ATTRIBUTES C :: proc_proc
487 double precision gradbufc(3,maxres),gradbufx(3,maxres),
488 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
489 include 'COMMON.SETUP'
490 include 'COMMON.IOUNITS'
491 include 'COMMON.FFIELD'
492 include 'COMMON.DERIV'
493 include 'COMMON.INTERACT'
494 include 'COMMON.SBRIDGE'
495 include 'COMMON.CHAIN'
497 include 'COMMON.CONTROL'
498 include 'COMMON.TIME1'
499 include 'COMMON.MAXGRAD'
500 include 'COMMON.SCCOR'
509 write (iout,*) "sum_gradient gvdwc, gvdwx"
511 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
512 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
513 & (gvdwcT(j,i),j=1,3)
518 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
519 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
520 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
523 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
524 C in virtual-bond-vector coordinates
527 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
529 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
530 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
532 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
534 c write (iout,'(i5,3f10.5,2x,f10.5)')
535 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
537 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
539 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
540 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
549 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
550 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
551 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
552 & wel_loc*gel_loc_long(j,i)+
553 & wcorr*gradcorr_long(j,i)+
554 & wcorr5*gradcorr5_long(j,i)+
555 & wcorr6*gradcorr6_long(j,i)+
556 & wturn6*gcorr6_turn_long(j,i)+
563 gradbufc(j,i)=wsc*gvdwc(j,i)+
564 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
565 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
566 & wel_loc*gel_loc_long(j,i)+
567 & wcorr*gradcorr_long(j,i)+
568 & wcorr5*gradcorr5_long(j,i)+
569 & wcorr6*gradcorr6_long(j,i)+
570 & wturn6*gcorr6_turn_long(j,i)+
578 gradbufc(j,i)=wsc*gvdwc(j,i)+
579 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
580 & welec*gelc_long(j,i)+
582 & wel_loc*gel_loc_long(j,i)+
583 & wcorr*gradcorr_long(j,i)+
584 & wcorr5*gradcorr5_long(j,i)+
585 & wcorr6*gradcorr6_long(j,i)+
586 & wturn6*gcorr6_turn_long(j,i)+
592 if (nfgtasks.gt.1) then
595 write (iout,*) "gradbufc before allreduce"
597 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
603 gradbufc_sum(j,i)=gradbufc(j,i)
606 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
607 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
608 c time_reduce=time_reduce+MPI_Wtime()-time00
610 c write (iout,*) "gradbufc_sum after allreduce"
612 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
617 c time_allreduce=time_allreduce+MPI_Wtime()-time00
625 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
626 write (iout,*) (i," jgrad_start",jgrad_start(i),
627 & " jgrad_end ",jgrad_end(i),
628 & i=igrad_start,igrad_end)
631 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
632 c do not parallelize this part.
634 c do i=igrad_start,igrad_end
635 c do j=jgrad_start(i),jgrad_end(i)
637 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
642 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
646 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
650 write (iout,*) "gradbufc after summing"
652 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
659 write (iout,*) "gradbufc"
661 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
667 gradbufc_sum(j,i)=gradbufc(j,i)
672 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
676 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
681 c gradbufc(k,i)=0.0d0
685 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
690 write (iout,*) "gradbufc after summing"
692 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
700 gradbufc(k,nres)=0.0d0
705 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
706 & wel_loc*gel_loc(j,i)+
707 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
708 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
709 & wel_loc*gel_loc_long(j,i)+
710 & wcorr*gradcorr_long(j,i)+
711 & wcorr5*gradcorr5_long(j,i)+
712 & wcorr6*gradcorr6_long(j,i)+
713 & wturn6*gcorr6_turn_long(j,i))+
715 & wcorr*gradcorr(j,i)+
716 & wturn3*gcorr3_turn(j,i)+
717 & wturn4*gcorr4_turn(j,i)+
718 & wcorr5*gradcorr5(j,i)+
719 & wcorr6*gradcorr6(j,i)+
720 & wturn6*gcorr6_turn(j,i)+
721 & wsccor*gsccorc(j,i)
722 & +wscloc*gscloc(j,i)
724 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
725 & wel_loc*gel_loc(j,i)+
726 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
727 & welec*gelc_long(j,i)+
728 & wel_loc*gel_loc_long(j,i)+
729 & wcorr*gcorr_long(j,i)+
730 & wcorr5*gradcorr5_long(j,i)+
731 & wcorr6*gradcorr6_long(j,i)+
732 & wturn6*gcorr6_turn_long(j,i))+
734 & wcorr*gradcorr(j,i)+
735 & wturn3*gcorr3_turn(j,i)+
736 & wturn4*gcorr4_turn(j,i)+
737 & wcorr5*gradcorr5(j,i)+
738 & wcorr6*gradcorr6(j,i)+
739 & wturn6*gcorr6_turn(j,i)+
740 & wsccor*gsccorc(j,i)
741 & +wscloc*gscloc(j,i)
744 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
745 & wscp*gradx_scp(j,i)+
747 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
748 & wsccor*gsccorx(j,i)
749 & +wscloc*gsclocx(j,i)
751 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
753 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
754 & wsccor*gsccorx(j,i)
755 & +wscloc*gsclocx(j,i)
760 write (iout,*) "gloc before adding corr"
762 write (iout,*) i,gloc(i,icg)
766 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
767 & +wcorr5*g_corr5_loc(i)
768 & +wcorr6*g_corr6_loc(i)
769 & +wturn4*gel_loc_turn4(i)
770 & +wturn3*gel_loc_turn3(i)
771 & +wturn6*gel_loc_turn6(i)
772 & +wel_loc*gel_loc_loc(i)
775 write (iout,*) "gloc after adding corr"
777 write (iout,*) i,gloc(i,icg)
781 if (nfgtasks.gt.1) then
784 gradbufc(j,i)=gradc(j,i,icg)
785 gradbufx(j,i)=gradx(j,i,icg)
789 glocbuf(i)=gloc(i,icg)
792 write (iout,*) "gloc_sc before reduce"
795 write (iout,*) i,j,gloc_sc(j,i,icg)
801 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
805 call MPI_Barrier(FG_COMM,IERR)
806 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
808 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
809 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
810 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
811 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
812 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
813 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
814 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
815 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
816 time_reduce=time_reduce+MPI_Wtime()-time00
818 write (iout,*) "gloc_sc after reduce"
821 write (iout,*) i,j,gloc_sc(j,i,icg)
826 write (iout,*) "gloc after reduce"
828 write (iout,*) i,gloc(i,icg)
833 if (gnorm_check) then
835 c Compute the maximum elements of the gradient
845 gcorr3_turn_max=0.0d0
846 gcorr4_turn_max=0.0d0
849 gcorr6_turn_max=0.0d0
859 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
860 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
862 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
863 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
865 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
866 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
867 & gvdwc_scp_max=gvdwc_scp_norm
868 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
869 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
870 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
871 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
872 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
873 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
874 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
875 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
876 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
877 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
878 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
879 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
880 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
882 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
883 & gcorr3_turn_max=gcorr3_turn_norm
884 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
886 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
887 & gcorr4_turn_max=gcorr4_turn_norm
888 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
889 if (gradcorr5_norm.gt.gradcorr5_max)
890 & gradcorr5_max=gradcorr5_norm
891 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
892 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
893 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
895 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
896 & gcorr6_turn_max=gcorr6_turn_norm
897 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
898 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
899 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
900 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
901 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
902 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
904 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
905 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
907 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
908 if (gradx_scp_norm.gt.gradx_scp_max)
909 & gradx_scp_max=gradx_scp_norm
910 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
911 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
912 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
913 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
914 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
915 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
916 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
917 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
921 open(istat,file=statname,position="append")
923 open(istat,file=statname,access="append")
925 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
926 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
927 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
928 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
929 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
930 & gsccorx_max,gsclocx_max
932 if (gvdwc_max.gt.1.0d4) then
933 write (iout,*) "gvdwc gvdwx gradb gradbx"
935 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
936 & gradb(j,i),gradbx(j,i),j=1,3)
938 call pdbout(0.0d0,'cipiszcze',iout)
944 write (iout,*) "gradc gradx gloc"
946 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
947 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
952 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
954 time_sumgradient=time_sumgradient+tcpu()-time01
959 c-------------------------------------------------------------------------------
960 subroutine rescale_weights(t_bath)
961 implicit real*8 (a-h,o-z)
963 include 'COMMON.IOUNITS'
964 include 'COMMON.FFIELD'
965 include 'COMMON.SBRIDGE'
966 double precision kfac /2.4d0/
967 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
969 c facT=2*temp0/(t_bath+temp0)
970 if (rescale_mode.eq.0) then
976 else if (rescale_mode.eq.1) then
977 facT=kfac/(kfac-1.0d0+t_bath/temp0)
978 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
979 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
980 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
981 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
982 else if (rescale_mode.eq.2) then
988 facT=licznik/dlog(dexp(x)+dexp(-x))
989 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
990 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
991 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
992 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
994 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
995 write (*,*) "Wrong RESCALE_MODE",rescale_mode
997 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1001 welec=weights(3)*fact
1002 wcorr=weights(4)*fact3
1003 wcorr5=weights(5)*fact4
1004 wcorr6=weights(6)*fact5
1005 wel_loc=weights(7)*fact2
1006 wturn3=weights(8)*fact2
1007 wturn4=weights(9)*fact3
1008 wturn6=weights(10)*fact5
1009 wtor=weights(13)*fact
1010 wtor_d=weights(14)*fact2
1011 wsccor=weights(21)*fact
1014 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1018 C------------------------------------------------------------------------
1019 subroutine enerprint(energia)
1020 implicit real*8 (a-h,o-z)
1021 include 'DIMENSIONS'
1022 include 'COMMON.IOUNITS'
1023 include 'COMMON.FFIELD'
1024 include 'COMMON.SBRIDGE'
1026 double precision energia(0:n_ene)
1029 evdw=energia(22)+wsct*energia(23)
1035 evdw2=energia(2)+energia(18)
1047 eello_turn3=energia(8)
1048 eello_turn4=energia(9)
1049 eello_turn6=energia(10)
1055 edihcnstr=energia(19)
1060 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1061 & estr,wbond,ebe,wang,
1062 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1064 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1065 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1066 & edihcnstr,ebr*nss,
1068 10 format (/'Virtual-chain energies:'//
1069 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1070 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1071 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1072 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1073 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1074 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1075 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1076 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1077 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1078 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1079 & ' (SS bridges & dist. cnstr.)'/
1080 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1081 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1082 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1083 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1084 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1085 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1086 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1087 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1088 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1089 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1090 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1091 & 'ETOT= ',1pE16.6,' (total)')
1093 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1094 & estr,wbond,ebe,wang,
1095 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1097 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1098 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1099 & ebr*nss,Uconst,etot
1100 10 format (/'Virtual-chain energies:'//
1101 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1102 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1103 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1104 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1105 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1106 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1107 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1108 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1109 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1110 & ' (SS bridges & dist. cnstr.)'/
1111 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1112 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1113 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1114 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1115 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1116 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1117 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1118 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1119 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1120 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1121 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1122 & 'ETOT= ',1pE16.6,' (total)')
1126 C-----------------------------------------------------------------------
1127 subroutine elj(evdw,evdw_p,evdw_m)
1129 C This subroutine calculates the interaction energy of nonbonded side chains
1130 C assuming the LJ potential of interaction.
1132 implicit real*8 (a-h,o-z)
1133 include 'DIMENSIONS'
1134 parameter (accur=1.0d-10)
1135 include 'COMMON.GEO'
1136 include 'COMMON.VAR'
1137 include 'COMMON.LOCAL'
1138 include 'COMMON.CHAIN'
1139 include 'COMMON.DERIV'
1140 include 'COMMON.INTERACT'
1141 include 'COMMON.TORSION'
1142 include 'COMMON.SBRIDGE'
1143 include 'COMMON.NAMES'
1144 include 'COMMON.IOUNITS'
1145 include 'COMMON.CONTACTS'
1146 include "COMMON.ECOMPON"
1148 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1150 do i=iatsc_s,iatsc_e
1156 if (itypi.eq.ntyp1) cycle
1160 C Calculate SC interaction energy.
1162 do iint=1,nint_gr(i)
1163 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1164 cd & 'iend=',iend(i,iint)
1165 do j=istart(i,iint),iend(i,iint)
1167 if (itypj.eq.ntyp1) cycle
1171 C Change 12/1/95 to calculate four-body interactions
1172 rij=xj*xj+yj*yj+zj*zj
1174 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1175 eps0ij=eps(itypi,itypj)
1177 e1=fac*fac*aa(itypi,itypj)
1178 e2=fac*bb(itypi,itypj)
1180 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1181 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1182 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1183 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1184 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1185 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1186 vdwcompon(itypi,itypj)=vdwcompon(itypi,itypj)+evdwij
1188 if (bb(itypi,itypj).gt.0) then
1189 evdw_p=evdw_p+evdwij
1191 evdw_m=evdw_m+evdwij
1197 C Calculate the components of the gradient in DC and X
1199 fac=-rrij*(e1+evdwij)
1204 if (bb(itypi,itypj).gt.0.0d0) then
1206 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1207 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1208 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1209 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1213 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1214 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1215 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1216 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1221 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1222 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1223 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1224 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1229 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1233 C 12/1/95, revised on 5/20/97
1235 C Calculate the contact function. The ith column of the array JCONT will
1236 C contain the numbers of atoms that make contacts with the atom I (of numbers
1237 C greater than I). The arrays FACONT and GACONT will contain the values of
1238 C the contact function and its derivative.
1240 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1241 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1242 C Uncomment next line, if the correlation interactions are contact function only
1243 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1245 sigij=sigma(itypi,itypj)
1246 r0ij=rs0(itypi,itypj)
1248 C Check whether the SC's are not too far to make a contact.
1251 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1252 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1254 if (fcont.gt.0.0D0) then
1255 C If the SC-SC distance if close to sigma, apply spline.
1256 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1257 cAdam & fcont1,fprimcont1)
1258 cAdam fcont1=1.0d0-fcont1
1259 cAdam if (fcont1.gt.0.0d0) then
1260 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1261 cAdam fcont=fcont*fcont1
1263 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1264 cga eps0ij=1.0d0/dsqrt(eps0ij)
1266 cga gg(k)=gg(k)*eps0ij
1268 cga eps0ij=-evdwij*eps0ij
1269 C Uncomment for AL's type of SC correlation interactions.
1270 cadam eps0ij=-evdwij
1271 num_conti=num_conti+1
1272 jcont(num_conti,i)=j
1273 facont(num_conti,i)=fcont*eps0ij
1274 fprimcont=eps0ij*fprimcont/rij
1276 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1277 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1278 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1279 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1280 gacont(1,num_conti,i)=-fprimcont*xj
1281 gacont(2,num_conti,i)=-fprimcont*yj
1282 gacont(3,num_conti,i)=-fprimcont*zj
1283 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1284 cd write (iout,'(2i3,3f10.5)')
1285 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1291 num_cont(i)=num_conti
1295 gvdwc(j,i)=expon*gvdwc(j,i)
1296 gvdwx(j,i)=expon*gvdwx(j,i)
1299 C******************************************************************************
1303 C To save time, the factor of EXPON has been extracted from ALL components
1304 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1307 C******************************************************************************
1310 C-----------------------------------------------------------------------------
1311 subroutine eljk(evdw,evdw_p,evdw_m)
1313 C This subroutine calculates the interaction energy of nonbonded side chains
1314 C assuming the LJK potential of interaction.
1316 implicit real*8 (a-h,o-z)
1317 include 'DIMENSIONS'
1318 include 'COMMON.GEO'
1319 include 'COMMON.VAR'
1320 include 'COMMON.LOCAL'
1321 include 'COMMON.CHAIN'
1322 include 'COMMON.DERIV'
1323 include 'COMMON.INTERACT'
1324 include 'COMMON.IOUNITS'
1325 include 'COMMON.NAMES'
1326 include "COMMON.ECOMPON"
1329 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1331 do i=iatsc_s,iatsc_e
1337 if (itypi.eq.ntyp1) cycle
1339 C Calculate SC interaction energy.
1341 do iint=1,nint_gr(i)
1342 do j=istart(i,iint),iend(i,iint)
1344 if (itypj.eq.ntyp1) cycle
1348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1349 fac_augm=rrij**expon
1350 e_augm=augm(itypi,itypj)*fac_augm
1351 r_inv_ij=dsqrt(rrij)
1353 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1354 fac=r_shift_inv**expon
1355 e1=fac*fac*aa(itypi,itypj)
1356 e2=fac*bb(itypi,itypj)
1358 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1359 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1360 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1361 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1362 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1363 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1364 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1365 vdwcompon(itypi,itypj)=vdwcompon(itypi,itypj)+evdwij
1367 if (bb(itypi,itypj).gt.0) then
1368 evdw_p=evdw_p+evdwij
1370 evdw_m=evdw_m+evdwij
1376 C Calculate the components of the gradient in DC and X
1378 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1383 if (bb(itypi,itypj).gt.0.0d0) then
1385 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1386 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1387 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1388 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1392 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1393 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1394 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1395 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1400 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1401 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1402 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1403 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1408 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1416 gvdwc(j,i)=expon*gvdwc(j,i)
1417 gvdwx(j,i)=expon*gvdwx(j,i)
1422 C-----------------------------------------------------------------------------
1423 subroutine ebp(evdw,evdw_p,evdw_m)
1425 C This subroutine calculates the interaction energy of nonbonded side chains
1426 C assuming the Berne-Pechukas potential of interaction.
1428 implicit real*8 (a-h,o-z)
1429 include 'DIMENSIONS'
1430 include 'COMMON.GEO'
1431 include 'COMMON.VAR'
1432 include 'COMMON.LOCAL'
1433 include 'COMMON.CHAIN'
1434 include 'COMMON.DERIV'
1435 include 'COMMON.NAMES'
1436 include 'COMMON.INTERACT'
1437 include 'COMMON.IOUNITS'
1438 include 'COMMON.CALC'
1439 include "COMMON.ECOMPON"
1440 common /srutu/ icall
1441 c double precision rrsave(maxdim)
1444 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1446 c if (icall.eq.0) then
1452 do i=iatsc_s,iatsc_e
1458 if (itypi.eq.ntyp1) cycle
1459 dxi=dc_norm(1,nres+i)
1460 dyi=dc_norm(2,nres+i)
1461 dzi=dc_norm(3,nres+i)
1462 c dsci_inv=dsc_inv(itypi)
1463 dsci_inv=vbld_inv(i+nres)
1465 C Calculate SC interaction energy.
1467 do iint=1,nint_gr(i)
1468 do j=istart(i,iint),iend(i,iint)
1471 if (itypj.eq.ntyp1) cycle
1472 c dscj_inv=dsc_inv(itypj)
1473 dscj_inv=vbld_inv(j+nres)
1474 chi1=chi(itypi,itypj)
1475 chi2=chi(itypj,itypi)
1482 alf12=0.5D0*(alf1+alf2)
1483 C For diagnostics only!!!
1496 dxj=dc_norm(1,nres+j)
1497 dyj=dc_norm(2,nres+j)
1498 dzj=dc_norm(3,nres+j)
1499 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1500 cd if (icall.eq.0) then
1506 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1508 C Calculate whole angle-dependent part of epsilon and contributions
1509 C to its derivatives
1510 fac=(rrij*sigsq)**expon2
1511 e1=fac*fac*aa(itypi,itypj)
1512 e2=fac*bb(itypi,itypj)
1513 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1514 eps2der=evdwij*eps3rt
1515 eps3der=evdwij*eps2rt
1516 evdwij=evdwij*eps2rt*eps3rt
1517 vdwcompon(itypi,itypj)=vdwcompon(itypi,itypj)+evdwij
1519 if (bb(itypi,itypj).gt.0) then
1520 evdw_p=evdw_p+evdwij
1522 evdw_m=evdw_m+evdwij
1528 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1529 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1530 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1531 cd & restyp(itypi),i,restyp(itypj),j,
1532 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1533 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1534 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1537 C Calculate gradient components.
1538 e1=e1*eps1*eps2rt**2*eps3rt**2
1539 fac=-expon*(e1+evdwij)
1542 C Calculate radial part of the gradient
1546 C Calculate the angular part of the gradient and sum add the contributions
1547 C to the appropriate components of the Cartesian gradient.
1549 if (bb(itypi,itypj).gt.0) then
1563 C-----------------------------------------------------------------------------
1564 subroutine egb(evdw,evdw_p,evdw_m)
1566 C This subroutine calculates the interaction energy of nonbonded side chains
1567 C assuming the Gay-Berne potential of interaction.
1569 implicit real*8 (a-h,o-z)
1570 include 'DIMENSIONS'
1571 include 'COMMON.GEO'
1572 include 'COMMON.VAR'
1573 include 'COMMON.LOCAL'
1574 include 'COMMON.CHAIN'
1575 include 'COMMON.DERIV'
1576 include 'COMMON.NAMES'
1577 include 'COMMON.INTERACT'
1578 include 'COMMON.IOUNITS'
1579 include 'COMMON.CALC'
1580 include 'COMMON.CONTROL'
1581 include "COMMON.ECOMPON"
1584 ccccc energy_dec=.false.
1585 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1590 c if (icall.eq.0) lprn=.false.
1592 do i=iatsc_s,iatsc_e
1594 if (itypi.eq.ntyp1) cycle
1599 dxi=dc_norm(1,nres+i)
1600 dyi=dc_norm(2,nres+i)
1601 dzi=dc_norm(3,nres+i)
1602 c dsci_inv=dsc_inv(itypi)
1603 dsci_inv=vbld_inv(i+nres)
1604 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1605 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1607 C Calculate SC interaction energy.
1609 do iint=1,nint_gr(i)
1610 do j=istart(i,iint),iend(i,iint)
1613 if (itypj.eq.ntyp1) cycle
1614 c dscj_inv=dsc_inv(itypj)
1615 dscj_inv=vbld_inv(j+nres)
1616 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1617 c & 1.0d0/vbld(j+nres)
1618 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1619 sig0ij=sigma(itypi,itypj)
1620 chi1=chi(itypi,itypj)
1621 chi2=chi(itypj,itypi)
1628 alf12=0.5D0*(alf1+alf2)
1629 C For diagnostics only!!!
1642 dxj=dc_norm(1,nres+j)
1643 dyj=dc_norm(2,nres+j)
1644 dzj=dc_norm(3,nres+j)
1645 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1646 c write (iout,*) "j",j," dc_norm",
1647 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1648 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1650 C Calculate angle-dependent terms of energy and contributions to their
1654 sig=sig0ij*dsqrt(sigsq)
1655 rij_shift=1.0D0/rij-sig+sig0ij
1656 c for diagnostics; uncomment
1657 c rij_shift=1.2*sig0ij
1658 C I hate to put IF's in the loops, but here don't have another choice!!!!
1659 if (rij_shift.le.0.0D0) then
1661 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1662 cd & restyp(itypi),i,restyp(itypj),j,
1663 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1667 c---------------------------------------------------------------
1668 rij_shift=1.0D0/rij_shift
1669 fac=rij_shift**expon
1670 e1=fac*fac*aa(itypi,itypj)
1671 e2=fac*bb(itypi,itypj)
1672 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1673 eps2der=evdwij*eps3rt
1674 eps3der=evdwij*eps2rt
1675 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1676 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1677 evdwij=evdwij*eps2rt*eps3rt
1678 vdwcompon(itypi,itypj)=vdwcompon(itypi,itypj)+evdwij
1680 if (bb(itypi,itypj).gt.0) then
1681 evdw_p=evdw_p+evdwij
1683 evdw_m=evdw_m+evdwij
1689 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1690 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1691 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1692 & restyp(itypi),i,restyp(itypj),j,
1693 & epsi,sigm,chi1,chi2,chip1,chip2,
1694 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1695 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1699 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1702 C Calculate gradient components.
1703 e1=e1*eps1*eps2rt**2*eps3rt**2
1704 fac=-expon*(e1+evdwij)*rij_shift
1708 C Calculate the radial part of the gradient
1712 C Calculate angular part of the gradient.
1714 if (bb(itypi,itypj).gt.0) then
1725 c write (iout,*) "Number of loop steps in EGB:",ind
1726 cccc energy_dec=.false.
1729 C-----------------------------------------------------------------------------
1730 subroutine egbv(evdw,evdw_p,evdw_m)
1732 C This subroutine calculates the interaction energy of nonbonded side chains
1733 C assuming the Gay-Berne-Vorobjev potential of interaction.
1735 implicit real*8 (a-h,o-z)
1736 include 'DIMENSIONS'
1737 include 'COMMON.GEO'
1738 include 'COMMON.VAR'
1739 include 'COMMON.LOCAL'
1740 include 'COMMON.CHAIN'
1741 include 'COMMON.DERIV'
1742 include 'COMMON.NAMES'
1743 include 'COMMON.INTERACT'
1744 include 'COMMON.IOUNITS'
1745 include 'COMMON.CALC'
1746 include "COMMON.ECOMPON"
1747 common /srutu/ icall
1750 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1753 c if (icall.eq.0) lprn=.true.
1755 do i=iatsc_s,iatsc_e
1761 if (itypi.eq.ntyp1) cycle
1762 dxi=dc_norm(1,nres+i)
1763 dyi=dc_norm(2,nres+i)
1764 dzi=dc_norm(3,nres+i)
1765 c dsci_inv=dsc_inv(itypi)
1766 dsci_inv=vbld_inv(i+nres)
1768 C Calculate SC interaction energy.
1770 do iint=1,nint_gr(i)
1771 do j=istart(i,iint),iend(i,iint)
1774 if (itypj.eq.ntyp1) cycle
1775 c dscj_inv=dsc_inv(itypj)
1776 dscj_inv=vbld_inv(j+nres)
1777 sig0ij=sigma(itypi,itypj)
1778 r0ij=r0(itypi,itypj)
1779 chi1=chi(itypi,itypj)
1780 chi2=chi(itypj,itypi)
1787 alf12=0.5D0*(alf1+alf2)
1788 C For diagnostics only!!!
1801 dxj=dc_norm(1,nres+j)
1802 dyj=dc_norm(2,nres+j)
1803 dzj=dc_norm(3,nres+j)
1804 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1806 C Calculate angle-dependent terms of energy and contributions to their
1810 sig=sig0ij*dsqrt(sigsq)
1811 rij_shift=1.0D0/rij-sig+r0ij
1812 C I hate to put IF's in the loops, but here don't have another choice!!!!
1813 if (rij_shift.le.0.0D0) then
1818 c---------------------------------------------------------------
1819 rij_shift=1.0D0/rij_shift
1820 fac=rij_shift**expon
1821 e1=fac*fac*aa(itypi,itypj)
1822 e2=fac*bb(itypi,itypj)
1823 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1824 eps2der=evdwij*eps3rt
1825 eps3der=evdwij*eps2rt
1826 fac_augm=rrij**expon
1827 e_augm=augm(itypi,itypj)*fac_augm
1828 evdwij=evdwij*eps2rt*eps3rt
1829 vdwcompon(itypi,itypj)=vdwcompon(itypi,itypj)+evdwij
1831 if (bb(itypi,itypj).gt.0) then
1832 evdw_p=evdw_p+evdwij+e_augm
1834 evdw_m=evdw_m+evdwij+e_augm
1837 evdw=evdw+evdwij+e_augm
1840 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1841 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1842 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1843 & restyp(itypi),i,restyp(itypj),j,
1844 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1845 & chi1,chi2,chip1,chip2,
1846 & eps1,eps2rt**2,eps3rt**2,
1847 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1850 C Calculate gradient components.
1851 e1=e1*eps1*eps2rt**2*eps3rt**2
1852 fac=-expon*(e1+evdwij)*rij_shift
1854 fac=rij*fac-2*expon*rrij*e_augm
1855 C Calculate the radial part of the gradient
1859 C Calculate angular part of the gradient.
1861 if (bb(itypi,itypj).gt.0) then
1873 C-----------------------------------------------------------------------------
1874 subroutine sc_angular
1875 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1876 C om12. Called by ebp, egb, and egbv.
1878 include 'COMMON.CALC'
1879 include 'COMMON.IOUNITS'
1883 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1884 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1885 om12=dxi*dxj+dyi*dyj+dzi*dzj
1887 C Calculate eps1(om12) and its derivative in om12
1888 faceps1=1.0D0-om12*chiom12
1889 faceps1_inv=1.0D0/faceps1
1890 eps1=dsqrt(faceps1_inv)
1891 C Following variable is eps1*deps1/dom12
1892 eps1_om12=faceps1_inv*chiom12
1897 c write (iout,*) "om12",om12," eps1",eps1
1898 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1903 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1904 sigsq=1.0D0-facsig*faceps1_inv
1905 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1906 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1907 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1913 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1914 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1916 C Calculate eps2 and its derivatives in om1, om2, and om12.
1919 chipom12=chip12*om12
1920 facp=1.0D0-om12*chipom12
1922 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1923 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1924 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1925 C Following variable is the square root of eps2
1926 eps2rt=1.0D0-facp1*facp_inv
1927 C Following three variables are the derivatives of the square root of eps
1928 C in om1, om2, and om12.
1929 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1930 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1931 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1932 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1933 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1934 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1935 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1936 c & " eps2rt_om12",eps2rt_om12
1937 C Calculate whole angle-dependent part of epsilon and contributions
1938 C to its derivatives
1942 C----------------------------------------------------------------------------
1943 subroutine sc_grad_T
1944 implicit real*8 (a-h,o-z)
1945 include 'DIMENSIONS'
1946 include 'COMMON.CHAIN'
1947 include 'COMMON.DERIV'
1948 include 'COMMON.CALC'
1949 include 'COMMON.IOUNITS'
1950 double precision dcosom1(3),dcosom2(3)
1951 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1952 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1953 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1954 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1958 c eom12=evdwij*eps1_om12
1960 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1961 c & " sigder",sigder
1962 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1963 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1965 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1966 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1969 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1971 c write (iout,*) "gg",(gg(k),k=1,3)
1973 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1974 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1975 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1977 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1978 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1979 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1980 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1981 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1982 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1985 C Calculate the components of the gradient in DC and X
1989 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1993 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1994 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1999 C----------------------------------------------------------------------------
2001 implicit real*8 (a-h,o-z)
2002 include 'DIMENSIONS'
2003 include 'COMMON.CHAIN'
2004 include 'COMMON.DERIV'
2005 include 'COMMON.CALC'
2006 include 'COMMON.IOUNITS'
2007 double precision dcosom1(3),dcosom2(3)
2008 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2009 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2010 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2011 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2015 c eom12=evdwij*eps1_om12
2017 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2018 c & " sigder",sigder
2019 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2020 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2022 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2023 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2026 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2028 c write (iout,*) "gg",(gg(k),k=1,3)
2030 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2031 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2032 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2033 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2034 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2035 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2036 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2037 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2038 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2039 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2042 C Calculate the components of the gradient in DC and X
2046 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2050 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2051 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2055 C-----------------------------------------------------------------------
2056 subroutine e_softsphere(evdw)
2058 C This subroutine calculates the interaction energy of nonbonded side chains
2059 C assuming the LJ potential of interaction.
2061 implicit real*8 (a-h,o-z)
2062 include 'DIMENSIONS'
2063 parameter (accur=1.0d-10)
2064 include 'COMMON.GEO'
2065 include 'COMMON.VAR'
2066 include 'COMMON.LOCAL'
2067 include 'COMMON.CHAIN'
2068 include 'COMMON.DERIV'
2069 include 'COMMON.INTERACT'
2070 include 'COMMON.TORSION'
2071 include 'COMMON.SBRIDGE'
2072 include 'COMMON.NAMES'
2073 include 'COMMON.IOUNITS'
2074 include 'COMMON.CONTACTS'
2076 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2078 do i=iatsc_s,iatsc_e
2084 if (itypi.eq.ntyp1) cycle
2086 C Calculate SC interaction energy.
2088 do iint=1,nint_gr(i)
2089 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2090 cd & 'iend=',iend(i,iint)
2091 do j=istart(i,iint),iend(i,iint)
2092 if (itypj.eq.ntyp1) cycle
2097 rij=xj*xj+yj*yj+zj*zj
2098 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2099 r0ij=r0(itypi,itypj)
2101 c print *,i,j,r0ij,dsqrt(rij)
2102 if (rij.lt.r0ijsq) then
2103 evdwij=0.25d0*(rij-r0ijsq)**2
2111 C Calculate the components of the gradient in DC and X
2117 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2118 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2119 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2120 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2124 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2132 C--------------------------------------------------------------------------
2133 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2136 C Soft-sphere potential of p-p interaction
2138 implicit real*8 (a-h,o-z)
2139 include 'DIMENSIONS'
2140 include 'COMMON.CONTROL'
2141 include 'COMMON.IOUNITS'
2142 include 'COMMON.GEO'
2143 include 'COMMON.VAR'
2144 include 'COMMON.LOCAL'
2145 include 'COMMON.CHAIN'
2146 include 'COMMON.DERIV'
2147 include 'COMMON.INTERACT'
2148 include 'COMMON.CONTACTS'
2149 include 'COMMON.TORSION'
2150 include 'COMMON.VECTORS'
2151 include 'COMMON.FFIELD'
2153 cd write(iout,*) 'In EELEC_soft_sphere'
2160 do i=iatel_s,iatel_e
2161 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2165 xmedi=c(1,i)+0.5d0*dxi
2166 ymedi=c(2,i)+0.5d0*dyi
2167 zmedi=c(3,i)+0.5d0*dzi
2169 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2170 do j=ielstart(i),ielend(i)
2171 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2173 if (c(1,j).eq.1.0d10 .or. c(1,j+1).eq.1.0d10 .or.
2174 & c(2,j).eq.1.0d10 .or. c(2,j+1).eq.1.0d10 .or.
2175 & c(3,j).eq.1.0d10 .or. c(3,j+1).eq.1.0d10) cycle
2178 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2179 r0ij=rpp(iteli,itelj)
2184 xj=c(1,j)+0.5D0*dxj-xmedi
2185 yj=c(2,j)+0.5D0*dyj-ymedi
2186 zj=c(3,j)+0.5D0*dzj-zmedi
2187 rij=xj*xj+yj*yj+zj*zj
2188 if (rij.lt.r0ijsq) then
2189 evdw1ij=0.25d0*(rij-r0ijsq)**2
2197 C Calculate contributions to the Cartesian gradient.
2203 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2204 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2207 * Loop over residues i+1 thru j-1.
2211 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2216 cgrad do i=nnt,nct-1
2218 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2220 cgrad do j=i+1,nct-1
2222 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2228 c------------------------------------------------------------------------------
2229 subroutine vec_and_deriv
2230 implicit real*8 (a-h,o-z)
2231 include 'DIMENSIONS'
2235 include 'COMMON.IOUNITS'
2236 include 'COMMON.GEO'
2237 include 'COMMON.VAR'
2238 include 'COMMON.LOCAL'
2239 include 'COMMON.CHAIN'
2240 include 'COMMON.VECTORS'
2241 include 'COMMON.SETUP'
2242 include 'COMMON.TIME1'
2243 include 'COMMON.INTERACT'
2244 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2245 C Compute the local reference systems. For reference system (i), the
2246 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2247 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2249 do i=ivec_start,ivec_end
2253 if (itype(i).eq.ntyp1 .or.
2254 & itype(i+1).eq.ntyp1) cycle
2255 if (i.eq.nres-1) then
2256 C Case of the last full residue
2257 C Compute the Z-axis
2258 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2259 costh=dcos(pi-theta(nres))
2260 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2264 C Compute the derivatives of uz
2266 uzder(2,1,1)=-dc_norm(3,i-1)
2267 uzder(3,1,1)= dc_norm(2,i-1)
2268 uzder(1,2,1)= dc_norm(3,i-1)
2270 uzder(3,2,1)=-dc_norm(1,i-1)
2271 uzder(1,3,1)=-dc_norm(2,i-1)
2272 uzder(2,3,1)= dc_norm(1,i-1)
2275 uzder(2,1,2)= dc_norm(3,i)
2276 uzder(3,1,2)=-dc_norm(2,i)
2277 uzder(1,2,2)=-dc_norm(3,i)
2279 uzder(3,2,2)= dc_norm(1,i)
2280 uzder(1,3,2)= dc_norm(2,i)
2281 uzder(2,3,2)=-dc_norm(1,i)
2283 C Compute the Y-axis
2286 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2288 C Compute the derivatives of uy
2291 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2292 & -dc_norm(k,i)*dc_norm(j,i-1)
2293 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2295 uyder(j,j,1)=uyder(j,j,1)-costh
2296 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2301 uygrad(l,k,j,i)=uyder(l,k,j)
2302 uzgrad(l,k,j,i)=uzder(l,k,j)
2306 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2307 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2308 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2309 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2312 C Compute the Z-axis
2313 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2314 costh=dcos(pi-theta(i+2))
2315 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2319 C Compute the derivatives of uz
2321 uzder(2,1,1)=-dc_norm(3,i+1)
2322 uzder(3,1,1)= dc_norm(2,i+1)
2323 uzder(1,2,1)= dc_norm(3,i+1)
2325 uzder(3,2,1)=-dc_norm(1,i+1)
2326 uzder(1,3,1)=-dc_norm(2,i+1)
2327 uzder(2,3,1)= dc_norm(1,i+1)
2330 uzder(2,1,2)= dc_norm(3,i)
2331 uzder(3,1,2)=-dc_norm(2,i)
2332 uzder(1,2,2)=-dc_norm(3,i)
2334 uzder(3,2,2)= dc_norm(1,i)
2335 uzder(1,3,2)= dc_norm(2,i)
2336 uzder(2,3,2)=-dc_norm(1,i)
2338 C Compute the Y-axis
2341 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2343 C Compute the derivatives of uy
2346 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2347 & -dc_norm(k,i)*dc_norm(j,i+1)
2348 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2350 uyder(j,j,1)=uyder(j,j,1)-costh
2351 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2356 uygrad(l,k,j,i)=uyder(l,k,j)
2357 uzgrad(l,k,j,i)=uzder(l,k,j)
2361 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2362 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2363 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2364 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2368 vbld_inv_temp(1)=vbld_inv(i+1)
2369 if (i.lt.nres-1) then
2370 vbld_inv_temp(2)=vbld_inv(i+2)
2372 vbld_inv_temp(2)=vbld_inv(i)
2377 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2378 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2383 #if defined(PARVEC) && defined(MPI)
2384 if (nfgtasks1.gt.1) then
2386 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2387 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2388 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2389 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2390 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2392 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2393 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2395 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2396 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2397 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2398 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2399 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2400 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2401 time_gather=time_gather+MPI_Wtime()-time00
2403 c if (fg_rank.eq.0) then
2404 c write (iout,*) "Arrays UY and UZ"
2406 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2413 C-----------------------------------------------------------------------------
2414 subroutine check_vecgrad
2415 implicit real*8 (a-h,o-z)
2416 include 'DIMENSIONS'
2417 include 'COMMON.IOUNITS'
2418 include 'COMMON.GEO'
2419 include 'COMMON.VAR'
2420 include 'COMMON.LOCAL'
2421 include 'COMMON.CHAIN'
2422 include 'COMMON.VECTORS'
2423 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2424 dimension uyt(3,maxres),uzt(3,maxres)
2425 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2426 double precision delta /1.0d-7/
2429 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2430 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2431 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2432 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2433 cd & (dc_norm(if90,i),if90=1,3)
2434 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2435 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2436 cd write(iout,'(a)')
2442 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2443 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2456 cd write (iout,*) 'i=',i
2458 erij(k)=dc_norm(k,i)
2462 dc_norm(k,i)=erij(k)
2464 dc_norm(j,i)=dc_norm(j,i)+delta
2465 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2467 c dc_norm(k,i)=dc_norm(k,i)/fac
2469 c write (iout,*) (dc_norm(k,i),k=1,3)
2470 c write (iout,*) (erij(k),k=1,3)
2473 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2474 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2475 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2476 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2478 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2479 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2480 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2483 dc_norm(k,i)=erij(k)
2486 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2487 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2488 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2489 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2490 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2491 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2492 cd write (iout,'(a)')
2497 C--------------------------------------------------------------------------
2498 subroutine set_matrices
2499 implicit real*8 (a-h,o-z)
2500 include 'DIMENSIONS'
2503 include "COMMON.SETUP"
2505 integer status(MPI_STATUS_SIZE)
2507 include 'COMMON.IOUNITS'
2508 include 'COMMON.GEO'
2509 include 'COMMON.VAR'
2510 include 'COMMON.LOCAL'
2511 include 'COMMON.CHAIN'
2512 include 'COMMON.DERIV'
2513 include 'COMMON.INTERACT'
2514 include 'COMMON.CONTACTS'
2515 include 'COMMON.TORSION'
2516 include 'COMMON.VECTORS'
2517 include 'COMMON.FFIELD'
2518 double precision auxvec(2),auxmat(2,2)
2520 C Compute the virtual-bond-torsional-angle dependent quantities needed
2521 C to calculate the el-loc multibody terms of various order.
2524 do i=ivec_start+2,ivec_end+2
2528 if (itype(i-1).eq.ntyp1 .or.
2529 & itype(i-2).eq.ntyp1) cycle
2530 if (i .lt. nres+1) then
2567 if (i .gt. 3 .and. i .lt. nres+1) then
2568 obrot_der(1,i-2)=-sin1
2569 obrot_der(2,i-2)= cos1
2570 Ugder(1,1,i-2)= sin1
2571 Ugder(1,2,i-2)=-cos1
2572 Ugder(2,1,i-2)=-cos1
2573 Ugder(2,2,i-2)=-sin1
2576 obrot2_der(1,i-2)=-dwasin2
2577 obrot2_der(2,i-2)= dwacos2
2578 Ug2der(1,1,i-2)= dwasin2
2579 Ug2der(1,2,i-2)=-dwacos2
2580 Ug2der(2,1,i-2)=-dwacos2
2581 Ug2der(2,2,i-2)=-dwasin2
2583 obrot_der(1,i-2)=0.0d0
2584 obrot_der(2,i-2)=0.0d0
2585 Ugder(1,1,i-2)=0.0d0
2586 Ugder(1,2,i-2)=0.0d0
2587 Ugder(2,1,i-2)=0.0d0
2588 Ugder(2,2,i-2)=0.0d0
2589 obrot2_der(1,i-2)=0.0d0
2590 obrot2_der(2,i-2)=0.0d0
2591 Ug2der(1,1,i-2)=0.0d0
2592 Ug2der(1,2,i-2)=0.0d0
2593 Ug2der(2,1,i-2)=0.0d0
2594 Ug2der(2,2,i-2)=0.0d0
2596 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2597 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2598 iti = itortyp(itype(i-2))
2602 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2603 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2604 iti1 = itortyp(itype(i-1))
2608 cd write (iout,*) '*******i',i,' iti1',iti
2609 cd write (iout,*) 'b1',b1(:,iti)
2610 cd write (iout,*) 'b2',b2(:,iti)
2611 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2612 c if (i .gt. iatel_s+2) then
2613 if (i .gt. nnt+2) then
2614 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2615 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2616 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2618 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2619 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2620 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2621 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2622 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2633 DtUg2(l,k,i-2)=0.0d0
2637 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2638 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2640 muder(k,i-2)=Ub2der(k,i-2)
2642 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2643 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2644 iti1 = itortyp(itype(i-1))
2649 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2651 cd write (iout,*) 'mu ',mu(:,i-2)
2652 cd write (iout,*) 'mu1',mu1(:,i-2)
2653 cd write (iout,*) 'mu2',mu2(:,i-2)
2654 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2656 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2657 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2658 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2659 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2660 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2661 C Vectors and matrices dependent on a single virtual-bond dihedral.
2662 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2663 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2664 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2665 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2666 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2667 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2668 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2669 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2670 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2673 C Matrices dependent on two consecutive virtual-bond dihedrals.
2674 C The order of matrices is from left to right.
2675 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2677 c do i=max0(ivec_start,2),ivec_end
2679 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2680 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2681 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2682 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2683 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2684 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2685 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2686 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2689 #if defined(MPI) && defined(PARMAT)
2691 c if (fg_rank.eq.0) then
2692 write (iout,*) "Arrays UG and UGDER before GATHER"
2694 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2695 & ((ug(l,k,i),l=1,2),k=1,2),
2696 & ((ugder(l,k,i),l=1,2),k=1,2)
2698 write (iout,*) "Arrays UG2 and UG2DER"
2700 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2701 & ((ug2(l,k,i),l=1,2),k=1,2),
2702 & ((ug2der(l,k,i),l=1,2),k=1,2)
2704 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2706 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2707 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2708 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2710 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2712 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2713 & costab(i),sintab(i),costab2(i),sintab2(i)
2715 write (iout,*) "Array MUDER"
2717 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2721 if (nfgtasks.gt.1) then
2723 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2724 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2725 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2727 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2728 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2730 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2731 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2733 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2740 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2742 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2745 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2746 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2747 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2748 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2749 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2750 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2751 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2752 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2753 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2754 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2755 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2756 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2757 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2759 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2760 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2762 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2763 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2765 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2766 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2768 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2769 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2771 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2772 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2774 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2775 & ivec_count(fg_rank1),
2776 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2778 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2779 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2781 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2782 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2784 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2785 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2787 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2788 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2790 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2791 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2793 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2794 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2796 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2797 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2799 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2800 & ivec_count(fg_rank1),
2801 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2803 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2804 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2806 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2807 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2809 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2810 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2812 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2816 & ivec_count(fg_rank1),
2817 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2819 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2820 & ivec_count(fg_rank1),
2821 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2823 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2824 & ivec_count(fg_rank1),
2825 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2826 & MPI_MAT2,FG_COMM1,IERR)
2827 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2828 & ivec_count(fg_rank1),
2829 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2830 & MPI_MAT2,FG_COMM1,IERR)
2833 c Passes matrix info through the ring
2836 if (irecv.lt.0) irecv=nfgtasks1-1
2839 if (inext.ge.nfgtasks1) inext=0
2841 c write (iout,*) "isend",isend," irecv",irecv
2843 lensend=lentyp(isend)
2844 lenrecv=lentyp(irecv)
2845 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2846 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2847 c & MPI_ROTAT1(lensend),inext,2200+isend,
2848 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2849 c & iprev,2200+irecv,FG_COMM,status,IERR)
2850 c write (iout,*) "Gather ROTAT1"
2852 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2853 c & MPI_ROTAT2(lensend),inext,3300+isend,
2854 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2855 c & iprev,3300+irecv,FG_COMM,status,IERR)
2856 c write (iout,*) "Gather ROTAT2"
2858 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2859 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2860 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2861 & iprev,4400+irecv,FG_COMM,status,IERR)
2862 c write (iout,*) "Gather ROTAT_OLD"
2864 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2865 & MPI_PRECOMP11(lensend),inext,5500+isend,
2866 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2867 & iprev,5500+irecv,FG_COMM,status,IERR)
2868 c write (iout,*) "Gather PRECOMP11"
2870 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2871 & MPI_PRECOMP12(lensend),inext,6600+isend,
2872 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2873 & iprev,6600+irecv,FG_COMM,status,IERR)
2874 c write (iout,*) "Gather PRECOMP12"
2876 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2878 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2879 & MPI_ROTAT2(lensend),inext,7700+isend,
2880 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2881 & iprev,7700+irecv,FG_COMM,status,IERR)
2882 c write (iout,*) "Gather PRECOMP21"
2884 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2885 & MPI_PRECOMP22(lensend),inext,8800+isend,
2886 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2887 & iprev,8800+irecv,FG_COMM,status,IERR)
2888 c write (iout,*) "Gather PRECOMP22"
2890 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2891 & MPI_PRECOMP23(lensend),inext,9900+isend,
2892 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2893 & MPI_PRECOMP23(lenrecv),
2894 & iprev,9900+irecv,FG_COMM,status,IERR)
2895 c write (iout,*) "Gather PRECOMP23"
2900 if (irecv.lt.0) irecv=nfgtasks1-1
2903 time_gather=time_gather+MPI_Wtime()-time00
2906 c if (fg_rank.eq.0) then
2907 write (iout,*) "Arrays UG and UGDER"
2909 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2910 & ((ug(l,k,i),l=1,2),k=1,2),
2911 & ((ugder(l,k,i),l=1,2),k=1,2)
2913 write (iout,*) "Arrays UG2 and UG2DER"
2915 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2916 & ((ug2(l,k,i),l=1,2),k=1,2),
2917 & ((ug2der(l,k,i),l=1,2),k=1,2)
2919 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2921 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2922 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2923 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2925 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2927 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2928 & costab(i),sintab(i),costab2(i),sintab2(i)
2930 write (iout,*) "Array MUDER"
2932 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2938 cd iti = itortyp(itype(i))
2941 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2942 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2947 C--------------------------------------------------------------------------
2948 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2950 C This subroutine calculates the average interaction energy and its gradient
2951 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2952 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2953 C The potential depends both on the distance of peptide-group centers and on
2954 C the orientation of the CA-CA virtual bonds.
2956 implicit real*8 (a-h,o-z)
2960 include 'DIMENSIONS'
2961 include 'COMMON.CONTROL'
2962 include 'COMMON.SETUP'
2963 include 'COMMON.IOUNITS'
2964 include 'COMMON.GEO'
2965 include 'COMMON.VAR'
2966 include 'COMMON.LOCAL'
2967 include 'COMMON.CHAIN'
2968 include 'COMMON.DERIV'
2969 include 'COMMON.INTERACT'
2970 include 'COMMON.CONTACTS'
2971 include 'COMMON.TORSION'
2972 include 'COMMON.VECTORS'
2973 include 'COMMON.FFIELD'
2974 include 'COMMON.TIME1'
2975 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2976 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2977 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2978 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2979 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2980 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2982 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2984 double precision scal_el /1.0d0/
2986 double precision scal_el /0.5d0/
2989 C 13-go grudnia roku pamietnego...
2990 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2991 & 0.0d0,1.0d0,0.0d0,
2992 & 0.0d0,0.0d0,1.0d0/
2993 cd write(iout,*) 'In EELEC'
2995 cd write(iout,*) 'Type',i
2996 cd write(iout,*) 'B1',B1(:,i)
2997 cd write(iout,*) 'B2',B2(:,i)
2998 cd write(iout,*) 'CC',CC(:,:,i)
2999 cd write(iout,*) 'DD',DD(:,:,i)
3000 cd write(iout,*) 'EE',EE(:,:,i)
3002 cd call check_vecgrad
3004 if (icheckgrad.eq.1) then
3006 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp+1) cycle
3007 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3009 dc_norm(k,i)=dc(k,i)*fac
3011 c write (iout,*) 'i',i,' fac',fac
3014 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3015 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3016 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3017 c call vec_and_deriv
3023 time_mat=time_mat+MPI_Wtime()-time01
3027 cd write (iout,*) 'i=',i
3029 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3032 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3033 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3046 cd print '(a)','Enter EELEC'
3047 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3049 gel_loc_loc(i)=0.0d0
3054 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3056 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3058 do i=iturn3_start,iturn3_end
3059 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 .or.
3060 & itype(i+2).eq.ntyp1 .or. itype(i+3).eq. ntyp1) cycle
3064 dx_normi=dc_norm(1,i)
3065 dy_normi=dc_norm(2,i)
3066 dz_normi=dc_norm(3,i)
3067 xmedi=c(1,i)+0.5d0*dxi
3068 ymedi=c(2,i)+0.5d0*dyi
3069 zmedi=c(3,i)+0.5d0*dzi
3071 call eelecij(i,i+2,ees,evdw1,eel_loc)
3072 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3073 num_cont_hb(i)=num_conti
3075 do i=iturn4_start,iturn4_end
3076 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 .or.
3077 & itype(i+2).eq.ntyp1 .or. itype(i+3).eq. ntyp1 .or.
3078 & itype(i+4).eq.ntyp1) cycle
3082 dx_normi=dc_norm(1,i)
3083 dy_normi=dc_norm(2,i)
3084 dz_normi=dc_norm(3,i)
3085 xmedi=c(1,i)+0.5d0*dxi
3086 ymedi=c(2,i)+0.5d0*dyi
3087 zmedi=c(3,i)+0.5d0*dzi
3088 num_conti=num_cont_hb(i)
3089 call eelecij(i,i+3,ees,evdw1,eel_loc)
3090 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3091 num_cont_hb(i)=num_conti
3094 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3096 do i=iatel_s,iatel_e
3097 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3101 dx_normi=dc_norm(1,i)
3102 dy_normi=dc_norm(2,i)
3103 dz_normi=dc_norm(3,i)
3104 xmedi=c(1,i)+0.5d0*dxi
3105 ymedi=c(2,i)+0.5d0*dyi
3106 zmedi=c(3,i)+0.5d0*dzi
3107 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3108 num_conti=num_cont_hb(i)
3109 do j=ielstart(i),ielend(i)
3110 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
3111 call eelecij(i,j,ees,evdw1,eel_loc)
3113 num_cont_hb(i)=num_conti
3115 c write (iout,*) "Number of loop steps in EELEC:",ind
3117 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3118 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3120 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3121 ccc eel_loc=eel_loc+eello_turn3
3122 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3125 C-------------------------------------------------------------------------------
3126 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3127 implicit real*8 (a-h,o-z)
3128 include 'DIMENSIONS'
3132 include 'COMMON.CONTROL'
3133 include 'COMMON.IOUNITS'
3134 include 'COMMON.GEO'
3135 include 'COMMON.VAR'
3136 include 'COMMON.LOCAL'
3137 include 'COMMON.CHAIN'
3138 include 'COMMON.DERIV'
3139 include 'COMMON.INTERACT'
3140 include 'COMMON.CONTACTS'
3141 include 'COMMON.TORSION'
3142 include 'COMMON.VECTORS'
3143 include 'COMMON.FFIELD'
3144 include 'COMMON.TIME1'
3145 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3146 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3147 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3148 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3149 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3150 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3152 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3154 double precision scal_el /1.0d0/
3156 double precision scal_el /0.5d0/
3159 C 13-go grudnia roku pamietnego...
3160 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3161 & 0.0d0,1.0d0,0.0d0,
3162 & 0.0d0,0.0d0,1.0d0/
3163 c time00=MPI_Wtime()
3164 cd write (iout,*) "eelecij",i,j
3168 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3169 aaa=app(iteli,itelj)
3170 bbb=bpp(iteli,itelj)
3171 ael6i=ael6(iteli,itelj)
3172 ael3i=ael3(iteli,itelj)
3176 dx_normj=dc_norm(1,j)
3177 dy_normj=dc_norm(2,j)
3178 dz_normj=dc_norm(3,j)
3179 xj=c(1,j)+0.5D0*dxj-xmedi
3180 yj=c(2,j)+0.5D0*dyj-ymedi
3181 zj=c(3,j)+0.5D0*dzj-zmedi
3182 rij=xj*xj+yj*yj+zj*zj
3188 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3189 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3190 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3191 fac=cosa-3.0D0*cosb*cosg
3193 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3194 if (j.eq.i+2) ev1=scal_el*ev1
3199 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3202 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3203 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3206 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3207 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3208 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3209 cd & xmedi,ymedi,zmedi,xj,yj,zj
3211 if (energy_dec) then
3212 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3213 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3217 C Calculate contributions to the Cartesian gradient.
3220 facvdw=-6*rrmij*(ev1+evdwij)
3221 facel=-3*rrmij*(el1+eesij)
3227 * Radial derivatives. First process both termini of the fragment (i,j)
3233 c ghalf=0.5D0*ggg(k)
3234 c gelc(k,i)=gelc(k,i)+ghalf
3235 c gelc(k,j)=gelc(k,j)+ghalf
3237 c 9/28/08 AL Gradient compotents will be summed only at the end
3239 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3240 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3243 * Loop over residues i+1 thru j-1.
3247 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3254 c ghalf=0.5D0*ggg(k)
3255 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3256 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3258 c 9/28/08 AL Gradient compotents will be summed only at the end
3260 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3261 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3264 * Loop over residues i+1 thru j-1.
3268 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3275 fac=-3*rrmij*(facvdw+facvdw+facel)
3280 * Radial derivatives. First process both termini of the fragment (i,j)
3286 c ghalf=0.5D0*ggg(k)
3287 c gelc(k,i)=gelc(k,i)+ghalf
3288 c gelc(k,j)=gelc(k,j)+ghalf
3290 c 9/28/08 AL Gradient compotents will be summed only at the end
3292 gelc_long(k,j)=gelc(k,j)+ggg(k)
3293 gelc_long(k,i)=gelc(k,i)-ggg(k)
3296 * Loop over residues i+1 thru j-1.
3300 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3303 c 9/28/08 AL Gradient compotents will be summed only at the end
3308 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3309 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3315 ecosa=2.0D0*fac3*fac1+fac4
3318 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3319 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3321 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3322 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3324 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3325 cd & (dcosg(k),k=1,3)
3327 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3330 c ghalf=0.5D0*ggg(k)
3331 c gelc(k,i)=gelc(k,i)+ghalf
3332 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3333 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3334 c gelc(k,j)=gelc(k,j)+ghalf
3335 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3336 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3340 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3345 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3346 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3348 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3349 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3350 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3351 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3353 IF ((wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0.or.wcorr5.gt.0.0d0
3354 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3355 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0)
3356 & .and. itype(i+2).ne.ntyp1 .and.
3357 & (j.lt.nres-1.and.itype(j+2).ne.ntyp1 .or. j.eq.nres-1
3358 & .and.itype(j-2).ne.ntyp1)
3361 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3362 C energy of a peptide unit is assumed in the form of a second-order
3363 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3364 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3365 C are computed for EVERY pair of non-contiguous peptide groups.
3367 if (j.lt.nres-1) then
3378 muij(kkk)=mu(k,i)*mu(l,j)
3381 cd write (iout,*) 'EELEC: i',i,' j',j
3382 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3383 cd write(iout,*) 'muij',muij
3384 ury=scalar(uy(1,i),erij)
3385 urz=scalar(uz(1,i),erij)
3386 vry=scalar(uy(1,j),erij)
3387 vrz=scalar(uz(1,j),erij)
3388 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3389 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3390 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3391 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3392 fac=dsqrt(-ael6i)*r3ij
3397 cd write (iout,'(4i5,4f10.5)')
3398 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3399 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3400 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3401 cd & uy(:,j),uz(:,j)
3402 cd write (iout,'(4f10.5)')
3403 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3404 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3405 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3406 cd write (iout,'(9f10.5/)')
3407 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3408 C Derivatives of the elements of A in virtual-bond vectors
3409 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3411 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3412 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3413 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3414 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3415 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3416 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3417 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3418 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3419 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3420 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3421 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3422 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3424 C Compute radial contributions to the gradient
3442 C Add the contributions coming from er
3445 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3446 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3447 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3448 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3451 C Derivatives in DC(i)
3452 cgrad ghalf1=0.5d0*agg(k,1)
3453 cgrad ghalf2=0.5d0*agg(k,2)
3454 cgrad ghalf3=0.5d0*agg(k,3)
3455 cgrad ghalf4=0.5d0*agg(k,4)
3456 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3457 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3458 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3459 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3460 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3461 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3462 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3463 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3464 C Derivatives in DC(i+1)
3465 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3466 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3467 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3468 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3469 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3470 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3471 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3472 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3473 C Derivatives in DC(j)
3474 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3475 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3476 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3477 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3478 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3479 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3480 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3481 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3482 C Derivatives in DC(j+1) or DC(nres-1)
3483 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3484 & -3.0d0*vryg(k,3)*ury)
3485 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3486 & -3.0d0*vrzg(k,3)*ury)
3487 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3488 & -3.0d0*vryg(k,3)*urz)
3489 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3490 & -3.0d0*vrzg(k,3)*urz)
3491 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3493 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3506 aggi(k,l)=-aggi(k,l)
3507 aggi1(k,l)=-aggi1(k,l)
3508 aggj(k,l)=-aggj(k,l)
3509 aggj1(k,l)=-aggj1(k,l)
3512 if (j.lt.nres-1) then
3518 aggi(k,l)=-aggi(k,l)
3519 aggi1(k,l)=-aggi1(k,l)
3520 aggj(k,l)=-aggj(k,l)
3521 aggj1(k,l)=-aggj1(k,l)
3532 aggi(k,l)=-aggi(k,l)
3533 aggi1(k,l)=-aggi1(k,l)
3534 aggj(k,l)=-aggj(k,l)
3535 aggj1(k,l)=-aggj1(k,l)
3540 IF (wel_loc.gt.0.0d0) THEN
3541 C Contribution to the local-electrostatic energy coming from the i-j pair
3542 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3544 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3546 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3547 & 'eelloc',i,j,eel_loc_ij
3549 eel_loc=eel_loc+eel_loc_ij
3550 C Partial derivatives in virtual-bond dihedral angles gamma
3552 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3553 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3554 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3555 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3556 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3557 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3558 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3560 ggg(l)=agg(l,1)*muij(1)+
3561 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3562 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3563 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3564 cgrad ghalf=0.5d0*ggg(l)
3565 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3566 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3570 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3573 C Remaining derivatives of eello
3575 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3576 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3577 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3578 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3579 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3580 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3581 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3582 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3585 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3586 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3587 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3588 & .and. num_conti.le.maxconts) then
3589 c write (iout,*) i,j," entered corr"
3591 C Calculate the contact function. The ith column of the array JCONT will
3592 C contain the numbers of atoms that make contacts with the atom I (of numbers
3593 C greater than I). The arrays FACONT and GACONT will contain the values of
3594 C the contact function and its derivative.
3595 c r0ij=1.02D0*rpp(iteli,itelj)
3596 c r0ij=1.11D0*rpp(iteli,itelj)
3597 r0ij=2.20D0*rpp(iteli,itelj)
3598 c r0ij=1.55D0*rpp(iteli,itelj)
3599 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3600 if (fcont.gt.0.0D0) then
3601 num_conti=num_conti+1
3602 if (num_conti.gt.maxconts) then
3603 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3604 & ' will skip next contacts for this conf.'
3606 jcont_hb(num_conti,i)=j
3607 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3608 cd & " jcont_hb",jcont_hb(num_conti,i)
3609 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3610 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3611 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3613 d_cont(num_conti,i)=rij
3614 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3615 C --- Electrostatic-interaction matrix ---
3616 a_chuj(1,1,num_conti,i)=a22
3617 a_chuj(1,2,num_conti,i)=a23
3618 a_chuj(2,1,num_conti,i)=a32
3619 a_chuj(2,2,num_conti,i)=a33
3620 C --- Gradient of rij
3622 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3629 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3630 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3631 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3632 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3633 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3638 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3639 C Calculate contact energies
3641 wij=cosa-3.0D0*cosb*cosg
3644 c fac3=dsqrt(-ael6i)/r0ij**3
3645 fac3=dsqrt(-ael6i)*r3ij
3646 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3647 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3648 if (ees0tmp.gt.0) then
3649 ees0pij=dsqrt(ees0tmp)
3653 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3654 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3655 if (ees0tmp.gt.0) then
3656 ees0mij=dsqrt(ees0tmp)
3661 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3662 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3663 C Diagnostics. Comment out or remove after debugging!
3664 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3665 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3666 c ees0m(num_conti,i)=0.0D0
3668 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3669 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3670 C Angular derivatives of the contact function
3671 ees0pij1=fac3/ees0pij
3672 ees0mij1=fac3/ees0mij
3673 fac3p=-3.0D0*fac3*rrmij
3674 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3675 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3677 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3678 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3679 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3680 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3681 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3682 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3683 ecosap=ecosa1+ecosa2
3684 ecosbp=ecosb1+ecosb2
3685 ecosgp=ecosg1+ecosg2
3686 ecosam=ecosa1-ecosa2
3687 ecosbm=ecosb1-ecosb2
3688 ecosgm=ecosg1-ecosg2
3697 facont_hb(num_conti,i)=fcont
3698 fprimcont=fprimcont/rij
3699 cd facont_hb(num_conti,i)=1.0D0
3700 C Following line is for diagnostics.
3703 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3704 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3707 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3708 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3710 gggp(1)=gggp(1)+ees0pijp*xj
3711 gggp(2)=gggp(2)+ees0pijp*yj
3712 gggp(3)=gggp(3)+ees0pijp*zj
3713 gggm(1)=gggm(1)+ees0mijp*xj
3714 gggm(2)=gggm(2)+ees0mijp*yj
3715 gggm(3)=gggm(3)+ees0mijp*zj
3716 C Derivatives due to the contact function
3717 gacont_hbr(1,num_conti,i)=fprimcont*xj
3718 gacont_hbr(2,num_conti,i)=fprimcont*yj
3719 gacont_hbr(3,num_conti,i)=fprimcont*zj
3722 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3723 c following the change of gradient-summation algorithm.
3725 cgrad ghalfp=0.5D0*gggp(k)
3726 cgrad ghalfm=0.5D0*gggm(k)
3727 gacontp_hb1(k,num_conti,i)=!ghalfp
3728 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3729 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3730 gacontp_hb2(k,num_conti,i)=!ghalfp
3731 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3732 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3733 gacontp_hb3(k,num_conti,i)=gggp(k)
3734 gacontm_hb1(k,num_conti,i)=!ghalfm
3735 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3736 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3737 gacontm_hb2(k,num_conti,i)=!ghalfm
3738 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3739 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3740 gacontm_hb3(k,num_conti,i)=gggm(k)
3742 C Diagnostics. Comment out or remove after debugging!
3744 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3745 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3746 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3747 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3748 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3749 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3752 endif ! num_conti.le.maxconts
3755 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3758 ghalf=0.5d0*agg(l,k)
3759 aggi(l,k)=aggi(l,k)+ghalf
3760 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3761 aggj(l,k)=aggj(l,k)+ghalf
3764 if (j.eq.nres-1 .and. i.lt.j-2) then
3767 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3772 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3775 C-----------------------------------------------------------------------------
3776 subroutine eturn3(i,eello_turn3)
3777 C Third- and fourth-order contributions from turns
3778 implicit real*8 (a-h,o-z)
3779 include 'DIMENSIONS'
3780 include 'COMMON.IOUNITS'
3781 include 'COMMON.GEO'
3782 include 'COMMON.VAR'
3783 include 'COMMON.LOCAL'
3784 include 'COMMON.CHAIN'
3785 include 'COMMON.DERIV'
3786 include 'COMMON.INTERACT'
3787 include 'COMMON.CONTACTS'
3788 include 'COMMON.TORSION'
3789 include 'COMMON.VECTORS'
3790 include 'COMMON.FFIELD'
3791 include 'COMMON.CONTROL'
3793 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3794 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3795 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3796 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3797 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3798 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3799 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3802 c write (iout,*) "eturn3",i,j,j1,j2
3807 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3809 C Third-order contributions
3816 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3817 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3818 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3819 call transpose2(auxmat(1,1),auxmat1(1,1))
3820 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3821 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3822 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3823 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3824 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3825 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3826 cd & ' eello_turn3_num',4*eello_turn3_num
3827 C Derivatives in gamma(i)
3828 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3829 call transpose2(auxmat2(1,1),auxmat3(1,1))
3830 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3831 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3832 C Derivatives in gamma(i+1)
3833 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3834 call transpose2(auxmat2(1,1),auxmat3(1,1))
3835 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3836 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3837 & +0.5d0*(pizda(1,1)+pizda(2,2))
3838 C Cartesian derivatives
3840 c ghalf1=0.5d0*agg(l,1)
3841 c ghalf2=0.5d0*agg(l,2)
3842 c ghalf3=0.5d0*agg(l,3)
3843 c ghalf4=0.5d0*agg(l,4)
3844 a_temp(1,1)=aggi(l,1)!+ghalf1
3845 a_temp(1,2)=aggi(l,2)!+ghalf2
3846 a_temp(2,1)=aggi(l,3)!+ghalf3
3847 a_temp(2,2)=aggi(l,4)!+ghalf4
3848 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3849 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3850 & +0.5d0*(pizda(1,1)+pizda(2,2))
3851 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3852 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3853 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3854 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3855 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3856 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3857 & +0.5d0*(pizda(1,1)+pizda(2,2))
3858 a_temp(1,1)=aggj(l,1)!+ghalf1
3859 a_temp(1,2)=aggj(l,2)!+ghalf2
3860 a_temp(2,1)=aggj(l,3)!+ghalf3
3861 a_temp(2,2)=aggj(l,4)!+ghalf4
3862 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3863 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3864 & +0.5d0*(pizda(1,1)+pizda(2,2))
3865 a_temp(1,1)=aggj1(l,1)
3866 a_temp(1,2)=aggj1(l,2)
3867 a_temp(2,1)=aggj1(l,3)
3868 a_temp(2,2)=aggj1(l,4)
3869 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3870 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3871 & +0.5d0*(pizda(1,1)+pizda(2,2))
3875 C-------------------------------------------------------------------------------
3876 subroutine eturn4(i,eello_turn4)
3877 C Third- and fourth-order contributions from turns
3878 implicit real*8 (a-h,o-z)
3879 include 'DIMENSIONS'
3880 include 'COMMON.IOUNITS'
3881 include 'COMMON.GEO'
3882 include 'COMMON.VAR'
3883 include 'COMMON.LOCAL'
3884 include 'COMMON.CHAIN'
3885 include 'COMMON.DERIV'
3886 include 'COMMON.INTERACT'
3887 include 'COMMON.CONTACTS'
3888 include 'COMMON.TORSION'
3889 include 'COMMON.VECTORS'
3890 include 'COMMON.FFIELD'
3891 include 'COMMON.CONTROL'
3893 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3894 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3895 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3896 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3897 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3898 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3899 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3902 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3904 C Fourth-order contributions
3912 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3913 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3914 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3919 iti1=itortyp(itype(i+1))
3920 iti2=itortyp(itype(i+2))
3921 iti3=itortyp(itype(i+3))
3922 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3923 call transpose2(EUg(1,1,i+1),e1t(1,1))
3924 call transpose2(Eug(1,1,i+2),e2t(1,1))
3925 call transpose2(Eug(1,1,i+3),e3t(1,1))
3926 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3927 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3928 s1=scalar2(b1(1,iti2),auxvec(1))
3929 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3930 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3931 s2=scalar2(b1(1,iti1),auxvec(1))
3932 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3933 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3934 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3935 eello_turn4=eello_turn4-(s1+s2+s3)
3936 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3937 & 'eturn4',i,j,-(s1+s2+s3)
3938 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3939 cd & ' eello_turn4_num',8*eello_turn4_num
3940 C Derivatives in gamma(i)
3941 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3942 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3943 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3944 s1=scalar2(b1(1,iti2),auxvec(1))
3945 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3946 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3947 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3948 C Derivatives in gamma(i+1)
3949 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3950 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3951 s2=scalar2(b1(1,iti1),auxvec(1))
3952 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3953 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3954 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3955 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3956 C Derivatives in gamma(i+2)
3957 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3958 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3959 s1=scalar2(b1(1,iti2),auxvec(1))
3960 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3961 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3962 s2=scalar2(b1(1,iti1),auxvec(1))
3963 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3964 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3965 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3966 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3967 C Cartesian derivatives
3968 C Derivatives of this turn contributions in DC(i+2)
3969 if (j.lt.nres-1) then
3971 a_temp(1,1)=agg(l,1)
3972 a_temp(1,2)=agg(l,2)
3973 a_temp(2,1)=agg(l,3)
3974 a_temp(2,2)=agg(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))
3985 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3988 C Remaining derivatives of this turn contribution
3990 a_temp(1,1)=aggi(l,1)
3991 a_temp(1,2)=aggi(l,2)
3992 a_temp(2,1)=aggi(l,3)
3993 a_temp(2,2)=aggi(l,4)
3994 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3995 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3996 s1=scalar2(b1(1,iti2),auxvec(1))
3997 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3998 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3999 s2=scalar2(b1(1,iti1),auxvec(1))
4000 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4001 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4002 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4003 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4004 a_temp(1,1)=aggi1(l,1)
4005 a_temp(1,2)=aggi1(l,2)
4006 a_temp(2,1)=aggi1(l,3)
4007 a_temp(2,2)=aggi1(l,4)
4008 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4009 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4010 s1=scalar2(b1(1,iti2),auxvec(1))
4011 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4012 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4013 s2=scalar2(b1(1,iti1),auxvec(1))
4014 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4015 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4016 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4017 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4018 a_temp(1,1)=aggj(l,1)
4019 a_temp(1,2)=aggj(l,2)
4020 a_temp(2,1)=aggj(l,3)
4021 a_temp(2,2)=aggj(l,4)
4022 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4023 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4024 s1=scalar2(b1(1,iti2),auxvec(1))
4025 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4026 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4027 s2=scalar2(b1(1,iti1),auxvec(1))
4028 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4029 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4030 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4031 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4032 a_temp(1,1)=aggj1(l,1)
4033 a_temp(1,2)=aggj1(l,2)
4034 a_temp(2,1)=aggj1(l,3)
4035 a_temp(2,2)=aggj1(l,4)
4036 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4037 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4038 s1=scalar2(b1(1,iti2),auxvec(1))
4039 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4040 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4041 s2=scalar2(b1(1,iti1),auxvec(1))
4042 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4043 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4044 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4045 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4046 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4050 C-----------------------------------------------------------------------------
4051 subroutine vecpr(u,v,w)
4052 implicit real*8(a-h,o-z)
4053 dimension u(3),v(3),w(3)
4054 w(1)=u(2)*v(3)-u(3)*v(2)
4055 w(2)=-u(1)*v(3)+u(3)*v(1)
4056 w(3)=u(1)*v(2)-u(2)*v(1)
4059 C-----------------------------------------------------------------------------
4060 subroutine unormderiv(u,ugrad,unorm,ungrad)
4061 C This subroutine computes the derivatives of a normalized vector u, given
4062 C the derivatives computed without normalization conditions, ugrad. Returns
4065 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4066 double precision vec(3)
4067 double precision scalar
4069 c write (2,*) 'ugrad',ugrad
4072 vec(i)=scalar(ugrad(1,i),u(1))
4074 c write (2,*) 'vec',vec
4077 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4080 c write (2,*) 'ungrad',ungrad
4083 C-----------------------------------------------------------------------------
4084 subroutine escp_soft_sphere(evdw2,evdw2_14)
4086 C This subroutine calculates the excluded-volume interaction energy between
4087 C peptide-group centers and side chains and its gradient in virtual-bond and
4088 C side-chain vectors.
4090 implicit real*8 (a-h,o-z)
4091 include 'DIMENSIONS'
4092 include 'COMMON.GEO'
4093 include 'COMMON.VAR'
4094 include 'COMMON.LOCAL'
4095 include 'COMMON.CHAIN'
4096 include 'COMMON.DERIV'
4097 include 'COMMON.INTERACT'
4098 include 'COMMON.FFIELD'
4099 include 'COMMON.IOUNITS'
4100 include 'COMMON.CONTROL'
4105 cd print '(a)','Enter ESCP'
4106 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4107 do i=iatscp_s,iatscp_e
4109 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4111 xi=0.5D0*(c(1,i)+c(1,i+1))
4112 yi=0.5D0*(c(2,i)+c(2,i+1))
4113 zi=0.5D0*(c(3,i)+c(3,i+1))
4115 do iint=1,nscp_gr(i)
4117 do j=iscpstart(i,iint),iscpend(i,iint)
4119 C Uncomment following three lines for SC-p interactions
4123 C Uncomment following three lines for Ca-p interactions
4124 if (itype(j).eq.ntyp1) cycle
4128 rij=xj*xj+yj*yj+zj*zj
4131 if (rij.lt.r0ijsq) then
4132 evdwij=0.25d0*(rij-r0ijsq)**2
4140 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4145 cgrad if (j.lt.i) then
4146 cd write (iout,*) 'j<i'
4147 C Uncomment following three lines for SC-p interactions
4149 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4152 cd write (iout,*) 'j>i'
4154 cgrad ggg(k)=-ggg(k)
4155 C Uncomment following line for SC-p interactions
4156 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4160 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4162 cgrad kstart=min0(i+1,j)
4163 cgrad kend=max0(i-1,j-1)
4164 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4165 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4166 cgrad do k=kstart,kend
4168 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4172 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4173 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4181 C-----------------------------------------------------------------------------
4182 subroutine escp(evdw2,evdw2_14)
4184 C This subroutine calculates the excluded-volume interaction energy between
4185 C peptide-group centers and side chains and its gradient in virtual-bond and
4186 C side-chain vectors.
4188 implicit real*8 (a-h,o-z)
4189 include 'DIMENSIONS'
4190 include 'COMMON.GEO'
4191 include 'COMMON.VAR'
4192 include 'COMMON.LOCAL'
4193 include 'COMMON.CHAIN'
4194 include 'COMMON.DERIV'
4195 include 'COMMON.INTERACT'
4196 include 'COMMON.FFIELD'
4197 include 'COMMON.IOUNITS'
4198 include 'COMMON.CONTROL'
4199 include "COMMON.ECOMPON"
4203 cd print '(a)','Enter ESCP'
4204 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4205 do i=iatscp_s,iatscp_e
4206 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4208 xi=0.5D0*(c(1,i)+c(1,i+1))
4209 yi=0.5D0*(c(2,i)+c(2,i+1))
4210 zi=0.5D0*(c(3,i)+c(3,i+1))
4212 do iint=1,nscp_gr(i)
4214 do j=iscpstart(i,iint),iscpend(i,iint)
4215 if (itype(j).eq.ntyp1) cycle
4217 C Uncomment following three lines for SC-p interactions
4221 C Uncomment following three lines for Ca-p interactions
4225 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4227 e1=fac*fac*aad(itypj,iteli)
4228 e2=fac*bad(itypj,iteli)
4229 if (iabs(j-i) .le. 2) then
4232 evdw2_14=evdw2_14+e1+e2
4235 vdw2compon(itypj)=vdw2compon(itypj)+evdwij
4237 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4238 & 'evdw2',i,j,evdwij
4240 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4242 fac=-(evdwij+e1)*rrij
4246 cgrad if (j.lt.i) then
4247 cd write (iout,*) 'j<i'
4248 C Uncomment following three lines for SC-p interactions
4250 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4253 cd write (iout,*) 'j>i'
4255 cgrad ggg(k)=-ggg(k)
4256 C Uncomment following line for SC-p interactions
4257 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4258 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4262 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4264 cgrad kstart=min0(i+1,j)
4265 cgrad kend=max0(i-1,j-1)
4266 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4267 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4268 cgrad do k=kstart,kend
4270 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4274 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4275 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4283 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4284 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4285 gradx_scp(j,i)=expon*gradx_scp(j,i)
4288 C******************************************************************************
4292 C To save time the factor EXPON has been extracted from ALL components
4293 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4296 C******************************************************************************
4299 C--------------------------------------------------------------------------
4300 subroutine edis(ehpb)
4302 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4304 implicit real*8 (a-h,o-z)
4305 include 'DIMENSIONS'
4306 include 'COMMON.SBRIDGE'
4307 include 'COMMON.CHAIN'
4308 include 'COMMON.DERIV'
4309 include 'COMMON.VAR'
4310 include 'COMMON.INTERACT'
4311 include 'COMMON.IOUNITS'
4314 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4315 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4316 if (link_end.eq.0) return
4317 do i=link_start,link_end
4318 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4319 C CA-CA distance used in regularization of structure.
4322 if (itype(ii).eq.ntyp1 .or. itype(jj).eq.ntyp1) cycle
4323 C iii and jjj point to the residues for which the distance is assigned.
4324 if (ii.gt.nres) then
4331 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4332 c & dhpb(i),dhpb1(i),forcon(i)
4333 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4334 C distance and angle dependent SS bond potential.
4335 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4336 call ssbond_ene(iii,jjj,eij)
4338 cd write (iout,*) "eij",eij
4339 else if (ii.gt.nres .and. jj.gt.nres) then
4340 c Restraints from contact prediction
4342 if (dhpb1(i).gt.0.0d0) then
4343 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4344 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4345 c write (iout,*) "beta nmr",
4346 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4350 C Get the force constant corresponding to this distance.
4352 C Calculate the contribution to energy.
4353 ehpb=ehpb+waga*rdis*rdis
4354 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4356 C Evaluate gradient.
4361 ggg(j)=fac*(c(j,jj)-c(j,ii))
4364 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4365 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4368 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4369 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4372 C Calculate the distance between the two points and its difference from the
4375 if (dhpb1(i).gt.0.0d0) then
4376 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4377 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4378 c write (iout,*) "alph nmr",
4379 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4382 C Get the force constant corresponding to this distance.
4384 C Calculate the contribution to energy.
4385 ehpb=ehpb+waga*rdis*rdis
4386 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4388 C Evaluate gradient.
4392 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4393 cd & ' waga=',waga,' fac=',fac
4395 ggg(j)=fac*(c(j,jj)-c(j,ii))
4397 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4398 C If this is a SC-SC distance, we need to calculate the contributions to the
4399 C Cartesian gradient in the SC vectors (ghpbx).
4402 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4403 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4406 cgrad do j=iii,jjj-1
4408 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4412 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4413 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4420 C--------------------------------------------------------------------------
4421 subroutine ssbond_ene(i,j,eij)
4423 C Calculate the distance and angle dependent SS-bond potential energy
4424 C using a free-energy function derived based on RHF/6-31G** ab initio
4425 C calculations of diethyl disulfide.
4427 C A. Liwo and U. Kozlowska, 11/24/03
4429 implicit real*8 (a-h,o-z)
4430 include 'DIMENSIONS'
4431 include 'COMMON.SBRIDGE'
4432 include 'COMMON.CHAIN'
4433 include 'COMMON.DERIV'
4434 include 'COMMON.LOCAL'
4435 include 'COMMON.INTERACT'
4436 include 'COMMON.VAR'
4437 include 'COMMON.IOUNITS'
4438 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4443 dxi=dc_norm(1,nres+i)
4444 dyi=dc_norm(2,nres+i)
4445 dzi=dc_norm(3,nres+i)
4446 c dsci_inv=dsc_inv(itypi)
4447 dsci_inv=vbld_inv(nres+i)
4449 c dscj_inv=dsc_inv(itypj)
4450 dscj_inv=vbld_inv(nres+j)
4454 dxj=dc_norm(1,nres+j)
4455 dyj=dc_norm(2,nres+j)
4456 dzj=dc_norm(3,nres+j)
4457 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4462 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4463 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4464 om12=dxi*dxj+dyi*dyj+dzi*dzj
4466 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4467 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4473 deltat12=om2-om1+2.0d0
4475 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4476 & +akct*deltad*deltat12+ebr
4477 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4478 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4479 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4480 c & " deltat12",deltat12," eij",eij
4481 ed=2*akcm*deltad+akct*deltat12
4483 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4484 eom1=-2*akth*deltat1-pom1-om2*pom2
4485 eom2= 2*akth*deltat2+pom1-om1*pom2
4488 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4489 ghpbx(k,i)=ghpbx(k,i)-ggk
4490 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4491 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4492 ghpbx(k,j)=ghpbx(k,j)+ggk
4493 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4494 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4495 ghpbc(k,i)=ghpbc(k,i)-ggk
4496 ghpbc(k,j)=ghpbc(k,j)+ggk
4499 C Calculate the components of the gradient in DC and X
4503 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4508 C--------------------------------------------------------------------------
4509 subroutine ebond(estr)
4511 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4513 implicit real*8 (a-h,o-z)
4514 include 'DIMENSIONS'
4515 include 'COMMON.LOCAL'
4516 include 'COMMON.GEO'
4517 include 'COMMON.INTERACT'
4518 include 'COMMON.DERIV'
4519 include 'COMMON.VAR'
4520 include 'COMMON.CHAIN'
4521 include 'COMMON.IOUNITS'
4522 include 'COMMON.NAMES'
4523 include 'COMMON.FFIELD'
4524 include 'COMMON.CONTROL'
4525 include 'COMMON.SETUP'
4526 double precision u(3),ud(3)
4528 do i=ibondp_start,ibondp_end
4529 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
4530 diff = vbld(i)-vbldp0
4531 if (energy_dec) write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4534 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4536 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4540 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4542 do i=ibond_start,ibond_end
4544 if (iti.ne.10 .and. iti.ne.ntyp1) then
4547 diff=vbld(i+nres)-vbldsc0(1,iti)
4548 if (energy_dec) write (iout,*) i,iti,vbld(i+nres),
4549 & vbldsc0(1,iti),diff,
4550 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4551 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4553 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4557 diff=vbld(i+nres)-vbldsc0(j,iti)
4558 ud(j)=aksc(j,iti)*diff
4559 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4573 uprod2=uprod2*u(k)*u(k)
4577 usumsqder=usumsqder+ud(j)*uprod2
4579 estr=estr+uprod/usum
4581 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4589 C--------------------------------------------------------------------------
4590 subroutine ebend(etheta)
4592 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4593 C angles gamma and its derivatives in consecutive thetas and gammas.
4595 implicit real*8 (a-h,o-z)
4596 include 'DIMENSIONS'
4597 include 'COMMON.LOCAL'
4598 include 'COMMON.GEO'
4599 include 'COMMON.INTERACT'
4600 include 'COMMON.DERIV'
4601 include 'COMMON.VAR'
4602 include 'COMMON.CHAIN'
4603 include 'COMMON.IOUNITS'
4604 include 'COMMON.NAMES'
4605 include 'COMMON.FFIELD'
4606 include 'COMMON.CONTROL'
4607 include "COMMON.ECOMPON"
4608 common /calcthet/ term1,term2,termm,diffak,ratak,
4609 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4610 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4611 double precision y(2),z(2)
4613 c time11=dexp(-2*time)
4616 c write (*,'(a,i2)') 'EBEND ICG=',icg
4617 do i=ithet_start,ithet_end
4618 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 .or.
4619 & itype(i).eq.ntyp1) cycle
4620 C Zero the energy function and its derivative at 0 or pi.
4621 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4626 if (phii.ne.phii) phii=150.0
4639 if (phii1.ne.phii1) phii1=150.0
4651 C Calculate the "mean" value of theta from the part of the distribution
4652 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4653 C In following comments this theta will be referred to as t_c.
4654 thet_pred_mean=0.0d0
4658 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4660 dthett=thet_pred_mean*ssd
4661 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4662 C Derivatives of the "mean" values in gamma1 and gamma2.
4663 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4664 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4665 if (theta(i).gt.pi-delta) then
4666 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4668 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4669 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4670 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4672 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4674 else if (theta(i).lt.delta) then
4675 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4676 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4677 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4679 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4680 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4683 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4686 becompon(it)=becompon(it)+ethetai
4687 etheta=etheta+ethetai
4688 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4690 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4691 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4692 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4694 C Ufff.... We've done all this!!!
4697 C---------------------------------------------------------------------------
4698 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4700 implicit real*8 (a-h,o-z)
4701 include 'DIMENSIONS'
4702 include 'COMMON.LOCAL'
4703 include 'COMMON.IOUNITS'
4704 common /calcthet/ term1,term2,termm,diffak,ratak,
4705 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4706 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4707 C Calculate the contributions to both Gaussian lobes.
4708 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4709 C The "polynomial part" of the "standard deviation" of this part of
4713 sig=sig*thet_pred_mean+polthet(j,it)
4715 C Derivative of the "interior part" of the "standard deviation of the"
4716 C gamma-dependent Gaussian lobe in t_c.
4717 sigtc=3*polthet(3,it)
4719 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4722 C Set the parameters of both Gaussian lobes of the distribution.
4723 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4724 fac=sig*sig+sigc0(it)
4727 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4728 sigsqtc=-4.0D0*sigcsq*sigtc
4729 c print *,i,sig,sigtc,sigsqtc
4730 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4731 sigtc=-sigtc/(fac*fac)
4732 C Following variable is sigma(t_c)**(-2)
4733 sigcsq=sigcsq*sigcsq
4735 sig0inv=1.0D0/sig0i**2
4736 delthec=thetai-thet_pred_mean
4737 delthe0=thetai-theta0i
4738 term1=-0.5D0*sigcsq*delthec*delthec
4739 term2=-0.5D0*sig0inv*delthe0*delthe0
4740 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4741 C NaNs in taking the logarithm. We extract the largest exponent which is added
4742 C to the energy (this being the log of the distribution) at the end of energy
4743 C term evaluation for this virtual-bond angle.
4744 if (term1.gt.term2) then
4746 term2=dexp(term2-termm)
4750 term1=dexp(term1-termm)
4753 C The ratio between the gamma-independent and gamma-dependent lobes of
4754 C the distribution is a Gaussian function of thet_pred_mean too.
4755 diffak=gthet(2,it)-thet_pred_mean
4756 ratak=diffak/gthet(3,it)**2
4757 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4758 C Let's differentiate it in thet_pred_mean NOW.
4760 C Now put together the distribution terms to make complete distribution.
4761 termexp=term1+ak*term2
4762 termpre=sigc+ak*sig0i
4763 C Contribution of the bending energy from this theta is just the -log of
4764 C the sum of the contributions from the two lobes and the pre-exponential
4765 C factor. Simple enough, isn't it?
4766 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4767 C NOW the derivatives!!!
4768 C 6/6/97 Take into account the deformation.
4769 E_theta=(delthec*sigcsq*term1
4770 & +ak*delthe0*sig0inv*term2)/termexp
4771 E_tc=((sigtc+aktc*sig0i)/termpre
4772 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4773 & aktc*term2)/termexp)
4776 c-----------------------------------------------------------------------------
4777 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4778 implicit real*8 (a-h,o-z)
4779 include 'DIMENSIONS'
4780 include 'COMMON.LOCAL'
4781 include 'COMMON.IOUNITS'
4782 common /calcthet/ term1,term2,termm,diffak,ratak,
4783 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4784 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4785 delthec=thetai-thet_pred_mean
4786 delthe0=thetai-theta0i
4787 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4788 t3 = thetai-thet_pred_mean
4792 t14 = t12+t6*sigsqtc
4794 t21 = thetai-theta0i
4800 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4801 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4802 & *(-t12*t9-ak*sig0inv*t27)
4806 C--------------------------------------------------------------------------
4807 subroutine ebend(etheta)
4809 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4810 C angles gamma and its derivatives in consecutive thetas and gammas.
4811 C ab initio-derived potentials from
4812 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4814 implicit real*8 (a-h,o-z)
4815 include 'DIMENSIONS'
4816 include 'COMMON.LOCAL'
4817 include 'COMMON.GEO'
4818 include 'COMMON.INTERACT'
4819 include 'COMMON.DERIV'
4820 include 'COMMON.VAR'
4821 include 'COMMON.CHAIN'
4822 include 'COMMON.IOUNITS'
4823 include 'COMMON.NAMES'
4824 include 'COMMON.FFIELD'
4825 include 'COMMON.CONTROL'
4826 include "COMMON.ECOMPON"
4827 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4828 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4829 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4830 & sinph1ph2(maxdouble,maxdouble)
4831 logical lprn /.false./, lprn1 /.false./
4833 do i=ithet_start,ithet_end
4834 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 .or.
4835 & itype(i).eq.ntyp1) cycle
4839 theti2=0.5d0*theta(i)
4840 ityp2=ithetyp(itype(i-1))
4842 coskt(k)=dcos(k*theti2)
4843 sinkt(k)=dsin(k*theti2)
4848 if (phii.ne.phii) phii=150.0
4852 ityp1=ithetyp(itype(i-2))
4854 cosph1(k)=dcos(k*phii)
4855 sinph1(k)=dsin(k*phii)
4868 if (phii1.ne.phii1) phii1=150.0
4873 ityp3=ithetyp(itype(i))
4875 cosph2(k)=dcos(k*phii1)
4876 sinph2(k)=dsin(k*phii1)
4886 ethetai=aa0thet(ityp1,ityp2,ityp3)
4889 ccl=cosph1(l)*cosph2(k-l)
4890 ssl=sinph1(l)*sinph2(k-l)
4891 scl=sinph1(l)*cosph2(k-l)
4892 csl=cosph1(l)*sinph2(k-l)
4893 cosph1ph2(l,k)=ccl-ssl
4894 cosph1ph2(k,l)=ccl+ssl
4895 sinph1ph2(l,k)=scl+csl
4896 sinph1ph2(k,l)=scl-csl
4900 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4901 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4902 write (iout,*) "coskt and sinkt"
4904 write (iout,*) k,coskt(k),sinkt(k)
4908 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4909 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4912 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4913 & " ethetai",ethetai
4916 write (iout,*) "cosph and sinph"
4918 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4920 write (iout,*) "cosph1ph2 and sinph2ph2"
4923 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4924 & sinph1ph2(l,k),sinph1ph2(k,l)
4927 write(iout,*) "ethetai",ethetai
4931 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4932 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4933 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4934 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4935 ethetai=ethetai+sinkt(m)*aux
4936 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4937 dephii=dephii+k*sinkt(m)*(
4938 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4939 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4940 dephii1=dephii1+k*sinkt(m)*(
4941 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4942 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4944 & write (iout,*) "m",m," k",k," bbthet",
4945 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4946 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4947 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4948 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4952 & write(iout,*) "ethetai",ethetai
4956 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4957 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4958 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4959 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4960 ethetai=ethetai+sinkt(m)*aux
4961 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4962 dephii=dephii+l*sinkt(m)*(
4963 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4964 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4965 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4966 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4967 dephii1=dephii1+(k-l)*sinkt(m)*(
4968 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4969 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4970 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4971 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4973 write (iout,*) "m",m," k",k," l",l," ffthet",
4974 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4975 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4976 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4977 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4978 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4979 & cosph1ph2(k,l)*sinkt(m),
4980 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4986 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4987 & i,theta(i)*rad2deg,phii*rad2deg,
4988 & phii1*rad2deg,ethetai
4989 becompon(itype(i-1))=becompon(itype(i-1))+ethetai
4990 etheta=etheta+ethetai
4991 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4992 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4993 gloc(nphi+i-2,icg)=wang*dethetai
4999 c-----------------------------------------------------------------------------
5000 subroutine esc(escloc)
5001 C Calculate the local energy of a side chain and its derivatives in the
5002 C corresponding virtual-bond valence angles THETA and the spherical angles
5004 implicit real*8 (a-h,o-z)
5005 include 'DIMENSIONS'
5006 include 'COMMON.GEO'
5007 include 'COMMON.LOCAL'
5008 include 'COMMON.VAR'
5009 include 'COMMON.INTERACT'
5010 include 'COMMON.DERIV'
5011 include 'COMMON.CHAIN'
5012 include 'COMMON.IOUNITS'
5013 include 'COMMON.NAMES'
5014 include 'COMMON.FFIELD'
5015 include 'COMMON.CONTROL'
5016 include "COMMON.ECOMPON"
5017 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5018 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5019 common /sccalc/ time11,time12,time112,theti,it,nlobit
5022 c write (iout,'(a)') 'ESC'
5023 do i=loc_start,loc_end
5025 if (it.eq.10 .or. it.eq.ntyp1 .or. itype(i-1).eq.ntyp1 .or.
5026 & itype(i+1).eq.ntyp1) goto 1
5028 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5029 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5030 theti=theta(i+1)-pipol
5035 if (x(2).gt.pi-delta) then
5039 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5041 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5042 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5044 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5045 & ddersc0(1),dersc(1))
5046 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5047 & ddersc0(3),dersc(3))
5049 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5051 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5052 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5053 & dersc0(2),esclocbi,dersc02)
5054 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5056 call splinthet(x(2),0.5d0*delta,ss,ssd)
5061 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5063 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5064 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5066 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5068 c write (iout,*) escloci
5069 else if (x(2).lt.delta) then
5073 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5075 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5076 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5078 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5079 & ddersc0(1),dersc(1))
5080 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5081 & ddersc0(3),dersc(3))
5083 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5085 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5086 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5087 & dersc0(2),esclocbi,dersc02)
5088 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5093 call splinthet(x(2),0.5d0*delta,ss,ssd)
5095 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5097 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5098 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5100 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5101 c write (iout,*) escloci
5103 call enesc(x,escloci,dersc,ddummy,.false.)
5106 sccompon(it)=sccompon(it)+escloci
5107 escloc=escloc+escloci
5108 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5109 & 'escloc',i,escloci
5110 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5112 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5114 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5115 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5120 C---------------------------------------------------------------------------
5121 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5122 implicit real*8 (a-h,o-z)
5123 include 'DIMENSIONS'
5124 include 'COMMON.GEO'
5125 include 'COMMON.LOCAL'
5126 include 'COMMON.IOUNITS'
5127 common /sccalc/ time11,time12,time112,theti,it,nlobit
5128 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5129 double precision contr(maxlob,-1:1)
5131 c write (iout,*) 'it=',it,' nlobit=',nlobit
5135 if (mixed) ddersc(j)=0.0d0
5139 C Because of periodicity of the dependence of the SC energy in omega we have
5140 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5141 C To avoid underflows, first compute & store the exponents.
5149 z(k)=x(k)-censc(k,j,it)
5154 Axk=Axk+gaussc(l,k,j,it)*z(l)
5160 expfac=expfac+Ax(k,j,iii)*z(k)
5168 C As in the case of ebend, we want to avoid underflows in exponentiation and
5169 C subsequent NaNs and INFs in energy calculation.
5170 C Find the largest exponent
5174 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5178 cd print *,'it=',it,' emin=',emin
5180 C Compute the contribution to SC energy and derivatives
5185 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5186 if(adexp.ne.adexp) adexp=1.0
5189 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5191 cd print *,'j=',j,' expfac=',expfac
5192 escloc_i=escloc_i+expfac
5194 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5198 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5199 & +gaussc(k,2,j,it))*expfac
5206 dersc(1)=dersc(1)/cos(theti)**2
5207 ddersc(1)=ddersc(1)/cos(theti)**2
5210 escloci=-(dlog(escloc_i)-emin)
5212 dersc(j)=dersc(j)/escloc_i
5216 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5221 C------------------------------------------------------------------------------
5222 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5223 implicit real*8 (a-h,o-z)
5224 include 'DIMENSIONS'
5225 include 'COMMON.GEO'
5226 include 'COMMON.LOCAL'
5227 include 'COMMON.IOUNITS'
5228 common /sccalc/ time11,time12,time112,theti,it,nlobit
5229 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5230 double precision contr(maxlob)
5241 z(k)=x(k)-censc(k,j,it)
5247 Axk=Axk+gaussc(l,k,j,it)*z(l)
5253 expfac=expfac+Ax(k,j)*z(k)
5258 C As in the case of ebend, we want to avoid underflows in exponentiation and
5259 C subsequent NaNs and INFs in energy calculation.
5260 C Find the largest exponent
5263 if (emin.gt.contr(j)) emin=contr(j)
5267 C Compute the contribution to SC energy and derivatives
5271 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5272 escloc_i=escloc_i+expfac
5274 dersc(k)=dersc(k)+Ax(k,j)*expfac
5276 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5277 & +gaussc(1,2,j,it))*expfac
5281 dersc(1)=dersc(1)/cos(theti)**2
5282 dersc12=dersc12/cos(theti)**2
5283 escloci=-(dlog(escloc_i)-emin)
5285 dersc(j)=dersc(j)/escloc_i
5287 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5291 c----------------------------------------------------------------------------------
5292 subroutine esc(escloc)
5293 C Calculate the local energy of a side chain and its derivatives in the
5294 C corresponding virtual-bond valence angles THETA and the spherical angles
5295 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5296 C added by Urszula Kozlowska. 07/11/2007
5298 implicit real*8 (a-h,o-z)
5299 include 'DIMENSIONS'
5300 include 'COMMON.GEO'
5301 include 'COMMON.LOCAL'
5302 include 'COMMON.VAR'
5303 include 'COMMON.SCROT'
5304 include 'COMMON.INTERACT'
5305 include 'COMMON.DERIV'
5306 include 'COMMON.CHAIN'
5307 include 'COMMON.IOUNITS'
5308 include 'COMMON.NAMES'
5309 include 'COMMON.FFIELD'
5310 include 'COMMON.CONTROL'
5311 include 'COMMON.VECTORS'
5312 include "COMMON.ECOMPON"
5313 double precision x_prime(3),y_prime(3),z_prime(3)
5314 & , sumene,dsc_i,dp2_i,x(65),
5315 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5316 & de_dxx,de_dyy,de_dzz,de_dt
5317 double precision s1_t,s1_6_t,s2_t,s2_6_t
5319 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5320 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5321 & dt_dCi(3),dt_dCi1(3)
5322 common /sccalc/ time11,time12,time112,theti,it,nlobit
5325 do i=loc_start,loc_end
5326 costtab(i+1) =dcos(theta(i+1))
5327 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5328 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5329 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5330 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5331 cosfac=dsqrt(cosfac2)
5332 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5333 sinfac=dsqrt(sinfac2)
5335 if (it.eq.10 .or. it.eq.ntyp1 .or. itype(i-1).eq.ntyp1 .or.
5336 & itype(i+1).eq.ntyp1) goto 1
5338 C Compute the axes of tghe local cartesian coordinates system; store in
5339 c x_prime, y_prime and z_prime
5346 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5347 C & dc_norm(3,i+nres)
5349 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5350 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5353 z_prime(j) = -uz(j,i-1)
5356 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5357 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5358 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5359 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5360 c & " xy",scalar(x_prime(1),y_prime(1)),
5361 c & " xz",scalar(x_prime(1),z_prime(1)),
5362 c & " yy",scalar(y_prime(1),y_prime(1)),
5363 c & " yz",scalar(y_prime(1),z_prime(1)),
5364 c & " zz",scalar(z_prime(1),z_prime(1))
5366 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5367 C to local coordinate system. Store in xx, yy, zz.
5373 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5374 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5375 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5382 C Compute the energy of the ith side cbain
5384 c write (2,*) "xx",xx," yy",yy," zz",zz
5387 x(j) = sc_parmin(j,it)
5390 Cc diagnostics - remove later
5392 yy1 = dsin(alph(2))*dcos(omeg(2))
5393 zz1 = -dsin(alph(2))*dsin(omeg(2))
5394 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5395 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5397 C," --- ", xx_w,yy_w,zz_w
5400 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5401 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5403 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5404 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5406 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5407 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5408 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5409 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5410 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5412 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5413 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5414 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5415 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5416 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5418 dsc_i = 0.743d0+x(61)
5420 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5421 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5422 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5423 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5424 s1=(1+x(63))/(0.1d0 + dscp1)
5425 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5426 s2=(1+x(65))/(0.1d0 + dscp2)
5427 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5428 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5429 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5430 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5432 c & dscp1,dscp2,sumene
5433 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5434 sccompon(it)=sccompon(it)+sumene
5435 escloc = escloc + sumene
5436 c write (2,*) "i",i," escloc",sumene,escloc
5439 C This section to check the numerical derivatives of the energy of ith side
5440 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5441 C #define DEBUG in the code to turn it on.
5443 write (2,*) "sumene =",sumene
5447 write (2,*) xx,yy,zz
5448 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5449 de_dxx_num=(sumenep-sumene)/aincr
5451 write (2,*) "xx+ sumene from enesc=",sumenep
5454 write (2,*) xx,yy,zz
5455 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5456 de_dyy_num=(sumenep-sumene)/aincr
5458 write (2,*) "yy+ sumene from enesc=",sumenep
5461 write (2,*) xx,yy,zz
5462 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5463 de_dzz_num=(sumenep-sumene)/aincr
5465 write (2,*) "zz+ sumene from enesc=",sumenep
5466 costsave=cost2tab(i+1)
5467 sintsave=sint2tab(i+1)
5468 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5469 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5470 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5471 de_dt_num=(sumenep-sumene)/aincr
5472 write (2,*) " t+ sumene from enesc=",sumenep
5473 cost2tab(i+1)=costsave
5474 sint2tab(i+1)=sintsave
5475 C End of diagnostics section.
5478 C Compute the gradient of esc
5480 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5481 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5482 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5483 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5484 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5485 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5486 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5487 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5488 pom1=(sumene3*sint2tab(i+1)+sumene1)
5489 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5490 pom2=(sumene4*cost2tab(i+1)+sumene2)
5491 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5492 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5493 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5494 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5496 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5497 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5498 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5500 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5501 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5502 & +(pom1+pom2)*pom_dx
5504 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5507 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5508 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5509 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5511 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5512 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5513 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5514 & +x(59)*zz**2 +x(60)*xx*zz
5515 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5516 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5517 & +(pom1-pom2)*pom_dy
5519 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5522 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5523 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5524 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5525 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5526 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5527 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5528 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5529 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5531 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5534 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5535 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5536 & +pom1*pom_dt1+pom2*pom_dt2
5538 write(2,*), "de_dt = ", de_dt,de_dt_num
5542 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5543 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5544 cosfac2xx=cosfac2*xx
5545 sinfac2yy=sinfac2*yy
5547 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5549 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5551 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5552 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5553 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5554 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5555 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5556 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5557 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5558 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5559 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5560 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5564 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5565 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5568 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5569 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5570 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5572 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5573 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5577 dXX_Ctab(k,i)=dXX_Ci(k)
5578 dXX_C1tab(k,i)=dXX_Ci1(k)
5579 dYY_Ctab(k,i)=dYY_Ci(k)
5580 dYY_C1tab(k,i)=dYY_Ci1(k)
5581 dZZ_Ctab(k,i)=dZZ_Ci(k)
5582 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5583 dXX_XYZtab(k,i)=dXX_XYZ(k)
5584 dYY_XYZtab(k,i)=dYY_XYZ(k)
5585 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5589 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5590 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5591 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5592 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5593 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5595 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5596 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5597 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5598 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5599 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5600 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5601 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5602 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5604 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5605 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5607 C to check gradient call subroutine check_grad
5613 c------------------------------------------------------------------------------
5614 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5616 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5617 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5618 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5619 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5621 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5622 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5624 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5625 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5626 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5627 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5628 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5630 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5631 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5632 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5633 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5634 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5636 dsc_i = 0.743d0+x(61)
5638 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5639 & *(xx*cost2+yy*sint2))
5640 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5641 & *(xx*cost2-yy*sint2))
5642 s1=(1+x(63))/(0.1d0 + dscp1)
5643 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5644 s2=(1+x(65))/(0.1d0 + dscp2)
5645 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5646 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5647 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5652 c------------------------------------------------------------------------------
5653 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5655 C This procedure calculates two-body contact function g(rij) and its derivative:
5658 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5661 C where x=(rij-r0ij)/delta
5663 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5666 double precision rij,r0ij,eps0ij,fcont,fprimcont
5667 double precision x,x2,x4,delta
5671 if (x.lt.-1.0D0) then
5674 else if (x.le.1.0D0) then
5677 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5678 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5685 c------------------------------------------------------------------------------
5686 subroutine splinthet(theti,delta,ss,ssder)
5687 implicit real*8 (a-h,o-z)
5688 include 'DIMENSIONS'
5689 include 'COMMON.VAR'
5690 include 'COMMON.GEO'
5693 if (theti.gt.pipol) then
5694 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5696 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5701 c------------------------------------------------------------------------------
5702 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5704 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5705 double precision ksi,ksi2,ksi3,a1,a2,a3
5706 a1=fprim0*delta/(f1-f0)
5712 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5713 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5716 c------------------------------------------------------------------------------
5717 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5719 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5720 double precision ksi,ksi2,ksi3,a1,a2,a3
5725 a2=3*(f1x-f0x)-2*fprim0x*delta
5726 a3=fprim0x*delta-2*(f1x-f0x)
5727 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5730 C-----------------------------------------------------------------------------
5732 C-----------------------------------------------------------------------------
5733 subroutine etor(etors,edihcnstr)
5734 implicit real*8 (a-h,o-z)
5735 include 'DIMENSIONS'
5736 include 'COMMON.VAR'
5737 include 'COMMON.GEO'
5738 include 'COMMON.LOCAL'
5739 include 'COMMON.TORSION'
5740 include 'COMMON.INTERACT'
5741 include 'COMMON.DERIV'
5742 include 'COMMON.CHAIN'
5743 include 'COMMON.NAMES'
5744 include 'COMMON.IOUNITS'
5745 include 'COMMON.FFIELD'
5746 include 'COMMON.TORCNSTR'
5747 include 'COMMON.CONTROL'
5748 include "COMMON.ECOMPON"
5750 C Set lprn=.true. for debugging
5754 do i=iphi_start,iphi_end
5755 if (itype(i-3).eq.ntyp1 .or. itype(i-2).eq.ntyp1 .or.
5756 & itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
5758 itori=itortyp(itype(i-2))
5759 itori1=itortyp(itype(i-1))
5762 C Proline-Proline pair is a special case...
5763 if (itori.eq.3 .and. itori1.eq.3) then
5764 if (phii.gt.-dwapi3) then
5766 fac=1.0D0/(1.0D0-cosphi)
5767 etorsi=v1(1,3,3)*fac
5768 etorsi=etorsi+etorsi
5769 etors=etors+etorsi-v1(1,3,3)
5770 torcompon(itype(i-2),itype(i-1))=
5771 & torcompon(itype(i-2),itype(i-1))+etorsi
5772 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5773 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5776 v1ij=v1(j+1,itori,itori1)
5777 v2ij=v2(j+1,itori,itori1)
5780 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5781 if (energy_dec) etors_ii=etors_ii+
5782 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5783 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5787 v1ij=v1(j,itori,itori1)
5788 v2ij=v2(j,itori,itori1)
5791 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5792 torcompon(itype(i-2),itype(i-1))=
5793 & torcompon(itype(i-2),itype(i-1))+v1ij*cosphi+v2ij*sinphi+
5794 & dabs(v1ij)+dabs(v2ij)
5795 if (energy_dec) etors_ii=etors_ii+
5796 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5797 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5800 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5803 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5804 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5805 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5806 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5807 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5809 ! 6/20/98 - dihedral angle constraints
5812 itori=idih_constr(i)
5815 if (difi.gt.drange(i)) then
5817 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5818 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5819 else if (difi.lt.-drange(i)) then
5821 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5822 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5824 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5825 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5827 ! write (iout,*) 'edihcnstr',edihcnstr
5830 c------------------------------------------------------------------------------
5831 subroutine etor_d(etors_d)
5835 c----------------------------------------------------------------------------
5837 subroutine etor(etors,edihcnstr)
5838 implicit real*8 (a-h,o-z)
5839 include 'DIMENSIONS'
5840 include 'COMMON.VAR'
5841 include 'COMMON.GEO'
5842 include 'COMMON.LOCAL'
5843 include 'COMMON.TORSION'
5844 include 'COMMON.INTERACT'
5845 include 'COMMON.DERIV'
5846 include 'COMMON.CHAIN'
5847 include 'COMMON.NAMES'
5848 include 'COMMON.IOUNITS'
5849 include 'COMMON.FFIELD'
5850 include 'COMMON.TORCNSTR'
5851 include 'COMMON.CONTROL'
5852 include "COMMON.ECOMPON"
5854 C Set lprn=.true. for debugging
5858 do i=iphi_start,iphi_end
5859 if (itype(i-3).eq.ntyp1 .or. itype(i-2).eq.ntyp1 .or.
5860 & itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
5862 itori=itortyp(itype(i-2))
5863 itori1=itortyp(itype(i-1))
5866 C Regular cosine and sine terms
5867 do j=1,nterm(itori,itori1)
5868 v1ij=v1(j,itori,itori1)
5869 v2ij=v2(j,itori,itori1)
5872 etors=etors+v1ij*cosphi+v2ij*sinphi
5873 torcompon(itype(i-2),itype(i-1))=
5874 & torcompon(itype(i-2),itype(i-1))+v1ij*cosphi+v2ij*sinphi
5875 if (energy_dec) etors_ii=etors_ii+
5876 & v1ij*cosphi+v2ij*sinphi
5877 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5881 C E = SUM ----------------------------------- - v1
5882 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5884 cosphi=dcos(0.5d0*phii)
5885 sinphi=dsin(0.5d0*phii)
5886 do j=1,nlor(itori,itori1)
5887 vl1ij=vlor1(j,itori,itori1)
5888 vl2ij=vlor2(j,itori,itori1)
5889 vl3ij=vlor3(j,itori,itori1)
5890 pom=vl2ij*cosphi+vl3ij*sinphi
5891 pom1=1.0d0/(pom*pom+1.0d0)
5892 etors=etors+vl1ij*pom1
5893 torcompon(itype(i-2),itype(i-1))=
5894 & torcompon(itype(i-2),itype(i-1))+vl1ij*pom1
5895 if (energy_dec) etors_ii=etors_ii+
5898 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5900 C Subtract the constant term
5901 etors=etors-v0(itori,itori1)
5902 torcompon(itype(i-2),itype(i-1))=
5903 & torcompon(itype(i-2),itype(i-1))-v0(itori,itori1)
5904 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5905 & 'etor',i,etors_ii-v0(itori,itori1)
5907 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5908 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5909 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5910 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5911 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5913 ! 6/20/98 - dihedral angle constraints
5915 c do i=1,ndih_constr
5916 do i=idihconstr_start,idihconstr_end
5917 itori=idih_constr(i)
5919 difi=pinorm(phii-phi0(i))
5920 if (difi.gt.drange(i)) then
5922 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5923 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5924 else if (difi.lt.-drange(i)) then
5926 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5927 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5931 c write (iout,*) "gloci", gloc(i-3,icg)
5932 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5933 cd & rad2deg*phi0(i), rad2deg*drange(i),
5934 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5936 cd write (iout,*) 'edihcnstr',edihcnstr
5939 c----------------------------------------------------------------------------
5940 subroutine etor_d(etors_d)
5941 C 6/23/01 Compute double torsional energy
5942 implicit real*8 (a-h,o-z)
5943 include 'DIMENSIONS'
5944 include 'COMMON.VAR'
5945 include 'COMMON.GEO'
5946 include 'COMMON.LOCAL'
5947 include 'COMMON.TORSION'
5948 include 'COMMON.INTERACT'
5949 include 'COMMON.DERIV'
5950 include 'COMMON.CHAIN'
5951 include 'COMMON.NAMES'
5952 include 'COMMON.IOUNITS'
5953 include 'COMMON.FFIELD'
5954 include 'COMMON.TORCNSTR'
5955 include "COMMON.ECOMPON"
5957 C Set lprn=.true. for debugging
5961 do i=iphid_start,iphid_end
5962 if (itype(i-3).eq.ntyp1 .or. itype(i-2).eq.ntyp1 .or.
5963 & itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1 .or.
5964 & itype(i+1).eq.ntyp1) cycle
5965 itori=itortyp(itype(i-2))
5966 itori1=itortyp(itype(i-1))
5967 itori2=itortyp(itype(i))
5972 do j=1,ntermd_1(itori,itori1,itori2)
5973 v1cij=v1c(1,j,itori,itori1,itori2)
5974 v1sij=v1s(1,j,itori,itori1,itori2)
5975 v2cij=v1c(2,j,itori,itori1,itori2)
5976 v2sij=v1s(2,j,itori,itori1,itori2)
5977 cosphi1=dcos(j*phii)
5978 sinphi1=dsin(j*phii)
5979 cosphi2=dcos(j*phii1)
5980 sinphi2=dsin(j*phii1)
5981 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5982 & v2cij*cosphi2+v2sij*sinphi2
5983 tordcompon(itype(i-1))=tordcompon(itype(i-1))+
5984 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5985 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5986 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5988 do k=2,ntermd_2(itori,itori1,itori2)
5990 v1cdij = v2c(k,l,itori,itori1,itori2)
5991 v2cdij = v2c(l,k,itori,itori1,itori2)
5992 v1sdij = v2s(k,l,itori,itori1,itori2)
5993 v2sdij = v2s(l,k,itori,itori1,itori2)
5994 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5995 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5996 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5997 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5998 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5999 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6000 tordcompon(itype(i-1))=tordcompon(itype(i-1))+
6001 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6002 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6003 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6004 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6005 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6006 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6009 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6010 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6011 c write (iout,*) "gloci", gloc(i-3,icg)
6016 c------------------------------------------------------------------------------
6017 subroutine eback_sc_corr(esccor)
6018 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6019 c conformational states; temporarily implemented as differences
6020 c between UNRES torsional potentials (dependent on three types of
6021 c residues) and the torsional potentials dependent on all 20 types
6022 c of residues computed from AM1 energy surfaces of terminally-blocked
6023 c amino-acid residues.
6024 implicit real*8 (a-h,o-z)
6025 include 'DIMENSIONS'
6026 include 'COMMON.VAR'
6027 include 'COMMON.GEO'
6028 include 'COMMON.LOCAL'
6029 include 'COMMON.TORSION'
6030 include 'COMMON.SCCOR'
6031 include 'COMMON.INTERACT'
6032 include 'COMMON.DERIV'
6033 include 'COMMON.CHAIN'
6034 include 'COMMON.NAMES'
6035 include 'COMMON.IOUNITS'
6036 include 'COMMON.FFIELD'
6037 include 'COMMON.CONTROL'
6038 include 'COMMON.ECOMPON'
6040 C Set lprn=.true. for debugging
6043 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6045 do i=itau_start,itau_end
6047 isccori=isccortyp(itype(i-2))
6048 isccori1=isccortyp(itype(i-1))
6049 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle
6051 cccc Added 9 May 2012
6052 cc Tauangle is torsional engle depending on the value of first digit
6053 c(see comment below)
6054 cc Omicron is flat angle depending on the value of first digit
6055 c(see comment below)
6058 do intertyp=1,3 !intertyp
6059 cc Added 09 May 2012 (Adasko)
6060 cc Intertyp means interaction type of backbone mainchain correlation:
6061 c 1 = SC...Ca...Ca...Ca
6062 c 2 = Ca...Ca...Ca...SC
6063 c 3 = SC...Ca...Ca...SCi
6065 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6066 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6067 & (itype(i-1).eq.ntyp1)))
6068 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6069 & .or.(itype(i-2).eq.ntyp1)))
6070 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6071 & (itype(i-1).eq.ntyp1)))) cycle
6072 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6073 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6075 do j=1,nterm_sccor(isccori,isccori1)
6076 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6077 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6078 cosphi=dcos(j*tauangle(intertyp,i))
6079 sinphi=dsin(j*tauangle(intertyp,i))
6080 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6081 sccorcompon(itype(i-2),itype(i-1))=
6082 & sccorcompon(itype(i-2),itype(i-1))+v1ij*cosphi+v2ij*sinphi
6083 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6085 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6086 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6087 c &gloc_sc(intertyp,i-3,icg)
6089 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6090 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6091 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6092 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6093 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6097 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6101 c----------------------------------------------------------------------------
6102 subroutine multibody(ecorr)
6103 C This subroutine calculates multi-body contributions to energy following
6104 C the idea of Skolnick et al. If side chains I and J make a contact and
6105 C at the same time side chains I+1 and J+1 make a contact, an extra
6106 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6107 implicit real*8 (a-h,o-z)
6108 include 'DIMENSIONS'
6109 include 'COMMON.IOUNITS'
6110 include 'COMMON.DERIV'
6111 include 'COMMON.INTERACT'
6112 include 'COMMON.CONTACTS'
6113 double precision gx(3),gx1(3)
6116 C Set lprn=.true. for debugging
6120 write (iout,'(a)') 'Contact function values:'
6122 write (iout,'(i2,20(1x,i2,f10.5))')
6123 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6138 num_conti=num_cont(i)
6139 num_conti1=num_cont(i1)
6144 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6145 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6146 cd & ' ishift=',ishift
6147 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6148 C The system gains extra energy.
6149 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6150 endif ! j1==j+-ishift
6159 c------------------------------------------------------------------------------
6160 double precision function esccorr(i,j,k,l,jj,kk)
6161 implicit real*8 (a-h,o-z)
6162 include 'DIMENSIONS'
6163 include 'COMMON.IOUNITS'
6164 include 'COMMON.DERIV'
6165 include 'COMMON.INTERACT'
6166 include 'COMMON.CONTACTS'
6167 double precision gx(3),gx1(3)
6172 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6173 C Calculate the multi-body contribution to energy.
6174 C Calculate multi-body contributions to the gradient.
6175 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6176 cd & k,l,(gacont(m,kk,k),m=1,3)
6178 gx(m) =ekl*gacont(m,jj,i)
6179 gx1(m)=eij*gacont(m,kk,k)
6180 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6181 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6182 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6183 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6187 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6192 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6198 c------------------------------------------------------------------------------
6199 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6200 C This subroutine calculates multi-body contributions to hydrogen-bonding
6201 implicit real*8 (a-h,o-z)
6202 include 'DIMENSIONS'
6203 include 'COMMON.IOUNITS'
6206 parameter (max_cont=maxconts)
6207 parameter (max_dim=26)
6208 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6209 double precision zapas(max_dim,maxconts,max_fg_procs),
6210 & zapas_recv(max_dim,maxconts,max_fg_procs)
6211 common /przechowalnia/ zapas
6212 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6213 & status_array(MPI_STATUS_SIZE,maxconts*2)
6215 include 'COMMON.SETUP'
6216 include 'COMMON.FFIELD'
6217 include 'COMMON.DERIV'
6218 include 'COMMON.INTERACT'
6219 include 'COMMON.CONTACTS'
6220 include 'COMMON.CONTROL'
6221 include 'COMMON.LOCAL'
6222 double precision gx(3),gx1(3),time00
6225 C Set lprn=.true. for debugging
6230 if (nfgtasks.le.1) goto 30
6232 write (iout,'(a)') 'Contact function values before RECEIVE:'
6234 write (iout,'(2i3,50(1x,i2,f5.2))')
6235 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6236 & j=1,num_cont_hb(i))
6240 do i=1,ntask_cont_from
6243 do i=1,ntask_cont_to
6246 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6248 C Make the list of contacts to send to send to other procesors
6249 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6251 do i=iturn3_start,iturn3_end
6252 c write (iout,*) "make contact list turn3",i," num_cont",
6254 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6256 do i=iturn4_start,iturn4_end
6257 c write (iout,*) "make contact list turn4",i," num_cont",
6259 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6263 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6265 do j=1,num_cont_hb(i)
6268 iproc=iint_sent_local(k,jjc,ii)
6269 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6270 if (iproc.gt.0) then
6271 ncont_sent(iproc)=ncont_sent(iproc)+1
6272 nn=ncont_sent(iproc)
6274 zapas(2,nn,iproc)=jjc
6275 zapas(3,nn,iproc)=facont_hb(j,i)
6276 zapas(4,nn,iproc)=ees0p(j,i)
6277 zapas(5,nn,iproc)=ees0m(j,i)
6278 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6279 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6280 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6281 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6282 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6283 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6284 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6285 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6286 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6287 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6288 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6289 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6290 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6291 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6292 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6293 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6294 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6295 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6296 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6297 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6298 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6305 & "Numbers of contacts to be sent to other processors",
6306 & (ncont_sent(i),i=1,ntask_cont_to)
6307 write (iout,*) "Contacts sent"
6308 do ii=1,ntask_cont_to
6310 iproc=itask_cont_to(ii)
6311 write (iout,*) nn," contacts to processor",iproc,
6312 & " of CONT_TO_COMM group"
6314 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6322 CorrelID1=nfgtasks+fg_rank+1
6324 C Receive the numbers of needed contacts from other processors
6325 do ii=1,ntask_cont_from
6326 iproc=itask_cont_from(ii)
6328 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6329 & FG_COMM,req(ireq),IERR)
6331 c write (iout,*) "IRECV ended"
6333 C Send the number of contacts needed by other processors
6334 do ii=1,ntask_cont_to
6335 iproc=itask_cont_to(ii)
6337 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6338 & FG_COMM,req(ireq),IERR)
6340 c write (iout,*) "ISEND ended"
6341 c write (iout,*) "number of requests (nn)",ireq
6344 & call MPI_Waitall(ireq,req,status_array,ierr)
6346 c & "Numbers of contacts to be received from other processors",
6347 c & (ncont_recv(i),i=1,ntask_cont_from)
6351 do ii=1,ntask_cont_from
6352 iproc=itask_cont_from(ii)
6354 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6355 c & " of CONT_TO_COMM group"
6359 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6360 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6361 c write (iout,*) "ireq,req",ireq,req(ireq)
6364 C Send the contacts to processors that need them
6365 do ii=1,ntask_cont_to
6366 iproc=itask_cont_to(ii)
6368 c write (iout,*) nn," contacts to processor",iproc,
6369 c & " of CONT_TO_COMM group"
6372 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6373 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6374 c write (iout,*) "ireq,req",ireq,req(ireq)
6376 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6380 c write (iout,*) "number of requests (contacts)",ireq
6381 c write (iout,*) "req",(req(i),i=1,4)
6384 & call MPI_Waitall(ireq,req,status_array,ierr)
6385 do iii=1,ntask_cont_from
6386 iproc=itask_cont_from(iii)
6389 write (iout,*) "Received",nn," contacts from processor",iproc,
6390 & " of CONT_FROM_COMM group"
6393 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6398 ii=zapas_recv(1,i,iii)
6399 c Flag the received contacts to prevent double-counting
6400 jj=-zapas_recv(2,i,iii)
6401 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6403 nnn=num_cont_hb(ii)+1
6406 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6407 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6408 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6409 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6410 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6411 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6412 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6413 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6414 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6415 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6416 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6417 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6418 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6419 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6420 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6421 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6422 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6423 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6424 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6425 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6426 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6427 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6428 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6429 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6434 write (iout,'(a)') 'Contact function values after receive:'
6436 write (iout,'(2i3,50(1x,i3,f5.2))')
6437 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6438 & j=1,num_cont_hb(i))
6445 write (iout,'(a)') 'Contact function values:'
6447 write (iout,'(2i3,50(1x,i3,f5.2))')
6448 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6449 & j=1,num_cont_hb(i))
6453 C Remove the loop below after debugging !!!
6460 C Calculate the local-electrostatic correlation terms
6461 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6463 num_conti=num_cont_hb(i)
6464 num_conti1=num_cont_hb(i+1)
6471 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6472 c & ' jj=',jj,' kk=',kk
6473 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6474 & .or. j.lt.0 .and. j1.gt.0) .and.
6475 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6476 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6477 C The system gains extra energy.
6478 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6479 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6480 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6482 else if (j1.eq.j) then
6483 C Contacts I-J and I-(J+1) occur simultaneously.
6484 C The system loses extra energy.
6485 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6490 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6491 c & ' jj=',jj,' kk=',kk
6493 C Contacts I-J and (I+1)-J occur simultaneously.
6494 C The system loses extra energy.
6495 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6502 c------------------------------------------------------------------------------
6503 subroutine add_hb_contact(ii,jj,itask)
6504 implicit real*8 (a-h,o-z)
6505 include "DIMENSIONS"
6506 include "COMMON.IOUNITS"
6509 parameter (max_cont=maxconts)
6510 parameter (max_dim=26)
6511 include "COMMON.CONTACTS"
6512 double precision zapas(max_dim,maxconts,max_fg_procs),
6513 & zapas_recv(max_dim,maxconts,max_fg_procs)
6514 common /przechowalnia/ zapas
6515 integer i,j,ii,jj,iproc,itask(4),nn
6516 c write (iout,*) "itask",itask
6519 if (iproc.gt.0) then
6520 do j=1,num_cont_hb(ii)
6522 c write (iout,*) "i",ii," j",jj," jjc",jjc
6524 ncont_sent(iproc)=ncont_sent(iproc)+1
6525 nn=ncont_sent(iproc)
6526 zapas(1,nn,iproc)=ii
6527 zapas(2,nn,iproc)=jjc
6528 zapas(3,nn,iproc)=facont_hb(j,ii)
6529 zapas(4,nn,iproc)=ees0p(j,ii)
6530 zapas(5,nn,iproc)=ees0m(j,ii)
6531 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6532 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6533 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6534 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6535 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6536 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6537 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6538 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6539 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6540 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6541 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6542 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6543 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6544 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6545 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6546 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6547 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6548 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6549 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6550 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6551 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6559 c------------------------------------------------------------------------------
6560 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6562 C This subroutine calculates multi-body contributions to hydrogen-bonding
6563 implicit real*8 (a-h,o-z)
6564 include 'DIMENSIONS'
6565 include 'COMMON.IOUNITS'
6568 parameter (max_cont=maxconts)
6569 parameter (max_dim=70)
6570 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6571 double precision zapas(max_dim,maxconts,max_fg_procs),
6572 & zapas_recv(max_dim,maxconts,max_fg_procs)
6573 common /przechowalnia/ zapas
6574 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6575 & status_array(MPI_STATUS_SIZE,maxconts*2)
6577 include 'COMMON.SETUP'
6578 include 'COMMON.FFIELD'
6579 include 'COMMON.DERIV'
6580 include 'COMMON.LOCAL'
6581 include 'COMMON.INTERACT'
6582 include 'COMMON.CONTACTS'
6583 include 'COMMON.CHAIN'
6584 include 'COMMON.CONTROL'
6585 double precision gx(3),gx1(3)
6586 integer num_cont_hb_old(maxres)
6588 double precision eello4,eello5,eelo6,eello_turn6
6589 external eello4,eello5,eello6,eello_turn6
6590 C Set lprn=.true. for debugging
6595 num_cont_hb_old(i)=num_cont_hb(i)
6599 if (nfgtasks.le.1) goto 30
6601 write (iout,'(a)') 'Contact function values before RECEIVE:'
6603 write (iout,'(2i3,50(1x,i2,f5.2))')
6604 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6605 & j=1,num_cont_hb(i))
6609 do i=1,ntask_cont_from
6612 do i=1,ntask_cont_to
6615 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6617 C Make the list of contacts to send to send to other procesors
6618 do i=iturn3_start,iturn3_end
6619 c write (iout,*) "make contact list turn3",i," num_cont",
6621 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6623 do i=iturn4_start,iturn4_end
6624 c write (iout,*) "make contact list turn4",i," num_cont",
6626 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6630 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6632 do j=1,num_cont_hb(i)
6635 iproc=iint_sent_local(k,jjc,ii)
6636 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6637 if (iproc.ne.0) then
6638 ncont_sent(iproc)=ncont_sent(iproc)+1
6639 nn=ncont_sent(iproc)
6641 zapas(2,nn,iproc)=jjc
6642 zapas(3,nn,iproc)=d_cont(j,i)
6646 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6651 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6659 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6670 & "Numbers of contacts to be sent to other processors",
6671 & (ncont_sent(i),i=1,ntask_cont_to)
6672 write (iout,*) "Contacts sent"
6673 do ii=1,ntask_cont_to
6675 iproc=itask_cont_to(ii)
6676 write (iout,*) nn," contacts to processor",iproc,
6677 & " of CONT_TO_COMM group"
6679 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6687 CorrelID1=nfgtasks+fg_rank+1
6689 C Receive the numbers of needed contacts from other processors
6690 do ii=1,ntask_cont_from
6691 iproc=itask_cont_from(ii)
6693 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6694 & FG_COMM,req(ireq),IERR)
6696 c write (iout,*) "IRECV ended"
6698 C Send the number of contacts needed by other processors
6699 do ii=1,ntask_cont_to
6700 iproc=itask_cont_to(ii)
6702 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6703 & FG_COMM,req(ireq),IERR)
6705 c write (iout,*) "ISEND ended"
6706 c write (iout,*) "number of requests (nn)",ireq
6709 & call MPI_Waitall(ireq,req,status_array,ierr)
6711 c & "Numbers of contacts to be received from other processors",
6712 c & (ncont_recv(i),i=1,ntask_cont_from)
6716 do ii=1,ntask_cont_from
6717 iproc=itask_cont_from(ii)
6719 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6720 c & " of CONT_TO_COMM group"
6724 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6725 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6726 c write (iout,*) "ireq,req",ireq,req(ireq)
6729 C Send the contacts to processors that need them
6730 do ii=1,ntask_cont_to
6731 iproc=itask_cont_to(ii)
6733 c write (iout,*) nn," contacts to processor",iproc,
6734 c & " of CONT_TO_COMM group"
6737 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6738 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6739 c write (iout,*) "ireq,req",ireq,req(ireq)
6741 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6745 c write (iout,*) "number of requests (contacts)",ireq
6746 c write (iout,*) "req",(req(i),i=1,4)
6749 & call MPI_Waitall(ireq,req,status_array,ierr)
6750 do iii=1,ntask_cont_from
6751 iproc=itask_cont_from(iii)
6754 write (iout,*) "Received",nn," contacts from processor",iproc,
6755 & " of CONT_FROM_COMM group"
6758 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6763 ii=zapas_recv(1,i,iii)
6764 c Flag the received contacts to prevent double-counting
6765 jj=-zapas_recv(2,i,iii)
6766 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6768 nnn=num_cont_hb(ii)+1
6771 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6775 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6780 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6788 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6797 write (iout,'(a)') 'Contact function values after receive:'
6799 write (iout,'(2i3,50(1x,i3,5f6.3))')
6800 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6801 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6808 write (iout,'(a)') 'Contact function values:'
6810 write (iout,'(2i3,50(1x,i2,5f6.3))')
6811 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6812 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6818 C Remove the loop below after debugging !!!
6825 C Calculate the dipole-dipole interaction energies
6826 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6827 do i=iatel_s,iatel_e+1
6828 num_conti=num_cont_hb(i)
6837 C Calculate the local-electrostatic correlation terms
6838 c write (iout,*) "gradcorr5 in eello5 before loop"
6840 c write (iout,'(i5,3f10.5)')
6841 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6843 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6844 c write (iout,*) "corr loop i",i
6846 num_conti=num_cont_hb(i)
6847 num_conti1=num_cont_hb(i+1)
6854 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6855 c & ' jj=',jj,' kk=',kk
6856 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6857 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6858 & .or. j.lt.0 .and. j1.gt.0) .and.
6859 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6860 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6861 C The system gains extra energy.
6863 sqd1=dsqrt(d_cont(jj,i))
6864 sqd2=dsqrt(d_cont(kk,i1))
6865 sred_geom = sqd1*sqd2
6866 IF (sred_geom.lt.cutoff_corr) THEN
6867 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6869 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6870 cd & ' jj=',jj,' kk=',kk
6871 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6872 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6874 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6875 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6878 cd write (iout,*) 'sred_geom=',sred_geom,
6879 cd & ' ekont=',ekont,' fprim=',fprimcont,
6880 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6881 cd write (iout,*) "g_contij",g_contij
6882 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6883 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6884 call calc_eello(i,jp,i+1,jp1,jj,kk)
6885 if (wcorr4.gt.0.0d0)
6886 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6887 if (energy_dec.and.wcorr4.gt.0.0d0)
6888 1 write (iout,'(a6,4i5,0pf7.3)')
6889 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6890 c write (iout,*) "gradcorr5 before eello5"
6892 c write (iout,'(i5,3f10.5)')
6893 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6895 if (wcorr5.gt.0.0d0)
6896 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6897 c write (iout,*) "gradcorr5 after eello5"
6899 c write (iout,'(i5,3f10.5)')
6900 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6902 if (energy_dec.and.wcorr5.gt.0.0d0)
6903 1 write (iout,'(a6,4i5,0pf7.3)')
6904 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6905 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6906 cd write(2,*)'ijkl',i,jp,i+1,jp1
6907 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6908 & .or. wturn6.eq.0.0d0))then
6909 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6910 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6911 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6912 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6913 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6914 cd & 'ecorr6=',ecorr6
6915 cd write (iout,'(4e15.5)') sred_geom,
6916 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6917 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6918 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6919 else if (wturn6.gt.0.0d0
6920 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6921 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6922 eturn6=eturn6+eello_turn6(i,jj,kk)
6923 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6924 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6925 cd write (2,*) 'multibody_eello:eturn6',eturn6
6934 num_cont_hb(i)=num_cont_hb_old(i)
6936 c write (iout,*) "gradcorr5 in eello5"
6938 c write (iout,'(i5,3f10.5)')
6939 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6943 c------------------------------------------------------------------------------
6944 subroutine add_hb_contact_eello(ii,jj,itask)
6945 implicit real*8 (a-h,o-z)
6946 include "DIMENSIONS"
6947 include "COMMON.IOUNITS"
6950 parameter (max_cont=maxconts)
6951 parameter (max_dim=70)
6952 include "COMMON.CONTACTS"
6953 double precision zapas(max_dim,maxconts,max_fg_procs),
6954 & zapas_recv(max_dim,maxconts,max_fg_procs)
6955 common /przechowalnia/ zapas
6956 integer i,j,ii,jj,iproc,itask(4),nn
6957 c write (iout,*) "itask",itask
6960 if (iproc.gt.0) then
6961 do j=1,num_cont_hb(ii)
6963 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6965 ncont_sent(iproc)=ncont_sent(iproc)+1
6966 nn=ncont_sent(iproc)
6967 zapas(1,nn,iproc)=ii
6968 zapas(2,nn,iproc)=jjc
6969 zapas(3,nn,iproc)=d_cont(j,ii)
6973 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6978 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6986 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6998 c------------------------------------------------------------------------------
6999 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7000 implicit real*8 (a-h,o-z)
7001 include 'DIMENSIONS'
7002 include 'COMMON.IOUNITS'
7003 include 'COMMON.DERIV'
7004 include 'COMMON.INTERACT'
7005 include 'COMMON.CONTACTS'
7006 double precision gx(3),gx1(3)
7016 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7017 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7018 C Following 4 lines for diagnostics.
7023 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7024 c & 'Contacts ',i,j,
7025 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7026 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7028 C Calculate the multi-body contribution to energy.
7029 c ecorr=ecorr+ekont*ees
7030 C Calculate multi-body contributions to the gradient.
7031 coeffpees0pij=coeffp*ees0pij
7032 coeffmees0mij=coeffm*ees0mij
7033 coeffpees0pkl=coeffp*ees0pkl
7034 coeffmees0mkl=coeffm*ees0mkl
7036 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7037 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7038 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7039 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7040 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7041 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7042 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7043 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7044 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7045 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7046 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7047 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7048 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7049 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7050 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7051 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7052 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7053 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7054 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7055 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7056 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7057 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7058 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7059 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7060 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7065 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7066 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7067 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7068 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7073 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7074 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7075 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7076 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7079 c write (iout,*) "ehbcorr",ekont*ees
7084 C---------------------------------------------------------------------------
7085 subroutine dipole(i,j,jj)
7086 implicit real*8 (a-h,o-z)
7087 include 'DIMENSIONS'
7088 include 'COMMON.IOUNITS'
7089 include 'COMMON.CHAIN'
7090 include 'COMMON.FFIELD'
7091 include 'COMMON.DERIV'
7092 include 'COMMON.INTERACT'
7093 include 'COMMON.CONTACTS'
7094 include 'COMMON.TORSION'
7095 include 'COMMON.VAR'
7096 include 'COMMON.GEO'
7097 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7099 iti1 = itortyp(itype(i+1))
7100 if (j.lt.nres-1) then
7101 itj1 = itortyp(itype(j+1))
7106 dipi(iii,1)=Ub2(iii,i)
7107 dipderi(iii)=Ub2der(iii,i)
7108 dipi(iii,2)=b1(iii,iti1)
7109 dipj(iii,1)=Ub2(iii,j)
7110 dipderj(iii)=Ub2der(iii,j)
7111 dipj(iii,2)=b1(iii,itj1)
7115 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7118 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7125 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7129 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7134 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7135 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7137 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7139 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7141 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7146 C---------------------------------------------------------------------------
7147 subroutine calc_eello(i,j,k,l,jj,kk)
7149 C This subroutine computes matrices and vectors needed to calculate
7150 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7152 implicit real*8 (a-h,o-z)
7153 include 'DIMENSIONS'
7154 include 'COMMON.IOUNITS'
7155 include 'COMMON.CHAIN'
7156 include 'COMMON.DERIV'
7157 include 'COMMON.INTERACT'
7158 include 'COMMON.CONTACTS'
7159 include 'COMMON.TORSION'
7160 include 'COMMON.VAR'
7161 include 'COMMON.GEO'
7162 include 'COMMON.FFIELD'
7163 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7164 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7167 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7168 cd & ' jj=',jj,' kk=',kk
7169 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7170 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7171 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7174 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7175 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7178 call transpose2(aa1(1,1),aa1t(1,1))
7179 call transpose2(aa2(1,1),aa2t(1,1))
7182 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7183 & aa1tder(1,1,lll,kkk))
7184 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7185 & aa2tder(1,1,lll,kkk))
7189 C parallel orientation of the two CA-CA-CA frames.
7191 iti=itortyp(itype(i))
7195 itk1=itortyp(itype(k+1))
7196 itj=itortyp(itype(j))
7197 if (l.lt.nres-1) then
7198 itl1=itortyp(itype(l+1))
7202 C A1 kernel(j+1) A2T
7204 cd write (iout,'(3f10.5,5x,3f10.5)')
7205 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7207 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7208 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7209 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7210 C Following matrices are needed only for 6-th order cumulants
7211 IF (wcorr6.gt.0.0d0) THEN
7212 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7213 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7214 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7215 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7216 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7217 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7218 & ADtEAderx(1,1,1,1,1,1))
7220 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7221 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7222 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7223 & ADtEA1derx(1,1,1,1,1,1))
7225 C End 6-th order cumulants
7228 cd write (2,*) 'In calc_eello6'
7230 cd write (2,*) 'iii=',iii
7232 cd write (2,*) 'kkk=',kkk
7234 cd write (2,'(3(2f10.5),5x)')
7235 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7240 call transpose2(EUgder(1,1,k),auxmat(1,1))
7241 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7242 call transpose2(EUg(1,1,k),auxmat(1,1))
7243 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7244 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7248 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7249 & EAEAderx(1,1,lll,kkk,iii,1))
7253 C A1T kernel(i+1) A2
7254 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7255 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7256 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7257 C Following matrices are needed only for 6-th order cumulants
7258 IF (wcorr6.gt.0.0d0) THEN
7259 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7260 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7261 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7262 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7263 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7264 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7265 & ADtEAderx(1,1,1,1,1,2))
7266 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7267 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7268 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7269 & ADtEA1derx(1,1,1,1,1,2))
7271 C End 6-th order cumulants
7272 call transpose2(EUgder(1,1,l),auxmat(1,1))
7273 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7274 call transpose2(EUg(1,1,l),auxmat(1,1))
7275 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7276 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7280 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7281 & EAEAderx(1,1,lll,kkk,iii,2))
7286 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7287 C They are needed only when the fifth- or the sixth-order cumulants are
7289 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7290 call transpose2(AEA(1,1,1),auxmat(1,1))
7291 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7292 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7293 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7294 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7295 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7296 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7297 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7298 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7299 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7300 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7301 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7302 call transpose2(AEA(1,1,2),auxmat(1,1))
7303 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7304 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7305 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7306 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7307 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7308 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7309 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7310 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7311 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7312 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7313 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7314 C Calculate the Cartesian derivatives of the vectors.
7318 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7319 call matvec2(auxmat(1,1),b1(1,iti),
7320 & AEAb1derx(1,lll,kkk,iii,1,1))
7321 call matvec2(auxmat(1,1),Ub2(1,i),
7322 & AEAb2derx(1,lll,kkk,iii,1,1))
7323 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7324 & AEAb1derx(1,lll,kkk,iii,2,1))
7325 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7326 & AEAb2derx(1,lll,kkk,iii,2,1))
7327 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7328 call matvec2(auxmat(1,1),b1(1,itj),
7329 & AEAb1derx(1,lll,kkk,iii,1,2))
7330 call matvec2(auxmat(1,1),Ub2(1,j),
7331 & AEAb2derx(1,lll,kkk,iii,1,2))
7332 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7333 & AEAb1derx(1,lll,kkk,iii,2,2))
7334 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7335 & AEAb2derx(1,lll,kkk,iii,2,2))
7342 C Antiparallel orientation of the two CA-CA-CA frames.
7344 iti=itortyp(itype(i))
7348 itk1=itortyp(itype(k+1))
7349 itl=itortyp(itype(l))
7350 itj=itortyp(itype(j))
7351 if (j.lt.nres-1) then
7352 itj1=itortyp(itype(j+1))
7356 C A2 kernel(j-1)T A1T
7357 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7358 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7359 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7360 C Following matrices are needed only for 6-th order cumulants
7361 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7362 & j.eq.i+4 .and. l.eq.i+3)) THEN
7363 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7364 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7365 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7366 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7367 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7368 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7369 & ADtEAderx(1,1,1,1,1,1))
7370 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7371 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7372 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7373 & ADtEA1derx(1,1,1,1,1,1))
7375 C End 6-th order cumulants
7376 call transpose2(EUgder(1,1,k),auxmat(1,1))
7377 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7378 call transpose2(EUg(1,1,k),auxmat(1,1))
7379 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7380 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7384 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7385 & EAEAderx(1,1,lll,kkk,iii,1))
7389 C A2T kernel(i+1)T A1
7390 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7391 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7392 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7393 C Following matrices are needed only for 6-th order cumulants
7394 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7395 & j.eq.i+4 .and. l.eq.i+3)) THEN
7396 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7397 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7398 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7399 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7400 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7401 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7402 & ADtEAderx(1,1,1,1,1,2))
7403 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7404 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7405 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7406 & ADtEA1derx(1,1,1,1,1,2))
7408 C End 6-th order cumulants
7409 call transpose2(EUgder(1,1,j),auxmat(1,1))
7410 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7411 call transpose2(EUg(1,1,j),auxmat(1,1))
7412 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7413 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7417 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7418 & EAEAderx(1,1,lll,kkk,iii,2))
7423 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7424 C They are needed only when the fifth- or the sixth-order cumulants are
7426 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7427 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7428 call transpose2(AEA(1,1,1),auxmat(1,1))
7429 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7430 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7431 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7432 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7433 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7434 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7435 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7436 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7437 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7438 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7439 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7440 call transpose2(AEA(1,1,2),auxmat(1,1))
7441 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7442 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7443 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7444 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7445 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7446 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7447 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7448 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7449 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7450 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7451 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7452 C Calculate the Cartesian derivatives of the vectors.
7456 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7457 call matvec2(auxmat(1,1),b1(1,iti),
7458 & AEAb1derx(1,lll,kkk,iii,1,1))
7459 call matvec2(auxmat(1,1),Ub2(1,i),
7460 & AEAb2derx(1,lll,kkk,iii,1,1))
7461 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7462 & AEAb1derx(1,lll,kkk,iii,2,1))
7463 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7464 & AEAb2derx(1,lll,kkk,iii,2,1))
7465 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7466 call matvec2(auxmat(1,1),b1(1,itl),
7467 & AEAb1derx(1,lll,kkk,iii,1,2))
7468 call matvec2(auxmat(1,1),Ub2(1,l),
7469 & AEAb2derx(1,lll,kkk,iii,1,2))
7470 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7471 & AEAb1derx(1,lll,kkk,iii,2,2))
7472 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7473 & AEAb2derx(1,lll,kkk,iii,2,2))
7482 C---------------------------------------------------------------------------
7483 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7484 & KK,KKderg,AKA,AKAderg,AKAderx)
7488 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7489 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7490 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7495 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7497 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7500 cd if (lprn) write (2,*) 'In kernel'
7502 cd if (lprn) write (2,*) 'kkk=',kkk
7504 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7505 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7507 cd write (2,*) 'lll=',lll
7508 cd write (2,*) 'iii=1'
7510 cd write (2,'(3(2f10.5),5x)')
7511 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7514 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7515 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7517 cd write (2,*) 'lll=',lll
7518 cd write (2,*) 'iii=2'
7520 cd write (2,'(3(2f10.5),5x)')
7521 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7528 C---------------------------------------------------------------------------
7529 double precision function eello4(i,j,k,l,jj,kk)
7530 implicit real*8 (a-h,o-z)
7531 include 'DIMENSIONS'
7532 include 'COMMON.IOUNITS'
7533 include 'COMMON.CHAIN'
7534 include 'COMMON.DERIV'
7535 include 'COMMON.INTERACT'
7536 include 'COMMON.CONTACTS'
7537 include 'COMMON.TORSION'
7538 include 'COMMON.VAR'
7539 include 'COMMON.GEO'
7540 double precision pizda(2,2),ggg1(3),ggg2(3)
7541 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7545 cd print *,'eello4:',i,j,k,l,jj,kk
7546 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7547 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7548 cold eij=facont_hb(jj,i)
7549 cold ekl=facont_hb(kk,k)
7551 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7552 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7553 gcorr_loc(k-1)=gcorr_loc(k-1)
7554 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7556 gcorr_loc(l-1)=gcorr_loc(l-1)
7557 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7559 gcorr_loc(j-1)=gcorr_loc(j-1)
7560 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7565 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7566 & -EAEAderx(2,2,lll,kkk,iii,1)
7567 cd derx(lll,kkk,iii)=0.0d0
7571 cd gcorr_loc(l-1)=0.0d0
7572 cd gcorr_loc(j-1)=0.0d0
7573 cd gcorr_loc(k-1)=0.0d0
7575 cd write (iout,*)'Contacts have occurred for peptide groups',
7576 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7577 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7578 if (j.lt.nres-1) then
7585 if (l.lt.nres-1) then
7593 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7594 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7595 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7596 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7597 cgrad ghalf=0.5d0*ggg1(ll)
7598 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7599 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7600 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7601 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7602 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7603 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7604 cgrad ghalf=0.5d0*ggg2(ll)
7605 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7606 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7607 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7608 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7609 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7610 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7614 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7619 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7624 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7629 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7633 cd write (2,*) iii,gcorr_loc(iii)
7636 cd write (2,*) 'ekont',ekont
7637 cd write (iout,*) 'eello4',ekont*eel4
7640 C---------------------------------------------------------------------------
7641 double precision function eello5(i,j,k,l,jj,kk)
7642 implicit real*8 (a-h,o-z)
7643 include 'DIMENSIONS'
7644 include 'COMMON.IOUNITS'
7645 include 'COMMON.CHAIN'
7646 include 'COMMON.DERIV'
7647 include 'COMMON.INTERACT'
7648 include 'COMMON.CONTACTS'
7649 include 'COMMON.TORSION'
7650 include 'COMMON.VAR'
7651 include 'COMMON.GEO'
7652 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7653 double precision ggg1(3),ggg2(3)
7654 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7659 C /l\ / \ \ / \ / \ / C
7660 C / \ / \ \ / \ / \ / C
7661 C j| o |l1 | o | o| o | | o |o C
7662 C \ |/k\| |/ \| / |/ \| |/ \| C
7663 C \i/ \ / \ / / \ / \ C
7665 C (I) (II) (III) (IV) C
7667 C eello5_1 eello5_2 eello5_3 eello5_4 C
7669 C Antiparallel chains C
7672 C /j\ / \ \ / \ / \ / C
7673 C / \ / \ \ / \ / \ / C
7674 C j1| o |l | o | o| o | | o |o C
7675 C \ |/k\| |/ \| / |/ \| |/ \| C
7676 C \i/ \ / \ / / \ / \ C
7678 C (I) (II) (III) (IV) C
7680 C eello5_1 eello5_2 eello5_3 eello5_4 C
7682 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7684 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7685 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7690 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7692 itk=itortyp(itype(k))
7693 itl=itortyp(itype(l))
7694 itj=itortyp(itype(j))
7699 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7700 cd & eel5_3_num,eel5_4_num)
7704 derx(lll,kkk,iii)=0.0d0
7708 cd eij=facont_hb(jj,i)
7709 cd ekl=facont_hb(kk,k)
7711 cd write (iout,*)'Contacts have occurred for peptide groups',
7712 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7714 C Contribution from the graph I.
7715 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7716 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7717 call transpose2(EUg(1,1,k),auxmat(1,1))
7718 call matmat2(AEA(1,1,1),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 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7722 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7723 C Explicit gradient in virtual-dihedral angles.
7724 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7725 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7726 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7727 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7728 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7729 vv(1)=pizda(1,1)-pizda(2,2)
7730 vv(2)=pizda(1,2)+pizda(2,1)
7731 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7732 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7733 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7734 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7735 vv(1)=pizda(1,1)-pizda(2,2)
7736 vv(2)=pizda(1,2)+pizda(2,1)
7738 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7739 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7740 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7742 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7743 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7744 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7746 C Cartesian gradient
7750 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7752 vv(1)=pizda(1,1)-pizda(2,2)
7753 vv(2)=pizda(1,2)+pizda(2,1)
7754 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7755 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7756 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7762 C Contribution from graph II
7763 call transpose2(EE(1,1,itk),auxmat(1,1))
7764 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7765 vv(1)=pizda(1,1)+pizda(2,2)
7766 vv(2)=pizda(2,1)-pizda(1,2)
7767 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7768 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7769 C Explicit gradient in virtual-dihedral angles.
7770 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7771 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7772 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7773 vv(1)=pizda(1,1)+pizda(2,2)
7774 vv(2)=pizda(2,1)-pizda(1,2)
7776 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7777 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7778 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7780 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7781 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7782 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7784 C Cartesian gradient
7788 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7790 vv(1)=pizda(1,1)+pizda(2,2)
7791 vv(2)=pizda(2,1)-pizda(1,2)
7792 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7793 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7794 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7802 C Parallel orientation
7803 C Contribution from graph III
7804 call transpose2(EUg(1,1,l),auxmat(1,1))
7805 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7806 vv(1)=pizda(1,1)-pizda(2,2)
7807 vv(2)=pizda(1,2)+pizda(2,1)
7808 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7809 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7810 C Explicit gradient in virtual-dihedral angles.
7811 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7812 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7813 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7814 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7815 vv(1)=pizda(1,1)-pizda(2,2)
7816 vv(2)=pizda(1,2)+pizda(2,1)
7817 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7818 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7819 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7820 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7821 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7822 vv(1)=pizda(1,1)-pizda(2,2)
7823 vv(2)=pizda(1,2)+pizda(2,1)
7824 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7825 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7826 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7827 C Cartesian gradient
7831 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7833 vv(1)=pizda(1,1)-pizda(2,2)
7834 vv(2)=pizda(1,2)+pizda(2,1)
7835 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7836 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7837 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7842 C Contribution from graph IV
7844 call transpose2(EE(1,1,itl),auxmat(1,1))
7845 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7846 vv(1)=pizda(1,1)+pizda(2,2)
7847 vv(2)=pizda(2,1)-pizda(1,2)
7848 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7849 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7850 C Explicit gradient in virtual-dihedral angles.
7851 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7852 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7853 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7854 vv(1)=pizda(1,1)+pizda(2,2)
7855 vv(2)=pizda(2,1)-pizda(1,2)
7856 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7857 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7858 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7859 C Cartesian gradient
7863 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7865 vv(1)=pizda(1,1)+pizda(2,2)
7866 vv(2)=pizda(2,1)-pizda(1,2)
7867 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7868 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7869 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7874 C Antiparallel orientation
7875 C Contribution from graph III
7877 call transpose2(EUg(1,1,j),auxmat(1,1))
7878 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7879 vv(1)=pizda(1,1)-pizda(2,2)
7880 vv(2)=pizda(1,2)+pizda(2,1)
7881 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7882 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7883 C Explicit gradient in virtual-dihedral angles.
7884 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7885 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7886 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7887 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7888 vv(1)=pizda(1,1)-pizda(2,2)
7889 vv(2)=pizda(1,2)+pizda(2,1)
7890 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7891 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7892 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7893 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7894 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7895 vv(1)=pizda(1,1)-pizda(2,2)
7896 vv(2)=pizda(1,2)+pizda(2,1)
7897 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7898 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7899 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7900 C Cartesian gradient
7904 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7906 vv(1)=pizda(1,1)-pizda(2,2)
7907 vv(2)=pizda(1,2)+pizda(2,1)
7908 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7909 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7910 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7915 C Contribution from graph IV
7917 call transpose2(EE(1,1,itj),auxmat(1,1))
7918 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7919 vv(1)=pizda(1,1)+pizda(2,2)
7920 vv(2)=pizda(2,1)-pizda(1,2)
7921 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7922 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7923 C Explicit gradient in virtual-dihedral angles.
7924 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7925 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7926 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7927 vv(1)=pizda(1,1)+pizda(2,2)
7928 vv(2)=pizda(2,1)-pizda(1,2)
7929 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7930 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7931 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7932 C Cartesian gradient
7936 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7938 vv(1)=pizda(1,1)+pizda(2,2)
7939 vv(2)=pizda(2,1)-pizda(1,2)
7940 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7941 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7942 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7948 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7949 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7950 cd write (2,*) 'ijkl',i,j,k,l
7951 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7952 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7954 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7955 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7956 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7957 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7958 if (j.lt.nres-1) then
7965 if (l.lt.nres-1) then
7975 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7976 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7977 C summed up outside the subrouine as for the other subroutines
7978 C handling long-range interactions. The old code is commented out
7979 C with "cgrad" to keep track of changes.
7981 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7982 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7983 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7984 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7985 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7986 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7987 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7988 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7989 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7990 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7992 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7993 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7994 cgrad ghalf=0.5d0*ggg1(ll)
7996 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7997 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7998 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7999 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8000 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8001 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8002 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8003 cgrad ghalf=0.5d0*ggg2(ll)
8005 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8006 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8007 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8008 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8009 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8010 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8015 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8016 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8021 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8022 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8028 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8033 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8037 cd write (2,*) iii,g_corr5_loc(iii)
8040 cd write (2,*) 'ekont',ekont
8041 cd write (iout,*) 'eello5',ekont*eel5
8044 c--------------------------------------------------------------------------
8045 double precision function eello6(i,j,k,l,jj,kk)
8046 implicit real*8 (a-h,o-z)
8047 include 'DIMENSIONS'
8048 include 'COMMON.IOUNITS'
8049 include 'COMMON.CHAIN'
8050 include 'COMMON.DERIV'
8051 include 'COMMON.INTERACT'
8052 include 'COMMON.CONTACTS'
8053 include 'COMMON.TORSION'
8054 include 'COMMON.VAR'
8055 include 'COMMON.GEO'
8056 include 'COMMON.FFIELD'
8057 double precision ggg1(3),ggg2(3)
8058 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8063 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8071 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8072 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8076 derx(lll,kkk,iii)=0.0d0
8080 cd eij=facont_hb(jj,i)
8081 cd ekl=facont_hb(kk,k)
8087 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8088 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8089 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8090 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8091 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8092 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8094 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8095 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8096 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8097 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8098 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8099 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8103 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8105 C If turn contributions are considered, they will be handled separately.
8106 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8107 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8108 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8109 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8110 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8111 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8112 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8114 if (j.lt.nres-1) then
8121 if (l.lt.nres-1) then
8129 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8130 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8131 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8132 cgrad ghalf=0.5d0*ggg1(ll)
8134 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8135 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8136 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8137 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8138 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8139 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8140 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8141 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8142 cgrad ghalf=0.5d0*ggg2(ll)
8143 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8145 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8146 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8147 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8148 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8149 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8150 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8155 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8156 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8161 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8162 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8168 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8173 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8177 cd write (2,*) iii,g_corr6_loc(iii)
8180 cd write (2,*) 'ekont',ekont
8181 cd write (iout,*) 'eello6',ekont*eel6
8184 c--------------------------------------------------------------------------
8185 double precision function eello6_graph1(i,j,k,l,imat,swap)
8186 implicit real*8 (a-h,o-z)
8187 include 'DIMENSIONS'
8188 include 'COMMON.IOUNITS'
8189 include 'COMMON.CHAIN'
8190 include 'COMMON.DERIV'
8191 include 'COMMON.INTERACT'
8192 include 'COMMON.CONTACTS'
8193 include 'COMMON.TORSION'
8194 include 'COMMON.VAR'
8195 include 'COMMON.GEO'
8196 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8200 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8202 C Parallel Antiparallel
8208 C \ j|/k\| / \ |/k\|l /
8213 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8214 itk=itortyp(itype(k))
8215 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8216 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8217 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8218 call transpose2(EUgC(1,1,k),auxmat(1,1))
8219 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8220 vv1(1)=pizda1(1,1)-pizda1(2,2)
8221 vv1(2)=pizda1(1,2)+pizda1(2,1)
8222 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8223 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8224 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8225 s5=scalar2(vv(1),Dtobr2(1,i))
8226 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8227 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8228 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8229 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8230 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8231 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8232 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8233 & +scalar2(vv(1),Dtobr2der(1,i)))
8234 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8235 vv1(1)=pizda1(1,1)-pizda1(2,2)
8236 vv1(2)=pizda1(1,2)+pizda1(2,1)
8237 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8238 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8240 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8241 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8242 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8243 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8244 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8246 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8247 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8248 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8249 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8250 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8252 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8253 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8254 vv1(1)=pizda1(1,1)-pizda1(2,2)
8255 vv1(2)=pizda1(1,2)+pizda1(2,1)
8256 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8257 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8258 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8259 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8268 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8269 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8270 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8271 call transpose2(EUgC(1,1,k),auxmat(1,1))
8272 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8274 vv1(1)=pizda1(1,1)-pizda1(2,2)
8275 vv1(2)=pizda1(1,2)+pizda1(2,1)
8276 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8277 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8278 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8279 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8280 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8281 s5=scalar2(vv(1),Dtobr2(1,i))
8282 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8288 c----------------------------------------------------------------------------
8289 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8290 implicit real*8 (a-h,o-z)
8291 include 'DIMENSIONS'
8292 include 'COMMON.IOUNITS'
8293 include 'COMMON.CHAIN'
8294 include 'COMMON.DERIV'
8295 include 'COMMON.INTERACT'
8296 include 'COMMON.CONTACTS'
8297 include 'COMMON.TORSION'
8298 include 'COMMON.VAR'
8299 include 'COMMON.GEO'
8301 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8302 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8305 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8307 C Parallel Antiparallel C
8313 C \ j|/k\| \ |/k\|l C
8318 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8319 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8320 C AL 7/4/01 s1 would occur in the sixth-order moment,
8321 C but not in a cluster cumulant
8323 s1=dip(1,jj,i)*dip(1,kk,k)
8325 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8326 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8327 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8328 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8329 call transpose2(EUg(1,1,k),auxmat(1,1))
8330 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8331 vv(1)=pizda(1,1)-pizda(2,2)
8332 vv(2)=pizda(1,2)+pizda(2,1)
8333 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8334 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8336 eello6_graph2=-(s1+s2+s3+s4)
8338 eello6_graph2=-(s2+s3+s4)
8341 C Derivatives in gamma(i-1)
8344 s1=dipderg(1,jj,i)*dip(1,kk,k)
8346 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8347 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8348 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8349 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8351 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8353 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8355 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8357 C Derivatives in gamma(k-1)
8359 s1=dip(1,jj,i)*dipderg(1,kk,k)
8361 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8362 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8363 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8364 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8365 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8366 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8367 vv(1)=pizda(1,1)-pizda(2,2)
8368 vv(2)=pizda(1,2)+pizda(2,1)
8369 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8371 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8373 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8375 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8376 C Derivatives in gamma(j-1) or gamma(l-1)
8379 s1=dipderg(3,jj,i)*dip(1,kk,k)
8381 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8382 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8383 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8384 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8385 vv(1)=pizda(1,1)-pizda(2,2)
8386 vv(2)=pizda(1,2)+pizda(2,1)
8387 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8390 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8392 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8395 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8396 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8398 C Derivatives in gamma(l-1) or gamma(j-1)
8401 s1=dip(1,jj,i)*dipderg(3,kk,k)
8403 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8404 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8405 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8406 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8407 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8408 vv(1)=pizda(1,1)-pizda(2,2)
8409 vv(2)=pizda(1,2)+pizda(2,1)
8410 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8413 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8415 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8418 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8419 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8421 C Cartesian derivatives.
8423 write (2,*) 'In eello6_graph2'
8425 write (2,*) 'iii=',iii
8427 write (2,*) 'kkk=',kkk
8429 write (2,'(3(2f10.5),5x)')
8430 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8440 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8442 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8445 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8447 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8448 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8450 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8451 call transpose2(EUg(1,1,k),auxmat(1,1))
8452 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8454 vv(1)=pizda(1,1)-pizda(2,2)
8455 vv(2)=pizda(1,2)+pizda(2,1)
8456 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8457 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8459 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8461 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8464 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8466 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8473 c----------------------------------------------------------------------------
8474 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8475 implicit real*8 (a-h,o-z)
8476 include 'DIMENSIONS'
8477 include 'COMMON.IOUNITS'
8478 include 'COMMON.CHAIN'
8479 include 'COMMON.DERIV'
8480 include 'COMMON.INTERACT'
8481 include 'COMMON.CONTACTS'
8482 include 'COMMON.TORSION'
8483 include 'COMMON.VAR'
8484 include 'COMMON.GEO'
8485 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8487 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8489 C Parallel Antiparallel C
8495 C j|/k\| / |/k\|l / C
8500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8502 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8503 C energy moment and not to the cluster cumulant.
8504 iti=itortyp(itype(i))
8505 if (j.lt.nres-1) then
8506 itj1=itortyp(itype(j+1))
8510 itk=itortyp(itype(k))
8511 itk1=itortyp(itype(k+1))
8512 if (l.lt.nres-1) then
8513 itl1=itortyp(itype(l+1))
8518 s1=dip(4,jj,i)*dip(4,kk,k)
8520 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8521 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8522 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8523 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8524 call transpose2(EE(1,1,itk),auxmat(1,1))
8525 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8526 vv(1)=pizda(1,1)+pizda(2,2)
8527 vv(2)=pizda(2,1)-pizda(1,2)
8528 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8529 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8530 cd & "sum",-(s2+s3+s4)
8532 eello6_graph3=-(s1+s2+s3+s4)
8534 eello6_graph3=-(s2+s3+s4)
8537 C Derivatives in gamma(k-1)
8538 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8539 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8540 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8541 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8542 C Derivatives in gamma(l-1)
8543 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8544 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8545 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8546 vv(1)=pizda(1,1)+pizda(2,2)
8547 vv(2)=pizda(2,1)-pizda(1,2)
8548 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8549 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8550 C Cartesian derivatives.
8556 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8558 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8561 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8563 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8564 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8566 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8567 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8569 vv(1)=pizda(1,1)+pizda(2,2)
8570 vv(2)=pizda(2,1)-pizda(1,2)
8571 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8573 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8575 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8578 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8580 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8582 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8588 c----------------------------------------------------------------------------
8589 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8590 implicit real*8 (a-h,o-z)
8591 include 'DIMENSIONS'
8592 include 'COMMON.IOUNITS'
8593 include 'COMMON.CHAIN'
8594 include 'COMMON.DERIV'
8595 include 'COMMON.INTERACT'
8596 include 'COMMON.CONTACTS'
8597 include 'COMMON.TORSION'
8598 include 'COMMON.VAR'
8599 include 'COMMON.GEO'
8600 include 'COMMON.FFIELD'
8601 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8602 & auxvec1(2),auxmat1(2,2)
8604 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8606 C Parallel Antiparallel C
8612 C \ j|/k\| \ |/k\|l C
8617 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8619 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8620 C energy moment and not to the cluster cumulant.
8621 cd write (2,*) 'eello_graph4: wturn6',wturn6
8622 iti=itortyp(itype(i))
8623 itj=itortyp(itype(j))
8624 if (j.lt.nres-1) then
8625 itj1=itortyp(itype(j+1))
8629 itk=itortyp(itype(k))
8630 if (k.lt.nres-1) then
8631 itk1=itortyp(itype(k+1))
8635 itl=itortyp(itype(l))
8636 if (l.lt.nres-1) then
8637 itl1=itortyp(itype(l+1))
8641 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8642 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8643 cd & ' itl',itl,' itl1',itl1
8646 s1=dip(3,jj,i)*dip(3,kk,k)
8648 s1=dip(2,jj,j)*dip(2,kk,l)
8651 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8652 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8654 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8655 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8657 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8658 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8660 call transpose2(EUg(1,1,k),auxmat(1,1))
8661 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8662 vv(1)=pizda(1,1)-pizda(2,2)
8663 vv(2)=pizda(2,1)+pizda(1,2)
8664 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8665 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8667 eello6_graph4=-(s1+s2+s3+s4)
8669 eello6_graph4=-(s2+s3+s4)
8671 C Derivatives in gamma(i-1)
8675 s1=dipderg(2,jj,i)*dip(3,kk,k)
8677 s1=dipderg(4,jj,j)*dip(2,kk,l)
8680 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8682 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8683 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8685 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8686 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8688 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8689 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8690 cd write (2,*) 'turn6 derivatives'
8692 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8694 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8698 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8700 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8704 C Derivatives in gamma(k-1)
8707 s1=dip(3,jj,i)*dipderg(2,kk,k)
8709 s1=dip(2,jj,j)*dipderg(4,kk,l)
8712 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8713 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8715 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8716 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8718 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8719 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8721 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8722 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8723 vv(1)=pizda(1,1)-pizda(2,2)
8724 vv(2)=pizda(2,1)+pizda(1,2)
8725 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8726 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8728 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8730 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8734 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8736 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8739 C Derivatives in gamma(j-1) or gamma(l-1)
8740 if (l.eq.j+1 .and. l.gt.1) then
8741 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8742 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8743 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8744 vv(1)=pizda(1,1)-pizda(2,2)
8745 vv(2)=pizda(2,1)+pizda(1,2)
8746 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8747 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8748 else if (j.gt.1) then
8749 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8750 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8751 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8752 vv(1)=pizda(1,1)-pizda(2,2)
8753 vv(2)=pizda(2,1)+pizda(1,2)
8754 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8755 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8756 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8758 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8761 C Cartesian derivatives.
8768 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8770 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8774 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8776 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8780 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8782 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8784 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8785 & b1(1,itj1),auxvec(1))
8786 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8788 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8789 & b1(1,itl1),auxvec(1))
8790 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8792 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8794 vv(1)=pizda(1,1)-pizda(2,2)
8795 vv(2)=pizda(2,1)+pizda(1,2)
8796 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8798 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8800 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8803 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8806 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8809 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8811 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8813 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8817 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8819 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8822 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8824 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8832 c----------------------------------------------------------------------------
8833 double precision function eello_turn6(i,jj,kk)
8834 implicit real*8 (a-h,o-z)
8835 include 'DIMENSIONS'
8836 include 'COMMON.IOUNITS'
8837 include 'COMMON.CHAIN'
8838 include 'COMMON.DERIV'
8839 include 'COMMON.INTERACT'
8840 include 'COMMON.CONTACTS'
8841 include 'COMMON.TORSION'
8842 include 'COMMON.VAR'
8843 include 'COMMON.GEO'
8844 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8845 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8847 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8848 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8849 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8850 C the respective energy moment and not to the cluster cumulant.
8859 iti=itortyp(itype(i))
8860 itk=itortyp(itype(k))
8861 itk1=itortyp(itype(k+1))
8862 itl=itortyp(itype(l))
8863 itj=itortyp(itype(j))
8864 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8865 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8866 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8871 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8873 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8877 derx_turn(lll,kkk,iii)=0.0d0
8884 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8886 cd write (2,*) 'eello6_5',eello6_5
8888 call transpose2(AEA(1,1,1),auxmat(1,1))
8889 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8890 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8891 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8893 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8894 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8895 s2 = scalar2(b1(1,itk),vtemp1(1))
8897 call transpose2(AEA(1,1,2),atemp(1,1))
8898 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8899 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8900 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8902 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8903 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8904 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8906 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8907 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8908 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8909 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8910 ss13 = scalar2(b1(1,itk),vtemp4(1))
8911 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8913 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8919 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8920 C Derivatives in gamma(i+2)
8924 call transpose2(AEA(1,1,1),auxmatd(1,1))
8925 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8926 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8927 call transpose2(AEAderg(1,1,2),atempd(1,1))
8928 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8929 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8931 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8932 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8933 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8939 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8940 C Derivatives in gamma(i+3)
8942 call transpose2(AEA(1,1,1),auxmatd(1,1))
8943 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8944 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8945 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8947 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8948 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8949 s2d = scalar2(b1(1,itk),vtemp1d(1))
8951 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8952 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8954 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8956 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8957 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8958 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8966 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8967 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8969 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8970 & -0.5d0*ekont*(s2d+s12d)
8972 C Derivatives in gamma(i+4)
8973 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8974 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8975 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8977 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8978 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8979 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8987 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8989 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8991 C Derivatives in gamma(i+5)
8993 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8994 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8995 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8997 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8998 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8999 s2d = scalar2(b1(1,itk),vtemp1d(1))
9001 call transpose2(AEA(1,1,2),atempd(1,1))
9002 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9003 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9005 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9006 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9008 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9009 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9010 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9018 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9019 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9021 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9022 & -0.5d0*ekont*(s2d+s12d)
9024 C Cartesian derivatives
9029 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9030 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9031 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9033 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9034 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9036 s2d = scalar2(b1(1,itk),vtemp1d(1))
9038 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9039 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9040 s8d = -(atempd(1,1)+atempd(2,2))*
9041 & scalar2(cc(1,1,itl),vtemp2(1))
9043 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9045 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9046 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9053 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9056 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9060 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9061 & - 0.5d0*(s8d+s12d)
9063 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9072 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9074 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9075 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9076 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9077 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9078 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9080 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9081 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9082 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9086 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9087 cd & 16*eel_turn6_num
9089 if (j.lt.nres-1) then
9096 if (l.lt.nres-1) then
9104 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9105 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9106 cgrad ghalf=0.5d0*ggg1(ll)
9108 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9109 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9110 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9111 & +ekont*derx_turn(ll,2,1)
9112 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9113 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9114 & +ekont*derx_turn(ll,4,1)
9115 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9116 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9117 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9118 cgrad ghalf=0.5d0*ggg2(ll)
9120 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9121 & +ekont*derx_turn(ll,2,2)
9122 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9123 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9124 & +ekont*derx_turn(ll,4,2)
9125 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9126 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9127 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9132 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9137 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9143 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9148 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9152 cd write (2,*) iii,g_corr6_loc(iii)
9154 eello_turn6=ekont*eel_turn6
9155 cd write (2,*) 'ekont',ekont
9156 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9160 C-----------------------------------------------------------------------------
9161 double precision function scalar(u,v)
9162 !DIR$ INLINEALWAYS scalar
9164 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9167 double precision u(3),v(3)
9168 cd double precision sc
9176 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9179 crc-------------------------------------------------
9180 SUBROUTINE MATVEC2(A1,V1,V2)
9181 !DIR$ INLINEALWAYS MATVEC2
9183 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9185 implicit real*8 (a-h,o-z)
9186 include 'DIMENSIONS'
9187 DIMENSION A1(2,2),V1(2),V2(2)
9191 c 3 VI=VI+A1(I,K)*V1(K)
9195 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9196 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9201 C---------------------------------------
9202 SUBROUTINE MATMAT2(A1,A2,A3)
9204 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9206 implicit real*8 (a-h,o-z)
9207 include 'DIMENSIONS'
9208 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9209 c DIMENSION AI3(2,2)
9213 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9219 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9220 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9221 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9222 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9230 c-------------------------------------------------------------------------
9231 double precision function scalar2(u,v)
9232 !DIR$ INLINEALWAYS scalar2
9234 double precision u(2),v(2)
9237 scalar2=u(1)*v(1)+u(2)*v(2)
9241 C-----------------------------------------------------------------------------
9243 subroutine transpose2(a,at)
9244 !DIR$ INLINEALWAYS transpose2
9246 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9249 double precision a(2,2),at(2,2)
9256 c--------------------------------------------------------------------------
9257 subroutine transpose(n,a,at)
9260 double precision a(n,n),at(n,n)
9268 C---------------------------------------------------------------------------
9269 subroutine prodmat3(a1,a2,kk,transp,prod)
9270 !DIR$ INLINEALWAYS prodmat3
9272 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9276 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9278 crc double precision auxmat(2,2),prod_(2,2)
9281 crc call transpose2(kk(1,1),auxmat(1,1))
9282 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9283 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9285 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9286 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9287 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9288 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9289 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9290 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9291 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9292 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9295 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9296 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9298 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9299 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9300 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9301 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9302 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9303 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9304 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9305 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9308 c call transpose2(a2(1,1),a2t(1,1))
9311 crc print *,((prod_(i,j),i=1,2),j=1,2)
9312 crc print *,((prod(i,j),i=1,2),j=1,2)