1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
37 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
38 if (fg_rank.eq.0) then
39 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
40 c print *,"Processor",myrank," BROADCAST iorder"
41 C FG master sets up the WEIGHTS_ array which will be broadcast to the
42 C FG slaves as WEIGHTS array.
63 C FG Master broadcasts the WEIGHTS_ array
64 call MPI_Bcast(weights_(1),n_ene,
65 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
67 C FG slaves receive the WEIGHTS array
68 call MPI_Bcast(weights(1),n_ene,
69 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
91 time_Bcast=time_Bcast+MPI_Wtime()-time00
92 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
93 c call chainbuild_cart
95 c write(iout,*) 'Processor',myrank,' calling etotal ipot=',ipot
96 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
98 c if (modecalc.eq.12.or.modecalc.eq.14) then
99 c call int_from_cart1(.false.)
116 C Compute the side-chain and electrostatic interaction energy
118 goto (101,102,103,104,105,106) ipot
119 C Lennard-Jones potential.
120 101 call elj(evdw,evdw_p,evdw_m)
121 cd print '(a)','Exit ELJ'
123 C Lennard-Jones-Kihara potential (shifted).
124 102 call eljk(evdw,evdw_p,evdw_m)
126 C Berne-Pechukas potential (dilated LJ, angular dependence).
127 103 call ebp(evdw,evdw_p,evdw_m)
129 C Gay-Berne potential (shifted LJ, angular dependence).
130 104 call egb(evdw,evdw_p,evdw_m)
132 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
133 105 call egbv(evdw,evdw_p,evdw_m)
135 C Soft-sphere potential
136 106 call e_softsphere(evdw)
138 C Calculate electrostatic (H-bonding) energy of the main chain.
142 C BARTEK for dfa test!
143 if (wdfa_dist.gt.0) then
148 c print*, 'edfad is finished!', edfadis
149 if (wdfa_tor.gt.0) then
154 c print*, 'edfat is finished!', edfator
155 if (wdfa_nei.gt.0) then
160 c print*, 'edfan is finished!', edfanei
161 if (wdfa_beta.gt.0) then
167 c print*, 'edfab is finished!', edfabet
169 cmc Sep-06: egb takes care of dynamic ss bonds too
171 c if (dyn_ss) call dyn_set_nss
173 c print *,"Processor",myrank," computed USCSC"
184 time_vec=time_vec+MPI_Wtime()-time01
186 time_vec=time_vec+tcpu()-time01
189 c print *,"Processor",myrank," left VEC_AND_DERIV"
192 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
193 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
194 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
195 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
197 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
198 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
199 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
200 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
202 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
211 c write (iout,*) "Soft-spheer ELEC potential"
212 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
215 c print *,"Processor",myrank," computed UELEC"
217 C Calculate excluded-volume interaction energy between peptide groups
222 call escp(evdw2,evdw2_14)
228 c write (iout,*) "Soft-sphere SCP potential"
229 call escp_soft_sphere(evdw2,evdw2_14)
232 c Calculate the bond-stretching energy
236 C Calculate the disulfide-bridge and other energy and the contributions
237 C from other distance constraints.
238 cd print *,'Calling EHPB'
240 cd print *,'EHPB exitted succesfully.'
242 C Calculate the virtual-bond-angle energy.
244 if (wang.gt.0d0) then
249 c print *,"Processor",myrank," computed UB"
251 C Calculate the SC local energy.
254 c print *,"Processor",myrank," computed USC"
256 C Calculate the virtual-bond torsional energy.
258 cd print *,'nterm=',nterm
260 call etor(etors,edihcnstr)
266 if (constr_homology.ge.1.and.waga_homology(iset).ne.0d0) then
267 call e_modeller(ehomology_constr)
268 c print *,'iset=',iset,'me=',me,ehomology_constr,
269 c & 'Processor',fg_rank,' CG group',kolor,
270 c & ' absolute rank',MyRank
272 ehomology_constr=0.0d0
276 c write(iout,*) ehomology_constr
277 c print *,"Processor",myrank," computed Utor"
279 C 6/23/01 Calculate double-torsional energy
281 if (wtor_d.gt.0) then
286 c print *,"Processor",myrank," computed Utord"
288 C 21/5/07 Calculate local sicdechain correlation energy
290 if (wsccor.gt.0.0d0) then
291 call eback_sc_corr(esccor)
295 c print *,"Processor",myrank," computed Usccorr"
297 C 12/1/95 Multi-body terms
301 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
302 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
303 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
304 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
305 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
312 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
313 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
314 cd write (iout,*) "multibody_hb ecorr",ecorr
316 c print *,"Processor",myrank," computed Ucorr"
318 C If performing constraint dynamics, call the constraint energy
319 C after the equilibration time
320 if(usampl.and.totT.gt.eq_time) then
321 c write (iout,*) "CALL TO ECONSTR_BACK"
330 time_enecalc=time_enecalc+MPI_Wtime()-time00
332 time_enecalc=time_enecalc+tcpu()-time00
335 c print *,"Processor",myrank," computed Uconstr"
348 energia(2)=evdw2-evdw2_14
365 energia(8)=eello_turn3
366 energia(9)=eello_turn4
373 energia(19)=edihcnstr
375 energia(20)=Uconst+Uconst_back
379 energia(24)=ehomology_constr
384 c print *," Processor",myrank," calls SUM_ENERGY"
385 call sum_energy(energia,.true.)
386 if (dyn_ss) call dyn_set_nss
387 c print *," Processor",myrank," left SUM_ENERGY"
390 time_sumene=time_sumene+MPI_Wtime()-time00
392 time_sumene=time_sumene+tcpu()-time00
397 c-------------------------------------------------------------------------------
398 subroutine sum_energy(energia,reduce)
399 implicit real*8 (a-h,o-z)
404 cMS$ATTRIBUTES C :: proc_proc
410 include 'COMMON.SETUP'
411 include 'COMMON.IOUNITS'
412 double precision energia(0:n_ene),enebuff(0:n_ene+1)
413 include 'COMMON.FFIELD'
414 include 'COMMON.DERIV'
415 include 'COMMON.INTERACT'
416 include 'COMMON.SBRIDGE'
417 include 'COMMON.CHAIN'
419 include 'COMMON.CONTROL'
420 include 'COMMON.TIME1'
423 if (nfgtasks.gt.1 .and. reduce) then
425 write (iout,*) "energies before REDUCE"
426 call enerprint(energia)
430 enebuff(i)=energia(i)
433 call MPI_Barrier(FG_COMM,IERR)
434 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
436 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
437 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
439 write (iout,*) "energies after REDUCE"
440 call enerprint(energia)
443 time_Reduce=time_Reduce+MPI_Wtime()-time00
445 if (fg_rank.eq.0) then
448 evdw=energia(22)+wsct*energia(23)
453 evdw2=energia(2)+energia(18)
469 eello_turn3=energia(8)
470 eello_turn4=energia(9)
477 edihcnstr=energia(19)
481 ehomology_constr=energia(24)
487 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
488 & +wang*ebe+wtor*etors+wscloc*escloc
489 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
490 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
491 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
492 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
493 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
496 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
497 & +wang*ebe+wtor*etors+wscloc*escloc
498 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
499 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
500 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
501 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
502 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
509 if (isnan(etot).ne.0) energia(0)=1.0d+99
511 if (isnan(etot)) energia(0)=1.0d+99
516 idumm=proc_proc(etot,i)
518 call proc_proc(etot,i)
520 if(i.eq.1)energia(0)=1.0d+99
527 c-------------------------------------------------------------------------------
528 subroutine sum_gradient
529 implicit real*8 (a-h,o-z)
534 cMS$ATTRIBUTES C :: proc_proc
540 double precision gradbufc(3,maxres),gradbufx(3,maxres),
541 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
542 include 'COMMON.SETUP'
543 include 'COMMON.IOUNITS'
544 include 'COMMON.FFIELD'
545 include 'COMMON.DERIV'
546 include 'COMMON.INTERACT'
547 include 'COMMON.SBRIDGE'
548 include 'COMMON.CHAIN'
550 include 'COMMON.CONTROL'
551 include 'COMMON.TIME1'
552 include 'COMMON.MAXGRAD'
553 include 'COMMON.SCCOR'
563 write (iout,*) "sum_gradient gvdwc, gvdwx"
565 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
566 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
567 & (gvdwcT(j,i),j=1,3)
572 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
573 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
574 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
577 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
578 C in virtual-bond-vector coordinates
581 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
583 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
584 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
586 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
588 c write (iout,'(i5,3f10.5,2x,f10.5)')
589 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
591 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
593 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
594 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
603 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
604 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
605 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
606 & wel_loc*gel_loc_long(j,i)+
607 & wcorr*gradcorr_long(j,i)+
608 & wcorr5*gradcorr5_long(j,i)+
609 & wcorr6*gradcorr6_long(j,i)+
610 & wturn6*gcorr6_turn_long(j,i)+
611 & wstrain*ghpbc(j,i)+
612 & wdfa_dist*gdfad(j,i)+
613 & wdfa_tor*gdfat(j,i)+
614 & wdfa_nei*gdfan(j,i)+
615 & wdfa_beta*gdfab(j,i)
621 gradbufc(j,i)=wsc*gvdwc(j,i)+
622 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
623 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
624 & wel_loc*gel_loc_long(j,i)+
625 & wcorr*gradcorr_long(j,i)+
626 & wcorr5*gradcorr5_long(j,i)+
627 & wcorr6*gradcorr6_long(j,i)+
628 & wturn6*gcorr6_turn_long(j,i)+
629 & wstrain*ghpbc(j,i)+
630 & wdfa_dist*gdfad(j,i)+
631 & wdfa_tor*gdfat(j,i)+
632 & wdfa_nei*gdfan(j,i)+
633 & wdfa_beta*gdfab(j,i)
640 gradbufc(j,i)=wsc*gvdwc(j,i)+
641 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
642 & welec*gelc_long(j,i)+
644 & wel_loc*gel_loc_long(j,i)+
645 & wcorr*gradcorr_long(j,i)+
646 & wcorr5*gradcorr5_long(j,i)+
647 & wcorr6*gradcorr6_long(j,i)+
648 & wturn6*gcorr6_turn_long(j,i)+
649 & wstrain*ghpbc(j,i)+
650 & wdfa_dist*gdfad(j,i)+
651 & wdfa_tor*gdfat(j,i)+
652 & wdfa_nei*gdfan(j,i)+
653 & wdfa_beta*gdfab(j,i)
658 if (nfgtasks.gt.1) then
661 write (iout,*) "gradbufc before allreduce"
663 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
669 gradbufc_sum(j,i)=gradbufc(j,i)
672 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
673 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
674 c time_reduce=time_reduce+MPI_Wtime()-time00
676 c write (iout,*) "gradbufc_sum after allreduce"
678 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
683 c time_allreduce=time_allreduce+MPI_Wtime()-time00
691 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
692 write (iout,*) (i," jgrad_start",jgrad_start(i),
693 & " jgrad_end ",jgrad_end(i),
694 & i=igrad_start,igrad_end)
697 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
698 c do not parallelize this part.
700 c do i=igrad_start,igrad_end
701 c do j=jgrad_start(i),jgrad_end(i)
703 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
708 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
712 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
716 write (iout,*) "gradbufc after summing"
718 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
725 write (iout,*) "gradbufc"
727 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
733 gradbufc_sum(j,i)=gradbufc(j,i)
738 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
742 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
747 c gradbufc(k,i)=0.0d0
751 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
756 write (iout,*) "gradbufc after summing"
758 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
766 gradbufc(k,nres)=0.0d0
771 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
772 & wel_loc*gel_loc(j,i)+
773 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
774 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
775 & wel_loc*gel_loc_long(j,i)+
776 & wcorr*gradcorr_long(j,i)+
777 & wcorr5*gradcorr5_long(j,i)+
778 & wcorr6*gradcorr6_long(j,i)+
779 & wturn6*gcorr6_turn_long(j,i))+
781 & wcorr*gradcorr(j,i)+
782 & wturn3*gcorr3_turn(j,i)+
783 & wturn4*gcorr4_turn(j,i)+
784 & wcorr5*gradcorr5(j,i)+
785 & wcorr6*gradcorr6(j,i)+
786 & wturn6*gcorr6_turn(j,i)+
787 & wsccor*gsccorc(j,i)
788 & +wscloc*gscloc(j,i)
790 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
791 & wel_loc*gel_loc(j,i)+
792 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
793 & welec*gelc_long(j,i)+
794 & wel_loc*gel_loc_long(j,i)+
795 & wcorr*gcorr_long(j,i)+
796 & wcorr5*gradcorr5_long(j,i)+
797 & wcorr6*gradcorr6_long(j,i)+
798 & wturn6*gcorr6_turn_long(j,i))+
800 & wcorr*gradcorr(j,i)+
801 & wturn3*gcorr3_turn(j,i)+
802 & wturn4*gcorr4_turn(j,i)+
803 & wcorr5*gradcorr5(j,i)+
804 & wcorr6*gradcorr6(j,i)+
805 & wturn6*gcorr6_turn(j,i)+
806 & wsccor*gsccorc(j,i)
807 & +wscloc*gscloc(j,i)
810 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
811 & wscp*gradx_scp(j,i)+
813 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
814 & wsccor*gsccorx(j,i)
815 & +wscloc*gsclocx(j,i)
817 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
819 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
820 & wsccor*gsccorx(j,i)
821 & +wscloc*gsclocx(j,i)
825 if (constr_homology.gt.0.and.waga_homology(iset).ne.0d0) then
828 gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
829 gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
834 write (iout,*) "gloc before adding corr"
836 write (iout,*) i,gloc(i,icg)
840 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
841 & +wcorr5*g_corr5_loc(i)
842 & +wcorr6*g_corr6_loc(i)
843 & +wturn4*gel_loc_turn4(i)
844 & +wturn3*gel_loc_turn3(i)
845 & +wturn6*gel_loc_turn6(i)
846 & +wel_loc*gel_loc_loc(i)
849 write (iout,*) "gloc after adding corr"
851 write (iout,*) i,gloc(i,icg)
855 if (nfgtasks.gt.1) then
858 gradbufc(j,i)=gradc(j,i,icg)
859 gradbufx(j,i)=gradx(j,i,icg)
863 glocbuf(i)=gloc(i,icg)
866 write (iout,*) "gloc_sc before reduce"
869 write (iout,*) i,j,gloc_sc(j,i,icg)
875 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
879 call MPI_Barrier(FG_COMM,IERR)
880 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
882 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
883 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
884 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
885 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
886 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
887 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
888 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
889 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
890 time_reduce=time_reduce+MPI_Wtime()-time00
892 write (iout,*) "gloc_sc after reduce"
895 write (iout,*) i,j,gloc_sc(j,i,icg)
900 write (iout,*) "gloc after reduce"
902 write (iout,*) i,gloc(i,icg)
907 if (gnorm_check) then
909 c Compute the maximum elements of the gradient
919 gcorr3_turn_max=0.0d0
920 gcorr4_turn_max=0.0d0
923 gcorr6_turn_max=0.0d0
933 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
934 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
936 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
937 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
939 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
940 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
941 & gvdwc_scp_max=gvdwc_scp_norm
942 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
943 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
944 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
945 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
946 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
947 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
948 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
949 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
950 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
951 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
952 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
953 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
954 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
956 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
957 & gcorr3_turn_max=gcorr3_turn_norm
958 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
960 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
961 & gcorr4_turn_max=gcorr4_turn_norm
962 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
963 if (gradcorr5_norm.gt.gradcorr5_max)
964 & gradcorr5_max=gradcorr5_norm
965 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
966 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
967 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
969 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
970 & gcorr6_turn_max=gcorr6_turn_norm
971 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
972 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
973 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
974 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
975 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
976 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
978 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
979 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
981 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
982 if (gradx_scp_norm.gt.gradx_scp_max)
983 & gradx_scp_max=gradx_scp_norm
984 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
985 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
986 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
987 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
988 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
989 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
990 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
991 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
995 open(istat,file=statname,position="append")
997 open(istat,file=statname,access="append")
999 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
1000 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
1001 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
1002 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
1003 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
1004 & gsccorx_max,gsclocx_max
1006 if (gvdwc_max.gt.1.0d4) then
1007 write (iout,*) "gvdwc gvdwx gradb gradbx"
1009 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
1010 & gradb(j,i),gradbx(j,i),j=1,3)
1012 call pdbout(0.0d0,'cipiszcze',iout)
1018 write (iout,*) "gradc gradx gloc"
1020 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1021 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1026 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1028 time_sumgradient=time_sumgradient+tcpu()-time01
1033 c-------------------------------------------------------------------------------
1034 subroutine rescale_weights(t_bath)
1035 implicit real*8 (a-h,o-z)
1036 include 'DIMENSIONS'
1037 include 'COMMON.IOUNITS'
1038 include 'COMMON.FFIELD'
1039 include 'COMMON.SBRIDGE'
1040 double precision kfac /2.4d0/
1041 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1043 c facT=2*temp0/(t_bath+temp0)
1044 if (rescale_mode.eq.0) then
1050 else if (rescale_mode.eq.1) then
1051 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1052 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1053 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1054 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1055 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1056 else if (rescale_mode.eq.2) then
1062 facT=licznik/dlog(dexp(x)+dexp(-x))
1063 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1064 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1065 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1066 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1068 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1069 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1071 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1075 welec=weights(3)*fact
1076 wcorr=weights(4)*fact3
1077 wcorr5=weights(5)*fact4
1078 wcorr6=weights(6)*fact5
1079 wel_loc=weights(7)*fact2
1080 wturn3=weights(8)*fact2
1081 wturn4=weights(9)*fact3
1082 wturn6=weights(10)*fact5
1083 wtor=weights(13)*fact
1084 wtor_d=weights(14)*fact2
1085 wsccor=weights(21)*fact
1088 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1092 C------------------------------------------------------------------------
1093 subroutine enerprint(energia)
1094 implicit real*8 (a-h,o-z)
1095 include 'DIMENSIONS'
1096 include 'COMMON.IOUNITS'
1097 include 'COMMON.FFIELD'
1098 include 'COMMON.SBRIDGE'
1100 double precision energia(0:n_ene)
1103 evdw=energia(22)+wsct*energia(23)
1109 evdw2=energia(2)+energia(18)
1121 eello_turn3=energia(8)
1122 eello_turn4=energia(9)
1123 eello_turn6=energia(10)
1129 edihcnstr=energia(19)
1133 ehomology_constr=energia(24)
1135 edfadis = energia(25)
1136 edfator = energia(26)
1137 edfanei = energia(27)
1138 edfabet = energia(28)
1141 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1142 & estr,wbond,ebe,wang,
1143 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1145 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1146 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1147 & edihcnstr,ehomology_constr, ebr*nss,
1148 & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
1149 & edfabet,wdfa_beta,etot
1150 10 format (/'Virtual-chain energies:'//
1151 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1152 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1153 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1154 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1155 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1156 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1157 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1158 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1159 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1160 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1161 & ' (SS bridges & dist. cnstr.)'/
1162 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1163 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1164 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1165 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1166 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1167 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1168 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1169 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1170 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1171 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1172 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1173 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1174 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
1175 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
1176 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
1177 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
1178 & 'ETOT= ',1pE16.6,' (total)')
1180 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1181 & estr,wbond,ebe,wang,
1182 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1184 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1185 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1186 & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator,
1187 & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta,
1189 10 format (/'Virtual-chain energies:'//
1190 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1191 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1192 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1193 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1194 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1195 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1196 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1197 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1198 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1199 & ' (SS bridges & dist. cnstr.)'/
1200 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1201 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1202 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1203 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1204 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1205 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1206 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1207 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1208 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1209 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1210 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1211 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1212 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
1213 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
1214 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
1215 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
1216 & 'ETOT= ',1pE16.6,' (total)')
1220 C-----------------------------------------------------------------------
1221 subroutine elj(evdw,evdw_p,evdw_m)
1223 C This subroutine calculates the interaction energy of nonbonded side chains
1224 C assuming the LJ potential of interaction.
1226 implicit real*8 (a-h,o-z)
1227 include 'DIMENSIONS'
1228 parameter (accur=1.0d-10)
1229 include 'COMMON.GEO'
1230 include 'COMMON.VAR'
1231 include 'COMMON.LOCAL'
1232 include 'COMMON.CHAIN'
1233 include 'COMMON.DERIV'
1234 include 'COMMON.INTERACT'
1235 include 'COMMON.TORSION'
1236 include 'COMMON.SBRIDGE'
1237 include 'COMMON.NAMES'
1238 include 'COMMON.IOUNITS'
1239 include 'COMMON.CONTACTS'
1241 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1243 do i=iatsc_s,iatsc_e
1252 C Calculate SC interaction energy.
1254 do iint=1,nint_gr(i)
1255 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1256 cd & 'iend=',iend(i,iint)
1257 do j=istart(i,iint),iend(i,iint)
1262 C Change 12/1/95 to calculate four-body interactions
1263 rij=xj*xj+yj*yj+zj*zj
1265 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1266 eps0ij=eps(itypi,itypj)
1268 e1=fac*fac*aa(itypi,itypj)
1269 e2=fac*bb(itypi,itypj)
1271 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1272 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1273 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1274 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1275 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1276 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1278 if (bb(itypi,itypj).gt.0) then
1279 evdw_p=evdw_p+evdwij
1281 evdw_m=evdw_m+evdwij
1287 C Calculate the components of the gradient in DC and X
1289 fac=-rrij*(e1+evdwij)
1294 if (bb(itypi,itypj).gt.0.0d0) then
1296 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1297 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1298 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1299 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1303 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1304 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1305 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1306 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1311 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1312 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1313 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1314 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1319 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1323 C 12/1/95, revised on 5/20/97
1325 C Calculate the contact function. The ith column of the array JCONT will
1326 C contain the numbers of atoms that make contacts with the atom I (of numbers
1327 C greater than I). The arrays FACONT and GACONT will contain the values of
1328 C the contact function and its derivative.
1330 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1331 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1332 C Uncomment next line, if the correlation interactions are contact function only
1333 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1335 sigij=sigma(itypi,itypj)
1336 r0ij=rs0(itypi,itypj)
1338 C Check whether the SC's are not too far to make a contact.
1341 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1342 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1344 if (fcont.gt.0.0D0) then
1345 C If the SC-SC distance if close to sigma, apply spline.
1346 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1347 cAdam & fcont1,fprimcont1)
1348 cAdam fcont1=1.0d0-fcont1
1349 cAdam if (fcont1.gt.0.0d0) then
1350 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1351 cAdam fcont=fcont*fcont1
1353 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1354 cga eps0ij=1.0d0/dsqrt(eps0ij)
1356 cga gg(k)=gg(k)*eps0ij
1358 cga eps0ij=-evdwij*eps0ij
1359 C Uncomment for AL's type of SC correlation interactions.
1360 cadam eps0ij=-evdwij
1361 num_conti=num_conti+1
1362 jcont(num_conti,i)=j
1363 facont(num_conti,i)=fcont*eps0ij
1364 fprimcont=eps0ij*fprimcont/rij
1366 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1367 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1368 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1369 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1370 gacont(1,num_conti,i)=-fprimcont*xj
1371 gacont(2,num_conti,i)=-fprimcont*yj
1372 gacont(3,num_conti,i)=-fprimcont*zj
1373 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1374 cd write (iout,'(2i3,3f10.5)')
1375 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1381 num_cont(i)=num_conti
1385 gvdwc(j,i)=expon*gvdwc(j,i)
1386 gvdwx(j,i)=expon*gvdwx(j,i)
1389 C******************************************************************************
1393 C To save time, the factor of EXPON has been extracted from ALL components
1394 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1397 C******************************************************************************
1400 C-----------------------------------------------------------------------------
1401 subroutine eljk(evdw,evdw_p,evdw_m)
1403 C This subroutine calculates the interaction energy of nonbonded side chains
1404 C assuming the LJK potential of interaction.
1406 implicit real*8 (a-h,o-z)
1407 include 'DIMENSIONS'
1408 include 'COMMON.GEO'
1409 include 'COMMON.VAR'
1410 include 'COMMON.LOCAL'
1411 include 'COMMON.CHAIN'
1412 include 'COMMON.DERIV'
1413 include 'COMMON.INTERACT'
1414 include 'COMMON.IOUNITS'
1415 include 'COMMON.NAMES'
1418 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1420 do i=iatsc_s,iatsc_e
1427 C Calculate SC interaction energy.
1429 do iint=1,nint_gr(i)
1430 do j=istart(i,iint),iend(i,iint)
1435 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1436 fac_augm=rrij**expon
1437 e_augm=augm(itypi,itypj)*fac_augm
1438 r_inv_ij=dsqrt(rrij)
1440 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1441 fac=r_shift_inv**expon
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1445 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1446 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1447 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1448 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1449 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1450 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1451 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1453 if (bb(itypi,itypj).gt.0) then
1454 evdw_p=evdw_p+evdwij
1456 evdw_m=evdw_m+evdwij
1462 C Calculate the components of the gradient in DC and X
1464 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1469 if (bb(itypi,itypj).gt.0.0d0) then
1471 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1472 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1473 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1474 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1478 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1479 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1480 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1481 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1486 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1487 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1488 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1489 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1494 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1502 gvdwc(j,i)=expon*gvdwc(j,i)
1503 gvdwx(j,i)=expon*gvdwx(j,i)
1508 C-----------------------------------------------------------------------------
1509 subroutine ebp(evdw,evdw_p,evdw_m)
1511 C This subroutine calculates the interaction energy of nonbonded side chains
1512 C assuming the Berne-Pechukas potential of interaction.
1514 implicit real*8 (a-h,o-z)
1515 include 'DIMENSIONS'
1516 include 'COMMON.GEO'
1517 include 'COMMON.VAR'
1518 include 'COMMON.LOCAL'
1519 include 'COMMON.CHAIN'
1520 include 'COMMON.DERIV'
1521 include 'COMMON.NAMES'
1522 include 'COMMON.INTERACT'
1523 include 'COMMON.IOUNITS'
1524 include 'COMMON.CALC'
1525 common /srutu/ icall
1526 c double precision rrsave(maxdim)
1529 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1531 c if (icall.eq.0) then
1537 do i=iatsc_s,iatsc_e
1543 dxi=dc_norm(1,nres+i)
1544 dyi=dc_norm(2,nres+i)
1545 dzi=dc_norm(3,nres+i)
1546 c dsci_inv=dsc_inv(itypi)
1547 dsci_inv=vbld_inv(i+nres)
1549 C Calculate SC interaction energy.
1551 do iint=1,nint_gr(i)
1552 do j=istart(i,iint),iend(i,iint)
1555 c dscj_inv=dsc_inv(itypj)
1556 dscj_inv=vbld_inv(j+nres)
1557 chi1=chi(itypi,itypj)
1558 chi2=chi(itypj,itypi)
1565 alf12=0.5D0*(alf1+alf2)
1566 C For diagnostics only!!!
1579 dxj=dc_norm(1,nres+j)
1580 dyj=dc_norm(2,nres+j)
1581 dzj=dc_norm(3,nres+j)
1582 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1583 cd if (icall.eq.0) then
1589 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1591 C Calculate whole angle-dependent part of epsilon and contributions
1592 C to its derivatives
1593 fac=(rrij*sigsq)**expon2
1594 e1=fac*fac*aa(itypi,itypj)
1595 e2=fac*bb(itypi,itypj)
1596 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1597 eps2der=evdwij*eps3rt
1598 eps3der=evdwij*eps2rt
1599 evdwij=evdwij*eps2rt*eps3rt
1601 if (bb(itypi,itypj).gt.0) then
1602 evdw_p=evdw_p+evdwij
1604 evdw_m=evdw_m+evdwij
1610 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1611 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1612 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1613 cd & restyp(itypi),i,restyp(itypj),j,
1614 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1615 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1616 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1619 C Calculate gradient components.
1620 e1=e1*eps1*eps2rt**2*eps3rt**2
1621 fac=-expon*(e1+evdwij)
1624 C Calculate radial part of the gradient
1628 C Calculate the angular part of the gradient and sum add the contributions
1629 C to the appropriate components of the Cartesian gradient.
1631 if (bb(itypi,itypj).gt.0) then
1645 C-----------------------------------------------------------------------------
1646 subroutine egb(evdw,evdw_p,evdw_m)
1648 C This subroutine calculates the interaction energy of nonbonded side chains
1649 C assuming the Gay-Berne potential of interaction.
1651 implicit real*8 (a-h,o-z)
1652 include 'DIMENSIONS'
1653 include 'COMMON.GEO'
1654 include 'COMMON.VAR'
1655 include 'COMMON.LOCAL'
1656 include 'COMMON.CHAIN'
1657 include 'COMMON.DERIV'
1658 include 'COMMON.NAMES'
1659 include 'COMMON.INTERACT'
1660 include 'COMMON.IOUNITS'
1661 include 'COMMON.CALC'
1662 include 'COMMON.CONTROL'
1663 include 'COMMON.SBRIDGE'
1666 ccccc energy_dec=.false.
1667 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1672 c if (icall.eq.0) lprn=.false.
1674 do i=iatsc_s,iatsc_e
1680 dxi=dc_norm(1,nres+i)
1681 dyi=dc_norm(2,nres+i)
1682 dzi=dc_norm(3,nres+i)
1683 c dsci_inv=dsc_inv(itypi)
1684 dsci_inv=vbld_inv(i+nres)
1685 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1686 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1688 C Calculate SC interaction energy.
1690 do iint=1,nint_gr(i)
1691 do j=istart(i,iint),iend(i,iint)
1692 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1693 call dyn_ssbond_ene(i,j,evdwij)
1695 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1696 & 'evdw',i,j,evdwij,' ss'
1700 c dscj_inv=dsc_inv(itypj)
1701 dscj_inv=vbld_inv(j+nres)
1702 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1703 c & 1.0d0/vbld(j+nres)
1704 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1705 sig0ij=sigma(itypi,itypj)
1706 chi1=chi(itypi,itypj)
1707 chi2=chi(itypj,itypi)
1714 alf12=0.5D0*(alf1+alf2)
1715 C For diagnostics only!!!
1728 dxj=dc_norm(1,nres+j)
1729 dyj=dc_norm(2,nres+j)
1730 dzj=dc_norm(3,nres+j)
1731 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1732 c write (iout,*) "j",j," dc_norm",
1733 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1734 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1736 C Calculate angle-dependent terms of energy and contributions to their
1740 sig=sig0ij*dsqrt(sigsq)
1741 rij_shift=1.0D0/rij-sig+sig0ij
1742 c for diagnostics; uncomment
1743 c rij_shift=1.2*sig0ij
1744 C I hate to put IF's in the loops, but here don't have another choice!!!!
1745 if (rij_shift.le.0.0D0) then
1747 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1748 cd & restyp(itypi),i,restyp(itypj),j,
1749 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1753 c---------------------------------------------------------------
1754 rij_shift=1.0D0/rij_shift
1755 fac=rij_shift**expon
1756 e1=fac*fac*aa(itypi,itypj)
1757 e2=fac*bb(itypi,itypj)
1758 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1759 eps2der=evdwij*eps3rt
1760 eps3der=evdwij*eps2rt
1761 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1762 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1763 evdwij=evdwij*eps2rt*eps3rt
1765 if (bb(itypi,itypj).gt.0) then
1766 evdw_p=evdw_p+evdwij
1768 evdw_m=evdw_m+evdwij
1774 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1775 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1776 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1777 & restyp(itypi),i,restyp(itypj),j,
1778 & epsi,sigm,chi1,chi2,chip1,chip2,
1779 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1780 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1784 if (energy_dec) then
1785 write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
1788 C Calculate gradient components.
1789 e1=e1*eps1*eps2rt**2*eps3rt**2
1790 fac=-expon*(e1+evdwij)*rij_shift
1794 C Calculate the radial part of the gradient
1798 C Calculate angular part of the gradient.
1800 if (bb(itypi,itypj).gt.0) then
1812 c write (iout,*) "Number of loop steps in EGB:",ind
1813 cccc energy_dec=.false.
1816 C-----------------------------------------------------------------------------
1817 subroutine egbv(evdw,evdw_p,evdw_m)
1819 C This subroutine calculates the interaction energy of nonbonded side chains
1820 C assuming the Gay-Berne-Vorobjev potential of interaction.
1822 implicit real*8 (a-h,o-z)
1823 include 'DIMENSIONS'
1824 include 'COMMON.GEO'
1825 include 'COMMON.VAR'
1826 include 'COMMON.LOCAL'
1827 include 'COMMON.CHAIN'
1828 include 'COMMON.DERIV'
1829 include 'COMMON.NAMES'
1830 include 'COMMON.INTERACT'
1831 include 'COMMON.IOUNITS'
1832 include 'COMMON.CALC'
1833 common /srutu/ icall
1836 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1839 c if (icall.eq.0) lprn=.true.
1841 do i=iatsc_s,iatsc_e
1847 dxi=dc_norm(1,nres+i)
1848 dyi=dc_norm(2,nres+i)
1849 dzi=dc_norm(3,nres+i)
1850 c dsci_inv=dsc_inv(itypi)
1851 dsci_inv=vbld_inv(i+nres)
1853 C Calculate SC interaction energy.
1855 do iint=1,nint_gr(i)
1856 do j=istart(i,iint),iend(i,iint)
1859 c dscj_inv=dsc_inv(itypj)
1860 dscj_inv=vbld_inv(j+nres)
1861 sig0ij=sigma(itypi,itypj)
1862 r0ij=r0(itypi,itypj)
1863 chi1=chi(itypi,itypj)
1864 chi2=chi(itypj,itypi)
1871 alf12=0.5D0*(alf1+alf2)
1872 C For diagnostics only!!!
1885 dxj=dc_norm(1,nres+j)
1886 dyj=dc_norm(2,nres+j)
1887 dzj=dc_norm(3,nres+j)
1888 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1890 C Calculate angle-dependent terms of energy and contributions to their
1894 sig=sig0ij*dsqrt(sigsq)
1895 rij_shift=1.0D0/rij-sig+r0ij
1896 C I hate to put IF's in the loops, but here don't have another choice!!!!
1897 if (rij_shift.le.0.0D0) then
1902 c---------------------------------------------------------------
1903 rij_shift=1.0D0/rij_shift
1904 fac=rij_shift**expon
1905 e1=fac*fac*aa(itypi,itypj)
1906 e2=fac*bb(itypi,itypj)
1907 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1908 eps2der=evdwij*eps3rt
1909 eps3der=evdwij*eps2rt
1910 fac_augm=rrij**expon
1911 e_augm=augm(itypi,itypj)*fac_augm
1912 evdwij=evdwij*eps2rt*eps3rt
1914 if (bb(itypi,itypj).gt.0) then
1915 evdw_p=evdw_p+evdwij+e_augm
1917 evdw_m=evdw_m+evdwij+e_augm
1920 evdw=evdw+evdwij+e_augm
1923 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1924 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1925 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1926 & restyp(itypi),i,restyp(itypj),j,
1927 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1928 & chi1,chi2,chip1,chip2,
1929 & eps1,eps2rt**2,eps3rt**2,
1930 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1933 C Calculate gradient components.
1934 e1=e1*eps1*eps2rt**2*eps3rt**2
1935 fac=-expon*(e1+evdwij)*rij_shift
1937 fac=rij*fac-2*expon*rrij*e_augm
1938 C Calculate the radial part of the gradient
1942 C Calculate angular part of the gradient.
1944 if (bb(itypi,itypj).gt.0) then
1956 C-----------------------------------------------------------------------------
1957 subroutine sc_angular
1958 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1959 C om12. Called by ebp, egb, and egbv.
1961 include 'COMMON.CALC'
1962 include 'COMMON.IOUNITS'
1966 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1967 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1968 om12=dxi*dxj+dyi*dyj+dzi*dzj
1970 C Calculate eps1(om12) and its derivative in om12
1971 faceps1=1.0D0-om12*chiom12
1972 faceps1_inv=1.0D0/faceps1
1973 eps1=dsqrt(faceps1_inv)
1974 C Following variable is eps1*deps1/dom12
1975 eps1_om12=faceps1_inv*chiom12
1980 c write (iout,*) "om12",om12," eps1",eps1
1981 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1986 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1987 sigsq=1.0D0-facsig*faceps1_inv
1988 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1989 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1990 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1996 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1997 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1999 C Calculate eps2 and its derivatives in om1, om2, and om12.
2002 chipom12=chip12*om12
2003 facp=1.0D0-om12*chipom12
2005 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2006 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2007 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2008 C Following variable is the square root of eps2
2009 eps2rt=1.0D0-facp1*facp_inv
2010 C Following three variables are the derivatives of the square root of eps
2011 C in om1, om2, and om12.
2012 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2013 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2014 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2015 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2016 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2017 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2018 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2019 c & " eps2rt_om12",eps2rt_om12
2020 C Calculate whole angle-dependent part of epsilon and contributions
2021 C to its derivatives
2025 C----------------------------------------------------------------------------
2026 subroutine sc_grad_T
2027 implicit real*8 (a-h,o-z)
2028 include 'DIMENSIONS'
2029 include 'COMMON.CHAIN'
2030 include 'COMMON.DERIV'
2031 include 'COMMON.CALC'
2032 include 'COMMON.IOUNITS'
2033 double precision dcosom1(3),dcosom2(3)
2034 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2035 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2036 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2037 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2041 c eom12=evdwij*eps1_om12
2043 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2044 c & " sigder",sigder
2045 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2046 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2048 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2049 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2052 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2054 c write (iout,*) "gg",(gg(k),k=1,3)
2056 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2057 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2058 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2059 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2060 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2061 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2062 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2063 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2064 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2065 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2068 C Calculate the components of the gradient in DC and X
2072 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2076 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2077 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2082 C----------------------------------------------------------------------------
2084 implicit real*8 (a-h,o-z)
2085 include 'DIMENSIONS'
2086 include 'COMMON.CHAIN'
2087 include 'COMMON.DERIV'
2088 include 'COMMON.CALC'
2089 include 'COMMON.IOUNITS'
2090 double precision dcosom1(3),dcosom2(3)
2091 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2092 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2093 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2094 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2098 c eom12=evdwij*eps1_om12
2100 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2101 c & " sigder",sigder
2102 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2103 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2105 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2106 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2109 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2111 c write (iout,*) "gg",(gg(k),k=1,3)
2113 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2114 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2115 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2116 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2117 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2118 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2119 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2120 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2121 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2122 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2125 C Calculate the components of the gradient in DC and X
2129 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2133 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2134 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2138 C-----------------------------------------------------------------------
2139 subroutine e_softsphere(evdw)
2141 C This subroutine calculates the interaction energy of nonbonded side chains
2142 C assuming the LJ potential of interaction.
2144 implicit real*8 (a-h,o-z)
2145 include 'DIMENSIONS'
2146 parameter (accur=1.0d-10)
2147 include 'COMMON.GEO'
2148 include 'COMMON.VAR'
2149 include 'COMMON.LOCAL'
2150 include 'COMMON.CHAIN'
2151 include 'COMMON.DERIV'
2152 include 'COMMON.INTERACT'
2153 include 'COMMON.TORSION'
2154 include 'COMMON.SBRIDGE'
2155 include 'COMMON.NAMES'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.CONTACTS'
2159 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2161 do i=iatsc_s,iatsc_e
2168 C Calculate SC interaction energy.
2170 do iint=1,nint_gr(i)
2171 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2172 cd & 'iend=',iend(i,iint)
2173 do j=istart(i,iint),iend(i,iint)
2178 rij=xj*xj+yj*yj+zj*zj
2179 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2180 r0ij=r0(itypi,itypj)
2182 c print *,i,j,r0ij,dsqrt(rij)
2183 if (rij.lt.r0ijsq) then
2184 evdwij=0.25d0*(rij-r0ijsq)**2
2192 C Calculate the components of the gradient in DC and X
2198 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2199 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2200 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2201 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2205 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2213 C--------------------------------------------------------------------------
2214 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2217 C Soft-sphere potential of p-p interaction
2219 implicit real*8 (a-h,o-z)
2220 include 'DIMENSIONS'
2221 include 'COMMON.CONTROL'
2222 include 'COMMON.IOUNITS'
2223 include 'COMMON.GEO'
2224 include 'COMMON.VAR'
2225 include 'COMMON.LOCAL'
2226 include 'COMMON.CHAIN'
2227 include 'COMMON.DERIV'
2228 include 'COMMON.INTERACT'
2229 include 'COMMON.CONTACTS'
2230 include 'COMMON.TORSION'
2231 include 'COMMON.VECTORS'
2232 include 'COMMON.FFIELD'
2234 cd write(iout,*) 'In EELEC_soft_sphere'
2241 do i=iatel_s,iatel_e
2245 xmedi=c(1,i)+0.5d0*dxi
2246 ymedi=c(2,i)+0.5d0*dyi
2247 zmedi=c(3,i)+0.5d0*dzi
2249 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2250 do j=ielstart(i),ielend(i)
2254 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2255 r0ij=rpp(iteli,itelj)
2260 xj=c(1,j)+0.5D0*dxj-xmedi
2261 yj=c(2,j)+0.5D0*dyj-ymedi
2262 zj=c(3,j)+0.5D0*dzj-zmedi
2263 rij=xj*xj+yj*yj+zj*zj
2264 if (rij.lt.r0ijsq) then
2265 evdw1ij=0.25d0*(rij-r0ijsq)**2
2273 C Calculate contributions to the Cartesian gradient.
2279 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2280 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2283 * Loop over residues i+1 thru j-1.
2287 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2292 cgrad do i=nnt,nct-1
2294 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2296 cgrad do j=i+1,nct-1
2298 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2304 c------------------------------------------------------------------------------
2305 subroutine vec_and_deriv
2306 implicit real*8 (a-h,o-z)
2307 include 'DIMENSIONS'
2311 include 'COMMON.IOUNITS'
2312 include 'COMMON.GEO'
2313 include 'COMMON.VAR'
2314 include 'COMMON.LOCAL'
2315 include 'COMMON.CHAIN'
2316 include 'COMMON.VECTORS'
2317 include 'COMMON.SETUP'
2318 include 'COMMON.TIME1'
2319 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2320 C Compute the local reference systems. For reference system (i), the
2321 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2322 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2324 do i=ivec_start,ivec_end
2328 if (i.eq.nres-1) then
2329 C Case of the last full residue
2330 C Compute the Z-axis
2331 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2332 costh=dcos(pi-theta(nres))
2333 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2337 C Compute the derivatives of uz
2339 uzder(2,1,1)=-dc_norm(3,i-1)
2340 uzder(3,1,1)= dc_norm(2,i-1)
2341 uzder(1,2,1)= dc_norm(3,i-1)
2343 uzder(3,2,1)=-dc_norm(1,i-1)
2344 uzder(1,3,1)=-dc_norm(2,i-1)
2345 uzder(2,3,1)= dc_norm(1,i-1)
2348 uzder(2,1,2)= dc_norm(3,i)
2349 uzder(3,1,2)=-dc_norm(2,i)
2350 uzder(1,2,2)=-dc_norm(3,i)
2352 uzder(3,2,2)= dc_norm(1,i)
2353 uzder(1,3,2)= dc_norm(2,i)
2354 uzder(2,3,2)=-dc_norm(1,i)
2356 C Compute the Y-axis
2359 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2361 C Compute the derivatives of uy
2364 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2365 & -dc_norm(k,i)*dc_norm(j,i-1)
2366 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2368 uyder(j,j,1)=uyder(j,j,1)-costh
2369 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2374 uygrad(l,k,j,i)=uyder(l,k,j)
2375 uzgrad(l,k,j,i)=uzder(l,k,j)
2379 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2380 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2381 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2382 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2385 C Compute the Z-axis
2386 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2387 costh=dcos(pi-theta(i+2))
2388 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2392 C Compute the derivatives of uz
2394 uzder(2,1,1)=-dc_norm(3,i+1)
2395 uzder(3,1,1)= dc_norm(2,i+1)
2396 uzder(1,2,1)= dc_norm(3,i+1)
2398 uzder(3,2,1)=-dc_norm(1,i+1)
2399 uzder(1,3,1)=-dc_norm(2,i+1)
2400 uzder(2,3,1)= dc_norm(1,i+1)
2403 uzder(2,1,2)= dc_norm(3,i)
2404 uzder(3,1,2)=-dc_norm(2,i)
2405 uzder(1,2,2)=-dc_norm(3,i)
2407 uzder(3,2,2)= dc_norm(1,i)
2408 uzder(1,3,2)= dc_norm(2,i)
2409 uzder(2,3,2)=-dc_norm(1,i)
2411 C Compute the Y-axis
2414 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2416 C Compute the derivatives of uy
2419 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2420 & -dc_norm(k,i)*dc_norm(j,i+1)
2421 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2423 uyder(j,j,1)=uyder(j,j,1)-costh
2424 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2429 uygrad(l,k,j,i)=uyder(l,k,j)
2430 uzgrad(l,k,j,i)=uzder(l,k,j)
2434 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2435 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2436 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2437 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2441 vbld_inv_temp(1)=vbld_inv(i+1)
2442 if (i.lt.nres-1) then
2443 vbld_inv_temp(2)=vbld_inv(i+2)
2445 vbld_inv_temp(2)=vbld_inv(i)
2450 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2451 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2456 #if defined(PARVEC) && defined(MPI)
2457 if (nfgtasks1.gt.1) then
2459 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2460 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2461 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2462 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2463 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2465 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2466 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2468 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2469 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2470 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2471 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2472 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2473 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2474 time_gather=time_gather+MPI_Wtime()-time00
2476 c if (fg_rank.eq.0) then
2477 c write (iout,*) "Arrays UY and UZ"
2479 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2486 C-----------------------------------------------------------------------------
2487 subroutine check_vecgrad
2488 implicit real*8 (a-h,o-z)
2489 include 'DIMENSIONS'
2490 include 'COMMON.IOUNITS'
2491 include 'COMMON.GEO'
2492 include 'COMMON.VAR'
2493 include 'COMMON.LOCAL'
2494 include 'COMMON.CHAIN'
2495 include 'COMMON.VECTORS'
2496 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2497 dimension uyt(3,maxres),uzt(3,maxres)
2498 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2499 double precision delta /1.0d-7/
2502 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2503 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2504 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2505 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2506 cd & (dc_norm(if90,i),if90=1,3)
2507 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2508 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2509 cd write(iout,'(a)')
2515 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2516 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2529 cd write (iout,*) 'i=',i
2531 erij(k)=dc_norm(k,i)
2535 dc_norm(k,i)=erij(k)
2537 dc_norm(j,i)=dc_norm(j,i)+delta
2538 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2540 c dc_norm(k,i)=dc_norm(k,i)/fac
2542 c write (iout,*) (dc_norm(k,i),k=1,3)
2543 c write (iout,*) (erij(k),k=1,3)
2546 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2547 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2548 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2549 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2551 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2552 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2553 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2556 dc_norm(k,i)=erij(k)
2559 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2560 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2561 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2562 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2563 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2564 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2565 cd write (iout,'(a)')
2570 C--------------------------------------------------------------------------
2571 subroutine set_matrices
2572 implicit real*8 (a-h,o-z)
2573 include 'DIMENSIONS'
2576 include "COMMON.SETUP"
2578 integer status(MPI_STATUS_SIZE)
2580 include 'COMMON.IOUNITS'
2581 include 'COMMON.GEO'
2582 include 'COMMON.VAR'
2583 include 'COMMON.LOCAL'
2584 include 'COMMON.CHAIN'
2585 include 'COMMON.DERIV'
2586 include 'COMMON.INTERACT'
2587 include 'COMMON.CONTACTS'
2588 include 'COMMON.TORSION'
2589 include 'COMMON.VECTORS'
2590 include 'COMMON.FFIELD'
2591 double precision auxvec(2),auxmat(2,2)
2593 C Compute the virtual-bond-torsional-angle dependent quantities needed
2594 C to calculate the el-loc multibody terms of various order.
2597 do i=ivec_start+2,ivec_end+2
2601 if (i .lt. nres+1) then
2638 if (i .gt. 3 .and. i .lt. nres+1) then
2639 obrot_der(1,i-2)=-sin1
2640 obrot_der(2,i-2)= cos1
2641 Ugder(1,1,i-2)= sin1
2642 Ugder(1,2,i-2)=-cos1
2643 Ugder(2,1,i-2)=-cos1
2644 Ugder(2,2,i-2)=-sin1
2647 obrot2_der(1,i-2)=-dwasin2
2648 obrot2_der(2,i-2)= dwacos2
2649 Ug2der(1,1,i-2)= dwasin2
2650 Ug2der(1,2,i-2)=-dwacos2
2651 Ug2der(2,1,i-2)=-dwacos2
2652 Ug2der(2,2,i-2)=-dwasin2
2654 obrot_der(1,i-2)=0.0d0
2655 obrot_der(2,i-2)=0.0d0
2656 Ugder(1,1,i-2)=0.0d0
2657 Ugder(1,2,i-2)=0.0d0
2658 Ugder(2,1,i-2)=0.0d0
2659 Ugder(2,2,i-2)=0.0d0
2660 obrot2_der(1,i-2)=0.0d0
2661 obrot2_der(2,i-2)=0.0d0
2662 Ug2der(1,1,i-2)=0.0d0
2663 Ug2der(1,2,i-2)=0.0d0
2664 Ug2der(2,1,i-2)=0.0d0
2665 Ug2der(2,2,i-2)=0.0d0
2667 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2668 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2669 iti = itortyp(itype(i-2))
2673 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2674 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2675 iti1 = itortyp(itype(i-1))
2679 cd write (iout,*) '*******i',i,' iti1',iti
2680 cd write (iout,*) 'b1',b1(:,iti)
2681 cd write (iout,*) 'b2',b2(:,iti)
2682 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2683 c if (i .gt. iatel_s+2) then
2684 if (i .gt. nnt+2) then
2685 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2686 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2687 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2689 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2690 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2691 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2692 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2693 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2704 DtUg2(l,k,i-2)=0.0d0
2708 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2709 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2711 muder(k,i-2)=Ub2der(k,i-2)
2713 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2714 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2715 iti1 = itortyp(itype(i-1))
2720 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2722 cd write (iout,*) 'mu ',mu(:,i-2)
2723 cd write (iout,*) 'mu1',mu1(:,i-2)
2724 cd write (iout,*) 'mu2',mu2(:,i-2)
2725 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2727 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2728 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2729 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2730 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2731 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2732 C Vectors and matrices dependent on a single virtual-bond dihedral.
2733 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2734 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2735 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2736 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2737 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2738 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2739 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2740 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2741 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2744 C Matrices dependent on two consecutive virtual-bond dihedrals.
2745 C The order of matrices is from left to right.
2746 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2748 c do i=max0(ivec_start,2),ivec_end
2750 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2751 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2752 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2753 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2754 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2755 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2756 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2757 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2760 #if defined(MPI) && defined(PARMAT)
2762 c if (fg_rank.eq.0) then
2763 write (iout,*) "Arrays UG and UGDER before GATHER"
2765 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2766 & ((ug(l,k,i),l=1,2),k=1,2),
2767 & ((ugder(l,k,i),l=1,2),k=1,2)
2769 write (iout,*) "Arrays UG2 and UG2DER"
2771 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2772 & ((ug2(l,k,i),l=1,2),k=1,2),
2773 & ((ug2der(l,k,i),l=1,2),k=1,2)
2775 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2777 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2778 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2779 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2781 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2783 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2784 & costab(i),sintab(i),costab2(i),sintab2(i)
2786 write (iout,*) "Array MUDER"
2788 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2792 if (nfgtasks.gt.1) then
2794 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2795 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2796 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2798 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2799 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2801 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2802 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2804 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2805 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2807 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2808 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2810 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2811 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2813 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2814 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2816 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2817 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2818 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2819 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2820 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2821 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2822 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2823 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2824 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2825 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2826 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2827 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2828 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2830 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2831 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2833 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2834 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2836 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2837 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2839 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2840 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2842 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2843 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2845 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2846 & ivec_count(fg_rank1),
2847 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2849 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2850 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2852 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2853 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2855 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2856 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2858 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2859 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2861 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2862 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2864 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2865 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2867 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2868 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2870 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2871 & ivec_count(fg_rank1),
2872 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2874 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2875 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2877 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2878 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2880 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2881 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2883 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2884 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2886 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2887 & ivec_count(fg_rank1),
2888 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2890 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2891 & ivec_count(fg_rank1),
2892 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2894 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2895 & ivec_count(fg_rank1),
2896 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2897 & MPI_MAT2,FG_COMM1,IERR)
2898 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2899 & ivec_count(fg_rank1),
2900 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2901 & MPI_MAT2,FG_COMM1,IERR)
2904 c Passes matrix info through the ring
2907 if (irecv.lt.0) irecv=nfgtasks1-1
2910 if (inext.ge.nfgtasks1) inext=0
2912 c write (iout,*) "isend",isend," irecv",irecv
2914 lensend=lentyp(isend)
2915 lenrecv=lentyp(irecv)
2916 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2917 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2918 c & MPI_ROTAT1(lensend),inext,2200+isend,
2919 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2920 c & iprev,2200+irecv,FG_COMM,status,IERR)
2921 c write (iout,*) "Gather ROTAT1"
2923 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2924 c & MPI_ROTAT2(lensend),inext,3300+isend,
2925 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2926 c & iprev,3300+irecv,FG_COMM,status,IERR)
2927 c write (iout,*) "Gather ROTAT2"
2929 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2930 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2931 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2932 & iprev,4400+irecv,FG_COMM,status,IERR)
2933 c write (iout,*) "Gather ROTAT_OLD"
2935 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2936 & MPI_PRECOMP11(lensend),inext,5500+isend,
2937 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2938 & iprev,5500+irecv,FG_COMM,status,IERR)
2939 c write (iout,*) "Gather PRECOMP11"
2941 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2942 & MPI_PRECOMP12(lensend),inext,6600+isend,
2943 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2944 & iprev,6600+irecv,FG_COMM,status,IERR)
2945 c write (iout,*) "Gather PRECOMP12"
2947 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2949 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2950 & MPI_ROTAT2(lensend),inext,7700+isend,
2951 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2952 & iprev,7700+irecv,FG_COMM,status,IERR)
2953 c write (iout,*) "Gather PRECOMP21"
2955 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2956 & MPI_PRECOMP22(lensend),inext,8800+isend,
2957 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2958 & iprev,8800+irecv,FG_COMM,status,IERR)
2959 c write (iout,*) "Gather PRECOMP22"
2961 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2962 & MPI_PRECOMP23(lensend),inext,9900+isend,
2963 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2964 & MPI_PRECOMP23(lenrecv),
2965 & iprev,9900+irecv,FG_COMM,status,IERR)
2966 c write (iout,*) "Gather PRECOMP23"
2971 if (irecv.lt.0) irecv=nfgtasks1-1
2974 time_gather=time_gather+MPI_Wtime()-time00
2977 c if (fg_rank.eq.0) then
2978 write (iout,*) "Arrays UG and UGDER"
2980 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2981 & ((ug(l,k,i),l=1,2),k=1,2),
2982 & ((ugder(l,k,i),l=1,2),k=1,2)
2984 write (iout,*) "Arrays UG2 and UG2DER"
2986 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2987 & ((ug2(l,k,i),l=1,2),k=1,2),
2988 & ((ug2der(l,k,i),l=1,2),k=1,2)
2990 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2992 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2993 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2994 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2996 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2998 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2999 & costab(i),sintab(i),costab2(i),sintab2(i)
3001 write (iout,*) "Array MUDER"
3003 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3009 cd iti = itortyp(itype(i))
3012 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3013 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3018 C--------------------------------------------------------------------------
3019 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3021 C This subroutine calculates the average interaction energy and its gradient
3022 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3023 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3024 C The potential depends both on the distance of peptide-group centers and on
3025 C the orientation of the CA-CA virtual bonds.
3027 implicit real*8 (a-h,o-z)
3031 include 'DIMENSIONS'
3032 include 'COMMON.CONTROL'
3033 include 'COMMON.SETUP'
3034 include 'COMMON.IOUNITS'
3035 include 'COMMON.GEO'
3036 include 'COMMON.VAR'
3037 include 'COMMON.LOCAL'
3038 include 'COMMON.CHAIN'
3039 include 'COMMON.DERIV'
3040 include 'COMMON.INTERACT'
3041 include 'COMMON.CONTACTS'
3042 include 'COMMON.TORSION'
3043 include 'COMMON.VECTORS'
3044 include 'COMMON.FFIELD'
3045 include 'COMMON.TIME1'
3046 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3047 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3048 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3049 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3050 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3051 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3053 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3055 double precision scal_el /1.0d0/
3057 double precision scal_el /0.5d0/
3060 C 13-go grudnia roku pamietnego...
3061 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3062 & 0.0d0,1.0d0,0.0d0,
3063 & 0.0d0,0.0d0,1.0d0/
3064 cd write(iout,*) 'In EELEC'
3066 cd write(iout,*) 'Type',i
3067 cd write(iout,*) 'B1',B1(:,i)
3068 cd write(iout,*) 'B2',B2(:,i)
3069 cd write(iout,*) 'CC',CC(:,:,i)
3070 cd write(iout,*) 'DD',DD(:,:,i)
3071 cd write(iout,*) 'EE',EE(:,:,i)
3073 cd call check_vecgrad
3075 if (icheckgrad.eq.1) then
3077 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3079 dc_norm(k,i)=dc(k,i)*fac
3081 c write (iout,*) 'i',i,' fac',fac
3084 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3085 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3086 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3087 c call vec_and_deriv
3093 time_mat=time_mat+MPI_Wtime()-time01
3097 cd write (iout,*) 'i=',i
3099 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3102 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3103 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3116 cd print '(a)','Enter EELEC'
3117 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3119 gel_loc_loc(i)=0.0d0
3124 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3126 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3128 do i=iturn3_start,iturn3_end
3132 dx_normi=dc_norm(1,i)
3133 dy_normi=dc_norm(2,i)
3134 dz_normi=dc_norm(3,i)
3135 xmedi=c(1,i)+0.5d0*dxi
3136 ymedi=c(2,i)+0.5d0*dyi
3137 zmedi=c(3,i)+0.5d0*dzi
3139 call eelecij(i,i+2,ees,evdw1,eel_loc)
3140 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3141 num_cont_hb(i)=num_conti
3143 do i=iturn4_start,iturn4_end
3147 dx_normi=dc_norm(1,i)
3148 dy_normi=dc_norm(2,i)
3149 dz_normi=dc_norm(3,i)
3150 xmedi=c(1,i)+0.5d0*dxi
3151 ymedi=c(2,i)+0.5d0*dyi
3152 zmedi=c(3,i)+0.5d0*dzi
3153 num_conti=num_cont_hb(i)
3154 call eelecij(i,i+3,ees,evdw1,eel_loc)
3155 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3156 num_cont_hb(i)=num_conti
3159 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3161 do i=iatel_s,iatel_e
3165 dx_normi=dc_norm(1,i)
3166 dy_normi=dc_norm(2,i)
3167 dz_normi=dc_norm(3,i)
3168 xmedi=c(1,i)+0.5d0*dxi
3169 ymedi=c(2,i)+0.5d0*dyi
3170 zmedi=c(3,i)+0.5d0*dzi
3171 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3172 num_conti=num_cont_hb(i)
3173 do j=ielstart(i),ielend(i)
3174 call eelecij(i,j,ees,evdw1,eel_loc)
3176 num_cont_hb(i)=num_conti
3178 c write (iout,*) "Number of loop steps in EELEC:",ind
3180 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3181 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3183 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3184 ccc eel_loc=eel_loc+eello_turn3
3185 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3188 C-------------------------------------------------------------------------------
3189 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3190 implicit real*8 (a-h,o-z)
3191 include 'DIMENSIONS'
3195 include 'COMMON.CONTROL'
3196 include 'COMMON.IOUNITS'
3197 include 'COMMON.GEO'
3198 include 'COMMON.VAR'
3199 include 'COMMON.LOCAL'
3200 include 'COMMON.CHAIN'
3201 include 'COMMON.DERIV'
3202 include 'COMMON.INTERACT'
3203 include 'COMMON.CONTACTS'
3204 include 'COMMON.TORSION'
3205 include 'COMMON.VECTORS'
3206 include 'COMMON.FFIELD'
3207 include 'COMMON.TIME1'
3208 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3209 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3210 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3211 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3212 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3213 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3215 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3217 double precision scal_el /1.0d0/
3219 double precision scal_el /0.5d0/
3222 C 13-go grudnia roku pamietnego...
3223 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3224 & 0.0d0,1.0d0,0.0d0,
3225 & 0.0d0,0.0d0,1.0d0/
3226 c time00=MPI_Wtime()
3227 cd write (iout,*) "eelecij",i,j
3231 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3232 aaa=app(iteli,itelj)
3233 bbb=bpp(iteli,itelj)
3234 ael6i=ael6(iteli,itelj)
3235 ael3i=ael3(iteli,itelj)
3239 dx_normj=dc_norm(1,j)
3240 dy_normj=dc_norm(2,j)
3241 dz_normj=dc_norm(3,j)
3242 xj=c(1,j)+0.5D0*dxj-xmedi
3243 yj=c(2,j)+0.5D0*dyj-ymedi
3244 zj=c(3,j)+0.5D0*dzj-zmedi
3245 rij=xj*xj+yj*yj+zj*zj
3251 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3252 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3253 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3254 fac=cosa-3.0D0*cosb*cosg
3256 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3257 if (j.eq.i+2) ev1=scal_el*ev1
3262 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3265 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3266 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3269 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3270 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3271 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3272 cd & xmedi,ymedi,zmedi,xj,yj,zj
3274 if (energy_dec) then
3275 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3276 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3280 C Calculate contributions to the Cartesian gradient.
3283 facvdw=-6*rrmij*(ev1+evdwij)
3284 facel=-3*rrmij*(el1+eesij)
3290 * Radial derivatives. First process both termini of the fragment (i,j)
3296 c ghalf=0.5D0*ggg(k)
3297 c gelc(k,i)=gelc(k,i)+ghalf
3298 c gelc(k,j)=gelc(k,j)+ghalf
3300 c 9/28/08 AL Gradient compotents will be summed only at the end
3302 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3303 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3306 * Loop over residues i+1 thru j-1.
3310 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3317 c ghalf=0.5D0*ggg(k)
3318 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3319 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3321 c 9/28/08 AL Gradient compotents will be summed only at the end
3323 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3324 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3327 * Loop over residues i+1 thru j-1.
3331 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3338 fac=-3*rrmij*(facvdw+facvdw+facel)
3343 * Radial derivatives. First process both termini of the fragment (i,j)
3349 c ghalf=0.5D0*ggg(k)
3350 c gelc(k,i)=gelc(k,i)+ghalf
3351 c gelc(k,j)=gelc(k,j)+ghalf
3353 c 9/28/08 AL Gradient compotents will be summed only at the end
3355 gelc_long(k,j)=gelc(k,j)+ggg(k)
3356 gelc_long(k,i)=gelc(k,i)-ggg(k)
3359 * Loop over residues i+1 thru j-1.
3363 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3366 c 9/28/08 AL Gradient compotents will be summed only at the end
3371 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3372 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3378 ecosa=2.0D0*fac3*fac1+fac4
3381 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3382 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3384 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3385 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3387 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3388 cd & (dcosg(k),k=1,3)
3390 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3393 c ghalf=0.5D0*ggg(k)
3394 c gelc(k,i)=gelc(k,i)+ghalf
3395 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3396 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3397 c gelc(k,j)=gelc(k,j)+ghalf
3398 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3399 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3403 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3408 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3409 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3411 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3412 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3413 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3414 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3416 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3417 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3418 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3420 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3421 C energy of a peptide unit is assumed in the form of a second-order
3422 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3423 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3424 C are computed for EVERY pair of non-contiguous peptide groups.
3426 if (j.lt.nres-1) then
3437 muij(kkk)=mu(k,i)*mu(l,j)
3440 cd write (iout,*) 'EELEC: i',i,' j',j
3441 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3442 cd write(iout,*) 'muij',muij
3443 ury=scalar(uy(1,i),erij)
3444 urz=scalar(uz(1,i),erij)
3445 vry=scalar(uy(1,j),erij)
3446 vrz=scalar(uz(1,j),erij)
3447 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3448 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3449 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3450 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3451 fac=dsqrt(-ael6i)*r3ij
3456 cd write (iout,'(4i5,4f10.5)')
3457 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3458 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3459 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3460 cd & uy(:,j),uz(:,j)
3461 cd write (iout,'(4f10.5)')
3462 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3463 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3464 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3465 cd write (iout,'(9f10.5/)')
3466 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3467 C Derivatives of the elements of A in virtual-bond vectors
3468 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3470 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3471 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3472 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3473 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3474 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3475 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3476 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3477 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3478 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3479 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3480 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3481 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3483 C Compute radial contributions to the gradient
3501 C Add the contributions coming from er
3504 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3505 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3506 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3507 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3510 C Derivatives in DC(i)
3511 cgrad ghalf1=0.5d0*agg(k,1)
3512 cgrad ghalf2=0.5d0*agg(k,2)
3513 cgrad ghalf3=0.5d0*agg(k,3)
3514 cgrad ghalf4=0.5d0*agg(k,4)
3515 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3516 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3517 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3518 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3519 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3520 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3521 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3522 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3523 C Derivatives in DC(i+1)
3524 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3525 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3526 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3527 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3528 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3529 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3530 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3531 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3532 C Derivatives in DC(j)
3533 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3534 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3535 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3536 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3537 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3538 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3539 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3540 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3541 C Derivatives in DC(j+1) or DC(nres-1)
3542 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3543 & -3.0d0*vryg(k,3)*ury)
3544 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3545 & -3.0d0*vrzg(k,3)*ury)
3546 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3547 & -3.0d0*vryg(k,3)*urz)
3548 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3549 & -3.0d0*vrzg(k,3)*urz)
3550 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3552 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3565 aggi(k,l)=-aggi(k,l)
3566 aggi1(k,l)=-aggi1(k,l)
3567 aggj(k,l)=-aggj(k,l)
3568 aggj1(k,l)=-aggj1(k,l)
3571 if (j.lt.nres-1) then
3577 aggi(k,l)=-aggi(k,l)
3578 aggi1(k,l)=-aggi1(k,l)
3579 aggj(k,l)=-aggj(k,l)
3580 aggj1(k,l)=-aggj1(k,l)
3591 aggi(k,l)=-aggi(k,l)
3592 aggi1(k,l)=-aggi1(k,l)
3593 aggj(k,l)=-aggj(k,l)
3594 aggj1(k,l)=-aggj1(k,l)
3599 IF (wel_loc.gt.0.0d0) THEN
3600 C Contribution to the local-electrostatic energy coming from the i-j pair
3601 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3603 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3605 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3606 & 'eelloc',i,j,eel_loc_ij
3608 eel_loc=eel_loc+eel_loc_ij
3609 C Partial derivatives in virtual-bond dihedral angles gamma
3611 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3612 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3613 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3614 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3615 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3616 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3617 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3619 ggg(l)=agg(l,1)*muij(1)+
3620 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3621 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3622 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3623 cgrad ghalf=0.5d0*ggg(l)
3624 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3625 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3629 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3632 C Remaining derivatives of eello
3634 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3635 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3636 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3637 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3638 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3639 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3640 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3641 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3644 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3645 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3646 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3647 & .and. num_conti.le.maxconts) then
3648 c write (iout,*) i,j," entered corr"
3650 C Calculate the contact function. The ith column of the array JCONT will
3651 C contain the numbers of atoms that make contacts with the atom I (of numbers
3652 C greater than I). The arrays FACONT and GACONT will contain the values of
3653 C the contact function and its derivative.
3654 c r0ij=1.02D0*rpp(iteli,itelj)
3655 c r0ij=1.11D0*rpp(iteli,itelj)
3656 r0ij=2.20D0*rpp(iteli,itelj)
3657 c r0ij=1.55D0*rpp(iteli,itelj)
3658 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3659 if (fcont.gt.0.0D0) then
3660 num_conti=num_conti+1
3661 if (num_conti.gt.maxconts) then
3662 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3663 & ' will skip next contacts for this conf.'
3665 jcont_hb(num_conti,i)=j
3666 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3667 cd & " jcont_hb",jcont_hb(num_conti,i)
3668 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3669 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3670 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3672 d_cont(num_conti,i)=rij
3673 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3674 C --- Electrostatic-interaction matrix ---
3675 a_chuj(1,1,num_conti,i)=a22
3676 a_chuj(1,2,num_conti,i)=a23
3677 a_chuj(2,1,num_conti,i)=a32
3678 a_chuj(2,2,num_conti,i)=a33
3679 C --- Gradient of rij
3681 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3688 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3689 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3690 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3691 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3692 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3697 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3698 C Calculate contact energies
3700 wij=cosa-3.0D0*cosb*cosg
3703 c fac3=dsqrt(-ael6i)/r0ij**3
3704 fac3=dsqrt(-ael6i)*r3ij
3705 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3706 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3707 if (ees0tmp.gt.0) then
3708 ees0pij=dsqrt(ees0tmp)
3712 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3713 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3714 if (ees0tmp.gt.0) then
3715 ees0mij=dsqrt(ees0tmp)
3720 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3721 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3722 C Diagnostics. Comment out or remove after debugging!
3723 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3724 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3725 c ees0m(num_conti,i)=0.0D0
3727 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3728 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3729 C Angular derivatives of the contact function
3730 ees0pij1=fac3/ees0pij
3731 ees0mij1=fac3/ees0mij
3732 fac3p=-3.0D0*fac3*rrmij
3733 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3734 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3736 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3737 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3738 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3739 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3740 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3741 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3742 ecosap=ecosa1+ecosa2
3743 ecosbp=ecosb1+ecosb2
3744 ecosgp=ecosg1+ecosg2
3745 ecosam=ecosa1-ecosa2
3746 ecosbm=ecosb1-ecosb2
3747 ecosgm=ecosg1-ecosg2
3756 facont_hb(num_conti,i)=fcont
3757 fprimcont=fprimcont/rij
3758 cd facont_hb(num_conti,i)=1.0D0
3759 C Following line is for diagnostics.
3762 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3763 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3766 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3767 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3769 gggp(1)=gggp(1)+ees0pijp*xj
3770 gggp(2)=gggp(2)+ees0pijp*yj
3771 gggp(3)=gggp(3)+ees0pijp*zj
3772 gggm(1)=gggm(1)+ees0mijp*xj
3773 gggm(2)=gggm(2)+ees0mijp*yj
3774 gggm(3)=gggm(3)+ees0mijp*zj
3775 C Derivatives due to the contact function
3776 gacont_hbr(1,num_conti,i)=fprimcont*xj
3777 gacont_hbr(2,num_conti,i)=fprimcont*yj
3778 gacont_hbr(3,num_conti,i)=fprimcont*zj
3781 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3782 c following the change of gradient-summation algorithm.
3784 cgrad ghalfp=0.5D0*gggp(k)
3785 cgrad ghalfm=0.5D0*gggm(k)
3786 gacontp_hb1(k,num_conti,i)=!ghalfp
3787 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3788 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3789 gacontp_hb2(k,num_conti,i)=!ghalfp
3790 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3791 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3792 gacontp_hb3(k,num_conti,i)=gggp(k)
3793 gacontm_hb1(k,num_conti,i)=!ghalfm
3794 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3795 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3796 gacontm_hb2(k,num_conti,i)=!ghalfm
3797 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3798 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3799 gacontm_hb3(k,num_conti,i)=gggm(k)
3801 C Diagnostics. Comment out or remove after debugging!
3803 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3804 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3805 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3806 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3807 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3808 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3811 endif ! num_conti.le.maxconts
3814 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3817 ghalf=0.5d0*agg(l,k)
3818 aggi(l,k)=aggi(l,k)+ghalf
3819 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3820 aggj(l,k)=aggj(l,k)+ghalf
3823 if (j.eq.nres-1 .and. i.lt.j-2) then
3826 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3831 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3834 C-----------------------------------------------------------------------------
3835 subroutine eturn3(i,eello_turn3)
3836 C Third- and fourth-order contributions from turns
3837 implicit real*8 (a-h,o-z)
3838 include 'DIMENSIONS'
3839 include 'COMMON.IOUNITS'
3840 include 'COMMON.GEO'
3841 include 'COMMON.VAR'
3842 include 'COMMON.LOCAL'
3843 include 'COMMON.CHAIN'
3844 include 'COMMON.DERIV'
3845 include 'COMMON.INTERACT'
3846 include 'COMMON.CONTACTS'
3847 include 'COMMON.TORSION'
3848 include 'COMMON.VECTORS'
3849 include 'COMMON.FFIELD'
3850 include 'COMMON.CONTROL'
3852 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3853 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3854 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3855 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3856 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3857 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3858 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3861 c write (iout,*) "eturn3",i,j,j1,j2
3866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3868 C Third-order contributions
3875 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3876 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3877 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3878 call transpose2(auxmat(1,1),auxmat1(1,1))
3879 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3880 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3881 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3882 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3883 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3884 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3885 cd & ' eello_turn3_num',4*eello_turn3_num
3886 C Derivatives in gamma(i)
3887 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3888 call transpose2(auxmat2(1,1),auxmat3(1,1))
3889 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3890 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3891 C Derivatives in gamma(i+1)
3892 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3893 call transpose2(auxmat2(1,1),auxmat3(1,1))
3894 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3895 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3896 & +0.5d0*(pizda(1,1)+pizda(2,2))
3897 C Cartesian derivatives
3899 c ghalf1=0.5d0*agg(l,1)
3900 c ghalf2=0.5d0*agg(l,2)
3901 c ghalf3=0.5d0*agg(l,3)
3902 c ghalf4=0.5d0*agg(l,4)
3903 a_temp(1,1)=aggi(l,1)!+ghalf1
3904 a_temp(1,2)=aggi(l,2)!+ghalf2
3905 a_temp(2,1)=aggi(l,3)!+ghalf3
3906 a_temp(2,2)=aggi(l,4)!+ghalf4
3907 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3908 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3909 & +0.5d0*(pizda(1,1)+pizda(2,2))
3910 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3911 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3912 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3913 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3914 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3915 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3916 & +0.5d0*(pizda(1,1)+pizda(2,2))
3917 a_temp(1,1)=aggj(l,1)!+ghalf1
3918 a_temp(1,2)=aggj(l,2)!+ghalf2
3919 a_temp(2,1)=aggj(l,3)!+ghalf3
3920 a_temp(2,2)=aggj(l,4)!+ghalf4
3921 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3922 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3923 & +0.5d0*(pizda(1,1)+pizda(2,2))
3924 a_temp(1,1)=aggj1(l,1)
3925 a_temp(1,2)=aggj1(l,2)
3926 a_temp(2,1)=aggj1(l,3)
3927 a_temp(2,2)=aggj1(l,4)
3928 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3929 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3930 & +0.5d0*(pizda(1,1)+pizda(2,2))
3934 C-------------------------------------------------------------------------------
3935 subroutine eturn4(i,eello_turn4)
3936 C Third- and fourth-order contributions from turns
3937 implicit real*8 (a-h,o-z)
3938 include 'DIMENSIONS'
3939 include 'COMMON.IOUNITS'
3940 include 'COMMON.GEO'
3941 include 'COMMON.VAR'
3942 include 'COMMON.LOCAL'
3943 include 'COMMON.CHAIN'
3944 include 'COMMON.DERIV'
3945 include 'COMMON.INTERACT'
3946 include 'COMMON.CONTACTS'
3947 include 'COMMON.TORSION'
3948 include 'COMMON.VECTORS'
3949 include 'COMMON.FFIELD'
3950 include 'COMMON.CONTROL'
3952 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3953 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3954 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3955 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3956 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3957 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3958 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3961 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3963 C Fourth-order contributions
3971 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3972 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3973 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3978 iti1=itortyp(itype(i+1))
3979 iti2=itortyp(itype(i+2))
3980 iti3=itortyp(itype(i+3))
3981 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3982 call transpose2(EUg(1,1,i+1),e1t(1,1))
3983 call transpose2(Eug(1,1,i+2),e2t(1,1))
3984 call transpose2(Eug(1,1,i+3),e3t(1,1))
3985 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3986 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3987 s1=scalar2(b1(1,iti2),auxvec(1))
3988 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3989 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3990 s2=scalar2(b1(1,iti1),auxvec(1))
3991 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3992 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3993 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3994 eello_turn4=eello_turn4-(s1+s2+s3)
3995 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3996 & 'eturn4',i,j,-(s1+s2+s3)
3997 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3998 cd & ' eello_turn4_num',8*eello_turn4_num
3999 C Derivatives in gamma(i)
4000 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4001 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4002 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4003 s1=scalar2(b1(1,iti2),auxvec(1))
4004 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4005 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4006 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4007 C Derivatives in gamma(i+1)
4008 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4009 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4010 s2=scalar2(b1(1,iti1),auxvec(1))
4011 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4012 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4013 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4014 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4015 C Derivatives in gamma(i+2)
4016 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4017 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4018 s1=scalar2(b1(1,iti2),auxvec(1))
4019 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4020 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4021 s2=scalar2(b1(1,iti1),auxvec(1))
4022 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4023 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4024 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4025 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4026 C Cartesian derivatives
4027 C Derivatives of this turn contributions in DC(i+2)
4028 if (j.lt.nres-1) then
4030 a_temp(1,1)=agg(l,1)
4031 a_temp(1,2)=agg(l,2)
4032 a_temp(2,1)=agg(l,3)
4033 a_temp(2,2)=agg(l,4)
4034 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4035 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4036 s1=scalar2(b1(1,iti2),auxvec(1))
4037 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4038 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4039 s2=scalar2(b1(1,iti1),auxvec(1))
4040 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4041 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4042 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4044 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4047 C Remaining derivatives of this turn contribution
4049 a_temp(1,1)=aggi(l,1)
4050 a_temp(1,2)=aggi(l,2)
4051 a_temp(2,1)=aggi(l,3)
4052 a_temp(2,2)=aggi(l,4)
4053 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4054 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4055 s1=scalar2(b1(1,iti2),auxvec(1))
4056 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4057 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4058 s2=scalar2(b1(1,iti1),auxvec(1))
4059 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4060 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4061 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4062 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4063 a_temp(1,1)=aggi1(l,1)
4064 a_temp(1,2)=aggi1(l,2)
4065 a_temp(2,1)=aggi1(l,3)
4066 a_temp(2,2)=aggi1(l,4)
4067 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4068 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4069 s1=scalar2(b1(1,iti2),auxvec(1))
4070 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4071 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4072 s2=scalar2(b1(1,iti1),auxvec(1))
4073 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4074 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4075 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4076 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4077 a_temp(1,1)=aggj(l,1)
4078 a_temp(1,2)=aggj(l,2)
4079 a_temp(2,1)=aggj(l,3)
4080 a_temp(2,2)=aggj(l,4)
4081 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4082 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4083 s1=scalar2(b1(1,iti2),auxvec(1))
4084 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4085 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4086 s2=scalar2(b1(1,iti1),auxvec(1))
4087 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4088 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4089 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4090 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4091 a_temp(1,1)=aggj1(l,1)
4092 a_temp(1,2)=aggj1(l,2)
4093 a_temp(2,1)=aggj1(l,3)
4094 a_temp(2,2)=aggj1(l,4)
4095 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4096 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4097 s1=scalar2(b1(1,iti2),auxvec(1))
4098 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4099 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4100 s2=scalar2(b1(1,iti1),auxvec(1))
4101 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4102 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4103 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4104 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4105 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4109 C-----------------------------------------------------------------------------
4110 subroutine vecpr(u,v,w)
4111 implicit real*8(a-h,o-z)
4112 dimension u(3),v(3),w(3)
4113 w(1)=u(2)*v(3)-u(3)*v(2)
4114 w(2)=-u(1)*v(3)+u(3)*v(1)
4115 w(3)=u(1)*v(2)-u(2)*v(1)
4118 C-----------------------------------------------------------------------------
4119 subroutine unormderiv(u,ugrad,unorm,ungrad)
4120 C This subroutine computes the derivatives of a normalized vector u, given
4121 C the derivatives computed without normalization conditions, ugrad. Returns
4124 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4125 double precision vec(3)
4126 double precision scalar
4128 c write (2,*) 'ugrad',ugrad
4131 vec(i)=scalar(ugrad(1,i),u(1))
4133 c write (2,*) 'vec',vec
4136 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4139 c write (2,*) 'ungrad',ungrad
4142 C-----------------------------------------------------------------------------
4143 subroutine escp_soft_sphere(evdw2,evdw2_14)
4145 C This subroutine calculates the excluded-volume interaction energy between
4146 C peptide-group centers and side chains and its gradient in virtual-bond and
4147 C side-chain vectors.
4149 implicit real*8 (a-h,o-z)
4150 include 'DIMENSIONS'
4151 include 'COMMON.GEO'
4152 include 'COMMON.VAR'
4153 include 'COMMON.LOCAL'
4154 include 'COMMON.CHAIN'
4155 include 'COMMON.DERIV'
4156 include 'COMMON.INTERACT'
4157 include 'COMMON.FFIELD'
4158 include 'COMMON.IOUNITS'
4159 include 'COMMON.CONTROL'
4164 cd print '(a)','Enter ESCP'
4165 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4166 do i=iatscp_s,iatscp_e
4168 xi=0.5D0*(c(1,i)+c(1,i+1))
4169 yi=0.5D0*(c(2,i)+c(2,i+1))
4170 zi=0.5D0*(c(3,i)+c(3,i+1))
4172 do iint=1,nscp_gr(i)
4174 do j=iscpstart(i,iint),iscpend(i,iint)
4176 C Uncomment following three lines for SC-p interactions
4180 C Uncomment following three lines for Ca-p interactions
4184 rij=xj*xj+yj*yj+zj*zj
4187 if (rij.lt.r0ijsq) then
4188 evdwij=0.25d0*(rij-r0ijsq)**2
4196 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4201 cgrad if (j.lt.i) then
4202 cd write (iout,*) 'j<i'
4203 C Uncomment following three lines for SC-p interactions
4205 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4208 cd write (iout,*) 'j>i'
4210 cgrad ggg(k)=-ggg(k)
4211 C Uncomment following line for SC-p interactions
4212 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4216 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4218 cgrad kstart=min0(i+1,j)
4219 cgrad kend=max0(i-1,j-1)
4220 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4221 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4222 cgrad do k=kstart,kend
4224 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4228 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4229 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4237 C-----------------------------------------------------------------------------
4238 subroutine escp(evdw2,evdw2_14)
4240 C This subroutine calculates the excluded-volume interaction energy between
4241 C peptide-group centers and side chains and its gradient in virtual-bond and
4242 C side-chain vectors.
4244 implicit real*8 (a-h,o-z)
4245 include 'DIMENSIONS'
4246 include 'COMMON.GEO'
4247 include 'COMMON.VAR'
4248 include 'COMMON.LOCAL'
4249 include 'COMMON.CHAIN'
4250 include 'COMMON.DERIV'
4251 include 'COMMON.INTERACT'
4252 include 'COMMON.FFIELD'
4253 include 'COMMON.IOUNITS'
4254 include 'COMMON.CONTROL'
4258 cd print '(a)','Enter ESCP'
4259 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4260 do i=iatscp_s,iatscp_e
4262 xi=0.5D0*(c(1,i)+c(1,i+1))
4263 yi=0.5D0*(c(2,i)+c(2,i+1))
4264 zi=0.5D0*(c(3,i)+c(3,i+1))
4266 do iint=1,nscp_gr(i)
4268 do j=iscpstart(i,iint),iscpend(i,iint)
4270 C Uncomment following three lines for SC-p interactions
4274 C Uncomment following three lines for Ca-p interactions
4278 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4280 e1=fac*fac*aad(itypj,iteli)
4281 e2=fac*bad(itypj,iteli)
4282 if (iabs(j-i) .le. 2) then
4285 evdw2_14=evdw2_14+e1+e2
4289 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4290 & 'evdw2',i,j,evdwij
4292 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4294 fac=-(evdwij+e1)*rrij
4298 cgrad if (j.lt.i) then
4299 cd write (iout,*) 'j<i'
4300 C Uncomment following three lines for SC-p interactions
4302 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4305 cd write (iout,*) 'j>i'
4307 cgrad ggg(k)=-ggg(k)
4308 C Uncomment following line for SC-p interactions
4309 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4310 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4314 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4316 cgrad kstart=min0(i+1,j)
4317 cgrad kend=max0(i-1,j-1)
4318 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4319 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4320 cgrad do k=kstart,kend
4322 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4326 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4327 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4335 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4336 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4337 gradx_scp(j,i)=expon*gradx_scp(j,i)
4340 C******************************************************************************
4344 C To save time the factor EXPON has been extracted from ALL components
4345 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4348 C******************************************************************************
4351 C--------------------------------------------------------------------------
4352 subroutine edis(ehpb)
4354 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4356 implicit real*8 (a-h,o-z)
4357 include 'DIMENSIONS'
4358 include 'COMMON.SBRIDGE'
4359 include 'COMMON.CHAIN'
4360 include 'COMMON.DERIV'
4361 include 'COMMON.VAR'
4362 include 'COMMON.INTERACT'
4363 include 'COMMON.IOUNITS'
4366 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4367 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4368 if (link_end.eq.0) return
4369 do i=link_start,link_end
4370 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4371 C CA-CA distance used in regularization of structure.
4374 C iii and jjj point to the residues for which the distance is assigned.
4375 if (ii.gt.nres) then
4382 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4383 c & dhpb(i),dhpb1(i),forcon(i)
4384 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4385 C distance and angle dependent SS bond potential.
4386 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4387 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4388 if (.not.dyn_ss .and. i.le.nss) then
4389 C 15/02/13 CC dynamic SSbond - additional check
4391 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4392 call ssbond_ene(iii,jjj,eij)
4395 cd write (iout,*) "eij",eij
4396 else if (ii.gt.nres .and. jj.gt.nres) then
4397 c Restraints from contact prediction
4399 if (dhpb1(i).gt.0.0d0) then
4400 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4401 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4402 c write (iout,*) "beta nmr",
4403 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4407 C Get the force constant corresponding to this distance.
4409 C Calculate the contribution to energy.
4410 ehpb=ehpb+waga*rdis*rdis
4411 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4413 C Evaluate gradient.
4418 ggg(j)=fac*(c(j,jj)-c(j,ii))
4421 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4422 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4425 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4426 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4429 C Calculate the distance between the two points and its difference from the
4432 if (dhpb1(i).gt.0.0d0) then
4433 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4434 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4435 c write (iout,*) "alph nmr",
4436 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4439 C Get the force constant corresponding to this distance.
4441 C Calculate the contribution to energy.
4442 ehpb=ehpb+waga*rdis*rdis
4443 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4445 C Evaluate gradient.
4449 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4450 cd & ' waga=',waga,' fac=',fac
4452 ggg(j)=fac*(c(j,jj)-c(j,ii))
4454 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4455 C If this is a SC-SC distance, we need to calculate the contributions to the
4456 C Cartesian gradient in the SC vectors (ghpbx).
4459 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4460 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4463 cgrad do j=iii,jjj-1
4465 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4469 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4470 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4477 C--------------------------------------------------------------------------
4478 subroutine ssbond_ene(i,j,eij)
4480 C Calculate the distance and angle dependent SS-bond potential energy
4481 C using a free-energy function derived based on RHF/6-31G** ab initio
4482 C calculations of diethyl disulfide.
4484 C A. Liwo and U. Kozlowska, 11/24/03
4486 implicit real*8 (a-h,o-z)
4487 include 'DIMENSIONS'
4488 include 'COMMON.SBRIDGE'
4489 include 'COMMON.CHAIN'
4490 include 'COMMON.DERIV'
4491 include 'COMMON.LOCAL'
4492 include 'COMMON.INTERACT'
4493 include 'COMMON.VAR'
4494 include 'COMMON.IOUNITS'
4495 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4500 dxi=dc_norm(1,nres+i)
4501 dyi=dc_norm(2,nres+i)
4502 dzi=dc_norm(3,nres+i)
4503 c dsci_inv=dsc_inv(itypi)
4504 dsci_inv=vbld_inv(nres+i)
4506 c dscj_inv=dsc_inv(itypj)
4507 dscj_inv=vbld_inv(nres+j)
4511 dxj=dc_norm(1,nres+j)
4512 dyj=dc_norm(2,nres+j)
4513 dzj=dc_norm(3,nres+j)
4514 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4519 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4520 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4521 om12=dxi*dxj+dyi*dyj+dzi*dzj
4523 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4524 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4530 deltat12=om2-om1+2.0d0
4532 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4533 & +akct*deltad*deltat12+ebr
4534 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4535 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4536 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4537 c & " deltat12",deltat12," eij",eij
4538 ed=2*akcm*deltad+akct*deltat12
4540 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4541 eom1=-2*akth*deltat1-pom1-om2*pom2
4542 eom2= 2*akth*deltat2+pom1-om1*pom2
4545 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4546 ghpbx(k,i)=ghpbx(k,i)-ggk
4547 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4548 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4549 ghpbx(k,j)=ghpbx(k,j)+ggk
4550 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4551 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4552 ghpbc(k,i)=ghpbc(k,i)-ggk
4553 ghpbc(k,j)=ghpbc(k,j)+ggk
4556 C Calculate the components of the gradient in DC and X
4560 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4565 C--------------------------------------------------------------------------
4566 subroutine ebond(estr)
4568 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4570 implicit real*8 (a-h,o-z)
4571 include 'DIMENSIONS'
4572 include 'COMMON.LOCAL'
4573 include 'COMMON.GEO'
4574 include 'COMMON.INTERACT'
4575 include 'COMMON.DERIV'
4576 include 'COMMON.VAR'
4577 include 'COMMON.CHAIN'
4578 include 'COMMON.IOUNITS'
4579 include 'COMMON.NAMES'
4580 include 'COMMON.FFIELD'
4581 include 'COMMON.CONTROL'
4582 include 'COMMON.SETUP'
4583 double precision u(3),ud(3)
4585 do i=ibondp_start,ibondp_end
4586 diff = vbld(i)-vbldp0
4587 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4588 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4589 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4592 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4594 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4598 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4600 do i=ibond_start,ibond_end
4605 diff=vbld(i+nres)-vbldsc0(1,iti)
4606 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4607 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4608 if (energy_dec) then
4610 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4611 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4614 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4616 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4620 diff=vbld(i+nres)-vbldsc0(j,iti)
4621 ud(j)=aksc(j,iti)*diff
4622 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4636 uprod2=uprod2*u(k)*u(k)
4640 usumsqder=usumsqder+ud(j)*uprod2
4642 estr=estr+uprod/usum
4644 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4652 C--------------------------------------------------------------------------
4653 subroutine ebend(etheta)
4655 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4656 C angles gamma and its derivatives in consecutive thetas and gammas.
4658 implicit real*8 (a-h,o-z)
4659 include 'DIMENSIONS'
4660 include 'COMMON.LOCAL'
4661 include 'COMMON.GEO'
4662 include 'COMMON.INTERACT'
4663 include 'COMMON.DERIV'
4664 include 'COMMON.VAR'
4665 include 'COMMON.CHAIN'
4666 include 'COMMON.IOUNITS'
4667 include 'COMMON.NAMES'
4668 include 'COMMON.FFIELD'
4669 include 'COMMON.CONTROL'
4670 common /calcthet/ term1,term2,termm,diffak,ratak,
4671 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4672 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4673 double precision y(2),z(2)
4675 c time11=dexp(-2*time)
4678 c write (*,'(a,i2)') 'EBEND ICG=',icg
4679 do i=ithet_start,ithet_end
4680 C Zero the energy function and its derivative at 0 or pi.
4681 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4686 if (phii.ne.phii) phii=150.0
4699 if (phii1.ne.phii1) phii1=150.0
4711 C Calculate the "mean" value of theta from the part of the distribution
4712 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4713 C In following comments this theta will be referred to as t_c.
4714 thet_pred_mean=0.0d0
4718 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4720 dthett=thet_pred_mean*ssd
4721 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4722 C Derivatives of the "mean" values in gamma1 and gamma2.
4723 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4724 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4725 if (theta(i).gt.pi-delta) then
4726 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4728 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4729 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4730 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4732 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4734 else if (theta(i).lt.delta) then
4735 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4736 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4737 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4739 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4740 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4743 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4746 etheta=etheta+ethetai
4747 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4749 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4750 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4751 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4753 C Ufff.... We've done all this!!!
4756 C---------------------------------------------------------------------------
4757 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4759 implicit real*8 (a-h,o-z)
4760 include 'DIMENSIONS'
4761 include 'COMMON.LOCAL'
4762 include 'COMMON.IOUNITS'
4763 common /calcthet/ term1,term2,termm,diffak,ratak,
4764 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4765 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4766 C Calculate the contributions to both Gaussian lobes.
4767 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4768 C The "polynomial part" of the "standard deviation" of this part of
4772 sig=sig*thet_pred_mean+polthet(j,it)
4774 C Derivative of the "interior part" of the "standard deviation of the"
4775 C gamma-dependent Gaussian lobe in t_c.
4776 sigtc=3*polthet(3,it)
4778 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4781 C Set the parameters of both Gaussian lobes of the distribution.
4782 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4783 fac=sig*sig+sigc0(it)
4786 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4787 sigsqtc=-4.0D0*sigcsq*sigtc
4788 c print *,i,sig,sigtc,sigsqtc
4789 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4790 sigtc=-sigtc/(fac*fac)
4791 C Following variable is sigma(t_c)**(-2)
4792 sigcsq=sigcsq*sigcsq
4794 sig0inv=1.0D0/sig0i**2
4795 delthec=thetai-thet_pred_mean
4796 delthe0=thetai-theta0i
4797 term1=-0.5D0*sigcsq*delthec*delthec
4798 term2=-0.5D0*sig0inv*delthe0*delthe0
4799 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4800 C NaNs in taking the logarithm. We extract the largest exponent which is added
4801 C to the energy (this being the log of the distribution) at the end of energy
4802 C term evaluation for this virtual-bond angle.
4803 if (term1.gt.term2) then
4805 term2=dexp(term2-termm)
4809 term1=dexp(term1-termm)
4812 C The ratio between the gamma-independent and gamma-dependent lobes of
4813 C the distribution is a Gaussian function of thet_pred_mean too.
4814 diffak=gthet(2,it)-thet_pred_mean
4815 ratak=diffak/gthet(3,it)**2
4816 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4817 C Let's differentiate it in thet_pred_mean NOW.
4819 C Now put together the distribution terms to make complete distribution.
4820 termexp=term1+ak*term2
4821 termpre=sigc+ak*sig0i
4822 C Contribution of the bending energy from this theta is just the -log of
4823 C the sum of the contributions from the two lobes and the pre-exponential
4824 C factor. Simple enough, isn't it?
4825 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4826 C NOW the derivatives!!!
4827 C 6/6/97 Take into account the deformation.
4828 E_theta=(delthec*sigcsq*term1
4829 & +ak*delthe0*sig0inv*term2)/termexp
4830 E_tc=((sigtc+aktc*sig0i)/termpre
4831 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4832 & aktc*term2)/termexp)
4835 c-----------------------------------------------------------------------------
4836 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4837 implicit real*8 (a-h,o-z)
4838 include 'DIMENSIONS'
4839 include 'COMMON.LOCAL'
4840 include 'COMMON.IOUNITS'
4841 common /calcthet/ term1,term2,termm,diffak,ratak,
4842 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4843 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4844 delthec=thetai-thet_pred_mean
4845 delthe0=thetai-theta0i
4846 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4847 t3 = thetai-thet_pred_mean
4851 t14 = t12+t6*sigsqtc
4853 t21 = thetai-theta0i
4859 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4860 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4861 & *(-t12*t9-ak*sig0inv*t27)
4865 C--------------------------------------------------------------------------
4866 subroutine ebend(etheta)
4868 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4869 C angles gamma and its derivatives in consecutive thetas and gammas.
4870 C ab initio-derived potentials from
4871 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4873 implicit real*8 (a-h,o-z)
4874 include 'DIMENSIONS'
4875 include 'COMMON.LOCAL'
4876 include 'COMMON.GEO'
4877 include 'COMMON.INTERACT'
4878 include 'COMMON.DERIV'
4879 include 'COMMON.VAR'
4880 include 'COMMON.CHAIN'
4881 include 'COMMON.IOUNITS'
4882 include 'COMMON.NAMES'
4883 include 'COMMON.FFIELD'
4884 include 'COMMON.CONTROL'
4885 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4886 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4887 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4888 & sinph1ph2(maxdouble,maxdouble)
4889 logical lprn /.false./, lprn1 /.false./
4891 c write (iout,*) "EBEND ithet_start",ithet_start,
4892 c & " ithet_end",ithet_end
4893 do i=ithet_start,ithet_end
4894 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4895 &(itype(i).eq.ntyp1)) cycle
4899 theti2=0.5d0*theta(i)
4900 ityp2=ithetyp(itype(i-1))
4902 coskt(k)=dcos(k*theti2)
4903 sinkt(k)=dsin(k*theti2)
4906 if (i.gt.3 .and. itype(imax0(i-3,1)).ne.ntyp1) then
4909 if (phii.ne.phii) phii=150.0
4913 ityp1=ithetyp(itype(i-2))
4915 cosph1(k)=dcos(k*phii)
4916 sinph1(k)=dsin(k*phii)
4920 ityp1=ithetyp(itype(i-2))
4926 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4929 if (phii1.ne.phii1) phii1=150.0
4934 ityp3=ithetyp(itype(i))
4936 cosph2(k)=dcos(k*phii1)
4937 sinph2(k)=dsin(k*phii1)
4941 ityp3=ithetyp(itype(i))
4947 ethetai=aa0thet(ityp1,ityp2,ityp3)
4950 ccl=cosph1(l)*cosph2(k-l)
4951 ssl=sinph1(l)*sinph2(k-l)
4952 scl=sinph1(l)*cosph2(k-l)
4953 csl=cosph1(l)*sinph2(k-l)
4954 cosph1ph2(l,k)=ccl-ssl
4955 cosph1ph2(k,l)=ccl+ssl
4956 sinph1ph2(l,k)=scl+csl
4957 sinph1ph2(k,l)=scl-csl
4961 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4962 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4963 write (iout,*) "coskt and sinkt"
4965 write (iout,*) k,coskt(k),sinkt(k)
4969 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4970 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4973 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4974 & " ethetai",ethetai
4977 write (iout,*) "cosph and sinph"
4979 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4981 write (iout,*) "cosph1ph2 and sinph2ph2"
4984 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4985 & sinph1ph2(l,k),sinph1ph2(k,l)
4988 write(iout,*) "ethetai",ethetai
4992 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4993 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4994 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4995 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4996 ethetai=ethetai+sinkt(m)*aux
4997 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4998 dephii=dephii+k*sinkt(m)*(
4999 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5000 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5001 dephii1=dephii1+k*sinkt(m)*(
5002 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5003 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5005 & write (iout,*) "m",m," k",k," bbthet",
5006 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5007 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5008 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5009 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5013 & write(iout,*) "ethetai",ethetai
5017 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5018 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5019 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5020 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5021 ethetai=ethetai+sinkt(m)*aux
5022 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5023 dephii=dephii+l*sinkt(m)*(
5024 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5025 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5026 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5027 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5028 dephii1=dephii1+(k-l)*sinkt(m)*(
5029 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5030 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5031 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5032 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5034 write (iout,*) "m",m," k",k," l",l," ffthet",
5035 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5036 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5037 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5038 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5039 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5040 & cosph1ph2(k,l)*sinkt(m),
5041 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5048 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5049 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5050 & phii1*rad2deg,ethetai
5052 etheta=etheta+ethetai
5053 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5055 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5056 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5057 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5063 c-----------------------------------------------------------------------------
5064 subroutine esc(escloc)
5065 C Calculate the local energy of a side chain and its derivatives in the
5066 C corresponding virtual-bond valence angles THETA and the spherical angles
5068 implicit real*8 (a-h,o-z)
5069 include 'DIMENSIONS'
5070 include 'COMMON.GEO'
5071 include 'COMMON.LOCAL'
5072 include 'COMMON.VAR'
5073 include 'COMMON.INTERACT'
5074 include 'COMMON.DERIV'
5075 include 'COMMON.CHAIN'
5076 include 'COMMON.IOUNITS'
5077 include 'COMMON.NAMES'
5078 include 'COMMON.FFIELD'
5079 include 'COMMON.CONTROL'
5080 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5081 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5082 common /sccalc/ time11,time12,time112,theti,it,nlobit
5085 c write (iout,'(a)') 'ESC'
5086 do i=loc_start,loc_end
5088 if (it.eq.10) goto 1
5090 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5091 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5092 theti=theta(i+1)-pipol
5097 if (x(2).gt.pi-delta) then
5101 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5103 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5104 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5106 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5107 & ddersc0(1),dersc(1))
5108 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5109 & ddersc0(3),dersc(3))
5111 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5113 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5114 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5115 & dersc0(2),esclocbi,dersc02)
5116 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5118 call splinthet(x(2),0.5d0*delta,ss,ssd)
5123 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5125 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5126 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5128 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5130 c write (iout,*) escloci
5131 else if (x(2).lt.delta) then
5135 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5137 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5138 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5140 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5141 & ddersc0(1),dersc(1))
5142 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5143 & ddersc0(3),dersc(3))
5145 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5147 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5148 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5149 & dersc0(2),esclocbi,dersc02)
5150 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5155 call splinthet(x(2),0.5d0*delta,ss,ssd)
5157 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5159 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5160 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5162 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5163 c write (iout,*) escloci
5165 call enesc(x,escloci,dersc,ddummy,.false.)
5168 escloc=escloc+escloci
5169 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5170 & 'escloc',i,escloci
5171 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5173 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5175 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5176 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5181 C---------------------------------------------------------------------------
5182 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5183 implicit real*8 (a-h,o-z)
5184 include 'DIMENSIONS'
5185 include 'COMMON.GEO'
5186 include 'COMMON.LOCAL'
5187 include 'COMMON.IOUNITS'
5188 common /sccalc/ time11,time12,time112,theti,it,nlobit
5189 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5190 double precision contr(maxlob,-1:1)
5192 c write (iout,*) 'it=',it,' nlobit=',nlobit
5196 if (mixed) ddersc(j)=0.0d0
5200 C Because of periodicity of the dependence of the SC energy in omega we have
5201 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5202 C To avoid underflows, first compute & store the exponents.
5210 z(k)=x(k)-censc(k,j,it)
5215 Axk=Axk+gaussc(l,k,j,it)*z(l)
5221 expfac=expfac+Ax(k,j,iii)*z(k)
5229 C As in the case of ebend, we want to avoid underflows in exponentiation and
5230 C subsequent NaNs and INFs in energy calculation.
5231 C Find the largest exponent
5235 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5239 cd print *,'it=',it,' emin=',emin
5241 C Compute the contribution to SC energy and derivatives
5246 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5247 if(adexp.ne.adexp) adexp=1.0
5250 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5252 cd print *,'j=',j,' expfac=',expfac
5253 escloc_i=escloc_i+expfac
5255 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5259 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5260 & +gaussc(k,2,j,it))*expfac
5267 dersc(1)=dersc(1)/cos(theti)**2
5268 ddersc(1)=ddersc(1)/cos(theti)**2
5271 escloci=-(dlog(escloc_i)-emin)
5273 dersc(j)=dersc(j)/escloc_i
5277 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5282 C------------------------------------------------------------------------------
5283 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5284 implicit real*8 (a-h,o-z)
5285 include 'DIMENSIONS'
5286 include 'COMMON.GEO'
5287 include 'COMMON.LOCAL'
5288 include 'COMMON.IOUNITS'
5289 common /sccalc/ time11,time12,time112,theti,it,nlobit
5290 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5291 double precision contr(maxlob)
5302 z(k)=x(k)-censc(k,j,it)
5308 Axk=Axk+gaussc(l,k,j,it)*z(l)
5314 expfac=expfac+Ax(k,j)*z(k)
5319 C As in the case of ebend, we want to avoid underflows in exponentiation and
5320 C subsequent NaNs and INFs in energy calculation.
5321 C Find the largest exponent
5324 if (emin.gt.contr(j)) emin=contr(j)
5328 C Compute the contribution to SC energy and derivatives
5332 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5333 escloc_i=escloc_i+expfac
5335 dersc(k)=dersc(k)+Ax(k,j)*expfac
5337 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5338 & +gaussc(1,2,j,it))*expfac
5342 dersc(1)=dersc(1)/cos(theti)**2
5343 dersc12=dersc12/cos(theti)**2
5344 escloci=-(dlog(escloc_i)-emin)
5346 dersc(j)=dersc(j)/escloc_i
5348 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5352 c----------------------------------------------------------------------------------
5353 subroutine esc(escloc)
5354 C Calculate the local energy of a side chain and its derivatives in the
5355 C corresponding virtual-bond valence angles THETA and the spherical angles
5356 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5357 C added by Urszula Kozlowska. 07/11/2007
5359 implicit real*8 (a-h,o-z)
5360 include 'DIMENSIONS'
5361 include 'COMMON.GEO'
5362 include 'COMMON.LOCAL'
5363 include 'COMMON.VAR'
5364 include 'COMMON.SCROT'
5365 include 'COMMON.INTERACT'
5366 include 'COMMON.DERIV'
5367 include 'COMMON.CHAIN'
5368 include 'COMMON.IOUNITS'
5369 include 'COMMON.NAMES'
5370 include 'COMMON.FFIELD'
5371 include 'COMMON.CONTROL'
5372 include 'COMMON.VECTORS'
5373 double precision x_prime(3),y_prime(3),z_prime(3)
5374 & , sumene,dsc_i,dp2_i,x(65),
5375 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5376 & de_dxx,de_dyy,de_dzz,de_dt
5377 double precision s1_t,s1_6_t,s2_t,s2_6_t
5379 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5380 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5381 & dt_dCi(3),dt_dCi1(3)
5382 common /sccalc/ time11,time12,time112,theti,it,nlobit
5385 c write(iout,*) "ESC: loc_start",loc_start," loc_end",loc_end
5386 do i=loc_start,loc_end
5387 costtab(i+1) =dcos(theta(i+1))
5388 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5389 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5390 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5391 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5392 cosfac=dsqrt(cosfac2)
5393 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5394 sinfac=dsqrt(sinfac2)
5396 if (it.eq.10) goto 1
5398 C Compute the axes of tghe local cartesian coordinates system; store in
5399 c x_prime, y_prime and z_prime
5406 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5407 C & dc_norm(3,i+nres)
5409 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5410 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5413 z_prime(j) = -uz(j,i-1)
5416 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5417 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5418 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5419 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5420 c & " xy",scalar(x_prime(1),y_prime(1)),
5421 c & " xz",scalar(x_prime(1),z_prime(1)),
5422 c & " yy",scalar(y_prime(1),y_prime(1)),
5423 c & " yz",scalar(y_prime(1),z_prime(1)),
5424 c & " zz",scalar(z_prime(1),z_prime(1))
5426 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5427 C to local coordinate system. Store in xx, yy, zz.
5433 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5434 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5435 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5442 C Compute the energy of the ith side cbain
5444 c write (2,*) "xx",xx," yy",yy," zz",zz
5447 x(j) = sc_parmin(j,it)
5450 Cc diagnostics - remove later
5452 yy1 = dsin(alph(2))*dcos(omeg(2))
5453 zz1 = -dsin(alph(2))*dsin(omeg(2))
5454 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5455 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5457 C," --- ", xx_w,yy_w,zz_w
5460 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5461 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5463 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5464 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5466 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5467 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5468 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5469 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5470 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5472 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5473 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5474 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5475 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5476 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5478 dsc_i = 0.743d0+x(61)
5480 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5481 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5482 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5483 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5484 s1=(1+x(63))/(0.1d0 + dscp1)
5485 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5486 s2=(1+x(65))/(0.1d0 + dscp2)
5487 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5488 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5489 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5490 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5492 c & dscp1,dscp2,sumene
5493 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5494 escloc = escloc + sumene
5495 c write (2,*) "i",i," escloc",sumene,escloc
5498 C This section to check the numerical derivatives of the energy of ith side
5499 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5500 C #define DEBUG in the code to turn it on.
5502 write (2,*) "sumene =",sumene
5506 write (2,*) xx,yy,zz
5507 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5508 de_dxx_num=(sumenep-sumene)/aincr
5510 write (2,*) "xx+ sumene from enesc=",sumenep
5513 write (2,*) xx,yy,zz
5514 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5515 de_dyy_num=(sumenep-sumene)/aincr
5517 write (2,*) "yy+ sumene from enesc=",sumenep
5520 write (2,*) xx,yy,zz
5521 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5522 de_dzz_num=(sumenep-sumene)/aincr
5524 write (2,*) "zz+ sumene from enesc=",sumenep
5525 costsave=cost2tab(i+1)
5526 sintsave=sint2tab(i+1)
5527 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5528 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5529 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5530 de_dt_num=(sumenep-sumene)/aincr
5531 write (2,*) " t+ sumene from enesc=",sumenep
5532 cost2tab(i+1)=costsave
5533 sint2tab(i+1)=sintsave
5534 C End of diagnostics section.
5537 C Compute the gradient of esc
5539 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5540 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5541 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5542 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5543 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5544 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5545 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5546 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5547 pom1=(sumene3*sint2tab(i+1)+sumene1)
5548 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5549 pom2=(sumene4*cost2tab(i+1)+sumene2)
5550 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5551 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5552 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5553 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5555 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5556 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5557 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5559 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5560 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5561 & +(pom1+pom2)*pom_dx
5563 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5566 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5567 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5568 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5570 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5571 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5572 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5573 & +x(59)*zz**2 +x(60)*xx*zz
5574 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5575 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5576 & +(pom1-pom2)*pom_dy
5578 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5581 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5582 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5583 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5584 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5585 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5586 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5587 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5588 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5590 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5593 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5594 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5595 & +pom1*pom_dt1+pom2*pom_dt2
5597 write(2,*), "de_dt = ", de_dt,de_dt_num
5601 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5602 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5603 cosfac2xx=cosfac2*xx
5604 sinfac2yy=sinfac2*yy
5606 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5608 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5610 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5611 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5612 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5613 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5614 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5615 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5616 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5617 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5618 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5619 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5623 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5624 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5627 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5628 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5629 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5631 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5632 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5636 dXX_Ctab(k,i)=dXX_Ci(k)
5637 dXX_C1tab(k,i)=dXX_Ci1(k)
5638 dYY_Ctab(k,i)=dYY_Ci(k)
5639 dYY_C1tab(k,i)=dYY_Ci1(k)
5640 dZZ_Ctab(k,i)=dZZ_Ci(k)
5641 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5642 dXX_XYZtab(k,i)=dXX_XYZ(k)
5643 dYY_XYZtab(k,i)=dYY_XYZ(k)
5644 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5648 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5649 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5650 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5651 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5652 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5654 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5655 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5656 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5657 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5658 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5659 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5660 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5661 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5663 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5664 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5666 C to check gradient call subroutine check_grad
5672 c------------------------------------------------------------------------------
5673 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5675 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5676 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5677 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5678 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5680 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5681 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5683 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5684 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5685 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5686 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5687 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5689 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5690 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5691 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5692 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5693 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5695 dsc_i = 0.743d0+x(61)
5697 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5698 & *(xx*cost2+yy*sint2))
5699 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5700 & *(xx*cost2-yy*sint2))
5701 s1=(1+x(63))/(0.1d0 + dscp1)
5702 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5703 s2=(1+x(65))/(0.1d0 + dscp2)
5704 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5705 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5706 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5711 c------------------------------------------------------------------------------
5712 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5714 C This procedure calculates two-body contact function g(rij) and its derivative:
5717 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5720 C where x=(rij-r0ij)/delta
5722 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5725 double precision rij,r0ij,eps0ij,fcont,fprimcont
5726 double precision x,x2,x4,delta
5730 if (x.lt.-1.0D0) then
5733 else if (x.le.1.0D0) then
5736 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5737 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5744 c------------------------------------------------------------------------------
5745 subroutine splinthet(theti,delta,ss,ssder)
5746 implicit real*8 (a-h,o-z)
5747 include 'DIMENSIONS'
5748 include 'COMMON.VAR'
5749 include 'COMMON.GEO'
5752 if (theti.gt.pipol) then
5753 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5755 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5760 c------------------------------------------------------------------------------
5761 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5763 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5764 double precision ksi,ksi2,ksi3,a1,a2,a3
5765 a1=fprim0*delta/(f1-f0)
5771 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5772 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5775 c------------------------------------------------------------------------------
5776 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5778 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5779 double precision ksi,ksi2,ksi3,a1,a2,a3
5784 a2=3*(f1x-f0x)-2*fprim0x*delta
5785 a3=fprim0x*delta-2*(f1x-f0x)
5786 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5789 C-----------------------------------------------------------------------------
5791 C-----------------------------------------------------------------------------
5792 subroutine etor(etors,edihcnstr)
5793 implicit real*8 (a-h,o-z)
5794 include 'DIMENSIONS'
5795 include 'COMMON.VAR'
5796 include 'COMMON.GEO'
5797 include 'COMMON.LOCAL'
5798 include 'COMMON.TORSION'
5799 include 'COMMON.INTERACT'
5800 include 'COMMON.DERIV'
5801 include 'COMMON.CHAIN'
5802 include 'COMMON.NAMES'
5803 include 'COMMON.IOUNITS'
5804 include 'COMMON.FFIELD'
5805 include 'COMMON.TORCNSTR'
5806 include 'COMMON.CONTROL'
5808 C Set lprn=.true. for debugging
5812 do i=iphi_start,iphi_end
5814 itori=itortyp(itype(i-2))
5815 itori1=itortyp(itype(i-1))
5818 C Proline-Proline pair is a special case...
5819 if (itori.eq.3 .and. itori1.eq.3) then
5820 if (phii.gt.-dwapi3) then
5822 fac=1.0D0/(1.0D0-cosphi)
5823 etorsi=v1(1,3,3)*fac
5824 etorsi=etorsi+etorsi
5825 etors=etors+etorsi-v1(1,3,3)
5826 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5827 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5830 v1ij=v1(j+1,itori,itori1)
5831 v2ij=v2(j+1,itori,itori1)
5834 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5835 if (energy_dec) etors_ii=etors_ii+
5836 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5837 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5841 v1ij=v1(j,itori,itori1)
5842 v2ij=v2(j,itori,itori1)
5845 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5846 if (energy_dec) etors_ii=etors_ii+
5847 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5848 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5851 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5854 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5855 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5856 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5857 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5858 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5860 ! 6/20/98 - dihedral angle constraints
5863 itori=idih_constr(i)
5866 if (difi.gt.drange(i)) then
5868 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5869 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5870 else if (difi.lt.-drange(i)) then
5872 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5873 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5875 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5876 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5878 ! write (iout,*) 'edihcnstr',edihcnstr
5881 c------------------------------------------------------------------------------
5882 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5883 subroutine e_modeller(ehomology_constr)
5884 ehomology_constr=0.0d0
5885 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5888 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5890 c------------------------------------------------------------------------------
5891 subroutine etor_d(etors_d)
5895 c----------------------------------------------------------------------------
5897 subroutine etor(etors,edihcnstr)
5898 implicit real*8 (a-h,o-z)
5899 include 'DIMENSIONS'
5900 include 'COMMON.VAR'
5901 include 'COMMON.GEO'
5902 include 'COMMON.LOCAL'
5903 include 'COMMON.TORSION'
5904 include 'COMMON.INTERACT'
5905 include 'COMMON.DERIV'
5906 include 'COMMON.CHAIN'
5907 include 'COMMON.NAMES'
5908 include 'COMMON.IOUNITS'
5909 include 'COMMON.FFIELD'
5910 include 'COMMON.TORCNSTR'
5911 include 'COMMON.CONTROL'
5913 C Set lprn=.true. for debugging
5917 do i=iphi_start,iphi_end
5919 itori=itortyp(itype(i-2))
5920 itori1=itortyp(itype(i-1))
5923 C Regular cosine and sine terms
5924 do j=1,nterm(itori,itori1)
5925 v1ij=v1(j,itori,itori1)
5926 v2ij=v2(j,itori,itori1)
5929 etors=etors+v1ij*cosphi+v2ij*sinphi
5930 if (energy_dec) etors_ii=etors_ii+
5931 & v1ij*cosphi+v2ij*sinphi
5932 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5936 C E = SUM ----------------------------------- - v1
5937 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5939 cosphi=dcos(0.5d0*phii)
5940 sinphi=dsin(0.5d0*phii)
5941 do j=1,nlor(itori,itori1)
5942 vl1ij=vlor1(j,itori,itori1)
5943 vl2ij=vlor2(j,itori,itori1)
5944 vl3ij=vlor3(j,itori,itori1)
5945 pom=vl2ij*cosphi+vl3ij*sinphi
5946 pom1=1.0d0/(pom*pom+1.0d0)
5947 etors=etors+vl1ij*pom1
5948 if (energy_dec) etors_ii=etors_ii+
5951 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5953 C Subtract the constant term
5954 etors=etors-v0(itori,itori1)
5955 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5956 & 'etor',i,etors_ii-v0(itori,itori1)
5958 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5959 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5960 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5961 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5962 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5964 ! 6/20/98 - dihedral angle constraints
5966 c do i=1,ndih_constr
5967 do i=idihconstr_start,idihconstr_end
5968 itori=idih_constr(i)
5970 difi=pinorm(phii-phi0(i))
5971 if (difi.gt.drange(i)) then
5973 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5974 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5975 else if (difi.lt.-drange(i)) then
5977 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5978 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5982 c write (iout,*) "gloci", gloc(i-3,icg)
5983 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5984 cd & rad2deg*phi0(i), rad2deg*drange(i),
5985 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5987 cd write (iout,*) 'edihcnstr',edihcnstr
5990 c----------------------------------------------------------------------------
5991 c MODELLER restraint function
5992 subroutine e_modeller(ehomology_constr)
5993 implicit real*8 (a-h,o-z)
5994 include 'DIMENSIONS'
5996 integer nnn, i, j, k, ki, irec, l
5997 integer katy, odleglosci, test7
5998 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6000 real*8 distance(max_template),distancek(max_template),
6001 & min_odl,godl(max_template),dih_diff(max_template)
6004 c FP - 30/10/2014 Temporary specifications for homology restraints
6006 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6008 double precision, dimension (maxres) :: guscdiff,usc_diff
6009 double precision, dimension (max_template) ::
6010 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6014 include 'COMMON.SBRIDGE'
6015 include 'COMMON.CHAIN'
6016 include 'COMMON.GEO'
6017 include 'COMMON.DERIV'
6018 include 'COMMON.LOCAL'
6019 include 'COMMON.INTERACT'
6020 include 'COMMON.VAR'
6021 include 'COMMON.IOUNITS'
6023 include 'COMMON.CONTROL'
6025 c From subroutine Econstr_back
6027 include 'COMMON.NAMES'
6028 include 'COMMON.TIME1'
6033 distancek(i)=9999999.9
6039 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6041 C AL 5/2/14 - Introduce list of restraints
6042 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6044 write(iout,*) "------- dist restrs start -------"
6046 do ii = link_start_homo,link_end_homo
6050 c write (iout,*) "dij(",i,j,") =",dij
6051 do k=1,constr_homology
6052 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6053 if(.not.l_homo(k,ii)) cycle
6054 distance(k)=odl(k,ii)-dij
6055 c write (iout,*) "distance(",k,") =",distance(k)
6057 c For Gaussian-type Urestr
6059 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6060 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6061 c write (iout,*) "distancek(",k,") =",distancek(k)
6062 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6064 c For Lorentzian-type Urestr
6066 if (waga_dist.lt.0.0d0) then
6067 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6068 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6069 & (distance(k)**2+sigma_odlir(k,ii)**2))
6074 c min_odl=minval(distancek)
6075 do kk=1,constr_homology
6076 if(l_homo(kk,ii)) then
6077 min_odl=distancek(kk)
6081 do kk=1,constr_homology
6082 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
6083 & min_odl=distancek(kk)
6085 c write (iout,* )"min_odl",min_odl
6087 write (iout,*) "ij dij",i,j,dij
6088 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6089 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6090 write (iout,* )"min_odl",min_odl
6093 do k=1,constr_homology
6094 c Nie wiem po co to liczycie jeszcze raz!
6095 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6096 c & (2*(sigma_odl(i,j,k))**2))
6097 if(.not.l_homo(k,ii)) cycle
6098 if (waga_dist.ge.0.0d0) then
6100 c For Gaussian-type Urestr
6102 godl(k)=dexp(-distancek(k)+min_odl)
6103 odleg2=odleg2+godl(k)
6105 c For Lorentzian-type Urestr
6108 odleg2=odleg2+distancek(k)
6111 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6112 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6113 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6114 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6117 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6118 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6120 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6121 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6123 if (waga_dist.ge.0.0d0) then
6125 c For Gaussian-type Urestr
6127 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6129 c For Lorentzian-type Urestr
6132 odleg=odleg+odleg2/constr_homology
6135 c write (iout,*) "odleg",odleg ! sum of -ln-s
6138 c For Gaussian-type Urestr
6140 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6142 do k=1,constr_homology
6143 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6144 c & *waga_dist)+min_odl
6145 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6147 if(.not.l_homo(k,ii)) cycle
6148 if (waga_dist.ge.0.0d0) then
6149 c For Gaussian-type Urestr
6151 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6153 c For Lorentzian-type Urestr
6156 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6157 & sigma_odlir(k,ii)**2)**2)
6159 sum_sgodl=sum_sgodl+sgodl
6161 c sgodl2=sgodl2+sgodl
6162 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6163 c write(iout,*) "constr_homology=",constr_homology
6164 c write(iout,*) i, j, k, "TEST K"
6166 if (waga_dist.ge.0.0d0) then
6168 c For Gaussian-type Urestr
6170 grad_odl3=waga_homology(iset)*waga_dist
6171 & *sum_sgodl/(sum_godl*dij)
6173 c For Lorentzian-type Urestr
6176 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6177 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6178 grad_odl3=-waga_homology(iset)*waga_dist*
6179 & sum_sgodl/(constr_homology*dij)
6182 c grad_odl3=sum_sgodl/(sum_godl*dij)
6185 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6186 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6187 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6189 ccc write(iout,*) godl, sgodl, grad_odl3
6191 c grad_odl=grad_odl+grad_odl3
6194 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6195 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6196 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6197 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6198 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6199 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6200 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6201 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6202 c if (i.eq.25.and.j.eq.27) then
6203 c write(iout,*) "jik",jik,"i",i,"j",j
6204 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
6205 c write(iout,*) "grad_odl3",grad_odl3
6206 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
6207 c write(iout,*) "ggodl",ggodl
6208 c write(iout,*) "ghpbc(",jik,i,")",
6209 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
6213 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6214 ccc & dLOG(odleg2),"-odleg=", -odleg
6216 enddo ! ii-loop for dist
6218 write(iout,*) "------- dist restrs end -------"
6219 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
6220 c & waga_d.eq.1.0d0) call sum_gradient
6222 c Pseudo-energy and gradient from dihedral-angle restraints from
6223 c homology templates
6224 c write (iout,*) "End of distance loop"
6227 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6229 write(iout,*) "------- dih restrs start -------"
6230 do i=idihconstr_start_homo,idihconstr_end_homo
6231 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
6234 do i=idihconstr_start_homo,idihconstr_end_homo
6236 c betai=beta(i,i+1,i+2,i+3)
6238 c write (iout,*) "betai =",betai
6239 do k=1,constr_homology
6240 dih_diff(k)=pinorm(dih(k,i)-betai)
6241 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
6242 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6243 c & -(6.28318-dih_diff(i,k))
6244 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6245 c & 6.28318+dih_diff(i,k)
6247 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6248 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
6251 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6254 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
6255 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
6257 write (iout,*) "i",i," betai",betai," kat2",kat2
6258 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6260 if (kat2.le.1.0d-14) cycle
6261 kat=kat-dLOG(kat2/constr_homology)
6262 c write (iout,*) "kat",kat ! sum of -ln-s
6264 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6265 ccc & dLOG(kat2), "-kat=", -kat
6267 c ----------------------------------------------------------------------
6269 c ----------------------------------------------------------------------
6273 do k=1,constr_homology
6274 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
6275 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
6276 sum_sgdih=sum_sgdih+sgdih
6278 c grad_dih3=sum_sgdih/sum_gdih
6279 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
6281 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6282 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6283 ccc & gloc(nphi+i-3,icg)
6284 gloc(i,icg)=gloc(i,icg)+grad_dih3
6286 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
6288 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6289 ccc & gloc(nphi+i-3,icg)
6291 enddo ! i-loop for dih
6293 write(iout,*) "------- dih restrs end -------"
6296 c Pseudo-energy and gradient for theta angle restraints from
6297 c homology templates
6298 c FP 01/15 - inserted from econstr_local_test.F, loop structure
6302 c For constr_homology reference structures (FP)
6304 c Uconst_back_tot=0.0d0
6307 c Econstr_back legacy
6309 c do i=ithet_start,ithet_end
6312 c do i=loc_start,loc_end
6315 duscdiffx(j,i)=0.0d0
6320 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
6321 c write (iout,*) "waga_theta",waga_theta
6322 if (waga_theta.gt.0.0d0) then
6324 write (iout,*) "usampl",usampl
6325 write(iout,*) "------- theta restrs start -------"
6326 c do i=ithet_start,ithet_end
6327 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
6330 c write (iout,*) "maxres",maxres,"nres",nres
6332 do i=ithet_start,ithet_end
6335 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
6337 c Deviation of theta angles wrt constr_homology ref structures
6339 utheta_i=0.0d0 ! argument of Gaussian for single k
6340 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6341 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
6342 c over residues in a fragment
6343 c write (iout,*) "theta(",i,")=",theta(i)
6344 do k=1,constr_homology
6346 c dtheta_i=theta(j)-thetaref(j,iref)
6347 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
6348 theta_diff(k)=thetatpl(k,i)-theta(i)
6350 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
6351 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
6352 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
6353 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
6354 c Gradient for single Gaussian restraint in subr Econstr_back
6355 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
6358 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
6359 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
6362 c Gradient for multiple Gaussian restraint
6363 sum_gtheta=gutheta_i
6365 do k=1,constr_homology
6366 c New generalized expr for multiple Gaussian from Econstr_back
6367 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
6369 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
6370 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
6372 c Final value of gradient using same var as in Econstr_back
6373 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
6374 & +sum_sgtheta/sum_gtheta*waga_theta
6375 & *waga_homology(iset)
6376 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
6377 c & *waga_homology(iset)
6378 c dutheta(i)=sum_sgtheta/sum_gtheta
6380 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
6381 Eval=Eval-dLOG(gutheta_i/constr_homology)
6382 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
6383 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
6384 c Uconst_back=Uconst_back+utheta(i)
6385 enddo ! (i-loop for theta)
6387 write(iout,*) "------- theta restrs end -------"
6391 c Deviation of local SC geometry
6393 c Separation of two i-loops (instructed by AL - 11/3/2014)
6395 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
6396 c write (iout,*) "waga_d",waga_d
6399 write(iout,*) "------- SC restrs start -------"
6400 write (iout,*) "Initial duscdiff,duscdiffx"
6401 do i=loc_start,loc_end
6402 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
6403 & (duscdiffx(jik,i),jik=1,3)
6406 do i=loc_start,loc_end
6407 usc_diff_i=0.0d0 ! argument of Gaussian for single k
6408 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6409 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
6410 c write(iout,*) "xxtab, yytab, zztab"
6411 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
6412 do k=1,constr_homology
6414 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6415 c Original sign inverted for calc of gradients (s. Econstr_back)
6416 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6417 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6418 c write(iout,*) "dxx, dyy, dzz"
6419 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6421 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
6422 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
6423 c uscdiffk(k)=usc_diff(i)
6424 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
6425 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
6426 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
6427 c & xxref(j),yyref(j),zzref(j)
6432 c Generalized expression for multiple Gaussian acc to that for a single
6433 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
6435 c Original implementation
6436 c sum_guscdiff=guscdiff(i)
6438 c sum_sguscdiff=0.0d0
6439 c do k=1,constr_homology
6440 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
6441 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
6442 c sum_sguscdiff=sum_sguscdiff+sguscdiff
6445 c Implementation of new expressions for gradient (Jan. 2015)
6447 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
6448 do k=1,constr_homology
6450 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
6451 c before. Now the drivatives should be correct
6453 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6454 c Original sign inverted for calc of gradients (s. Econstr_back)
6455 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6456 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6458 c New implementation
6460 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
6461 & sigma_d(k,i) ! for the grad wrt r'
6462 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
6465 c New implementation
6466 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
6468 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
6469 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
6470 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
6471 duscdiff(jik,i)=duscdiff(jik,i)+
6472 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
6473 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
6474 duscdiffx(jik,i)=duscdiffx(jik,i)+
6475 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
6476 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
6479 write(iout,*) "jik",jik,"i",i
6480 write(iout,*) "dxx, dyy, dzz"
6481 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6482 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
6483 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
6484 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
6485 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
6486 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
6487 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
6488 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
6489 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
6490 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
6491 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
6492 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
6493 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
6494 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
6495 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
6501 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
6502 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
6504 c write (iout,*) i," uscdiff",uscdiff(i)
6506 c Put together deviations from local geometry
6508 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
6509 c & wfrag_back(3,i,iset)*uscdiff(i)
6510 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
6511 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
6512 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
6513 c Uconst_back=Uconst_back+usc_diff(i)
6515 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
6517 c New implment: multiplied by sum_sguscdiff
6520 enddo ! (i-loop for dscdiff)
6525 write(iout,*) "------- SC restrs end -------"
6526 write (iout,*) "------ After SC loop in e_modeller ------"
6527 do i=loc_start,loc_end
6528 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
6529 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
6531 if (waga_theta.eq.1.0d0) then
6532 write (iout,*) "in e_modeller after SC restr end: dutheta"
6533 do i=ithet_start,ithet_end
6534 write (iout,*) i,dutheta(i)
6537 if (waga_d.eq.1.0d0) then
6538 write (iout,*) "e_modeller after SC loop: duscdiff/x"
6540 write (iout,*) i,(duscdiff(j,i),j=1,3)
6541 write (iout,*) i,(duscdiffx(j,i),j=1,3)
6546 c Total energy from homology restraints
6548 write (iout,*) "odleg",odleg," kat",kat
6551 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
6553 c ehomology_constr=odleg+kat
6555 c For Lorentzian-type Urestr
6558 if (waga_dist.ge.0.0d0) then
6560 c For Gaussian-type Urestr
6562 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
6563 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6564 c write (iout,*) "ehomology_constr=",ehomology_constr
6567 c For Lorentzian-type Urestr
6569 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
6570 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6571 c write (iout,*) "ehomology_constr=",ehomology_constr
6574 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
6575 & "Eval",waga_theta,eval,
6576 & "Erot",waga_d,Erot
6577 write (iout,*) "ehomology_constr",ehomology_constr
6583 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6584 747 format(a12,i4,i4,i4,f8.3,f8.3)
6585 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6586 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6587 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6588 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6591 c------------------------------------------------------------------------------
6592 subroutine etor_d(etors_d)
6593 C 6/23/01 Compute double torsional energy
6594 implicit real*8 (a-h,o-z)
6595 include 'DIMENSIONS'
6596 include 'COMMON.VAR'
6597 include 'COMMON.GEO'
6598 include 'COMMON.LOCAL'
6599 include 'COMMON.TORSION'
6600 include 'COMMON.INTERACT'
6601 include 'COMMON.DERIV'
6602 include 'COMMON.CHAIN'
6603 include 'COMMON.NAMES'
6604 include 'COMMON.IOUNITS'
6605 include 'COMMON.FFIELD'
6606 include 'COMMON.TORCNSTR'
6607 include 'COMMON.CONTROL'
6609 C Set lprn=.true. for debugging
6613 do i=iphid_start,iphid_end
6615 itori=itortyp(itype(i-2))
6616 itori1=itortyp(itype(i-1))
6617 itori2=itortyp(itype(i))
6622 do j=1,ntermd_1(itori,itori1,itori2)
6623 v1cij=v1c(1,j,itori,itori1,itori2)
6624 v1sij=v1s(1,j,itori,itori1,itori2)
6625 v2cij=v1c(2,j,itori,itori1,itori2)
6626 v2sij=v1s(2,j,itori,itori1,itori2)
6627 cosphi1=dcos(j*phii)
6628 sinphi1=dsin(j*phii)
6629 cosphi2=dcos(j*phii1)
6630 sinphi2=dsin(j*phii1)
6631 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6632 & v2cij*cosphi2+v2sij*sinphi2
6633 if (energy_dec) etors_d_ii=etors_d_ii+
6634 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6635 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6636 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6638 do k=2,ntermd_2(itori,itori1,itori2)
6640 v1cdij = v2c(k,l,itori,itori1,itori2)
6641 v2cdij = v2c(l,k,itori,itori1,itori2)
6642 v1sdij = v2s(k,l,itori,itori1,itori2)
6643 v2sdij = v2s(l,k,itori,itori1,itori2)
6644 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6645 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6646 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6647 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6648 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6649 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6650 if (energy_dec) etors_d_ii=etors_d_ii+
6651 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6652 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6653 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6654 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6655 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6656 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6659 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6660 & 'etor_d',i,etors_d_ii
6661 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6662 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6663 c write (iout,*) "gloci", gloc(i-3,icg)
6668 c------------------------------------------------------------------------------
6669 subroutine eback_sc_corr(esccor)
6670 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6671 c conformational states; temporarily implemented as differences
6672 c between UNRES torsional potentials (dependent on three types of
6673 c residues) and the torsional potentials dependent on all 20 types
6674 c of residues computed from AM1 energy surfaces of terminally-blocked
6675 c amino-acid residues.
6676 implicit real*8 (a-h,o-z)
6677 include 'DIMENSIONS'
6678 include 'COMMON.VAR'
6679 include 'COMMON.GEO'
6680 include 'COMMON.LOCAL'
6681 include 'COMMON.TORSION'
6682 include 'COMMON.SCCOR'
6683 include 'COMMON.INTERACT'
6684 include 'COMMON.DERIV'
6685 include 'COMMON.CHAIN'
6686 include 'COMMON.NAMES'
6687 include 'COMMON.IOUNITS'
6688 include 'COMMON.FFIELD'
6689 include 'COMMON.CONTROL'
6691 C Set lprn=.true. for debugging
6694 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6696 do i=itau_start,itau_end
6698 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6699 isccori=isccortyp(itype(i-2))
6700 isccori1=isccortyp(itype(i-1))
6702 cccc Added 9 May 2012
6703 cc Tauangle is torsional engle depending on the value of first digit
6704 c(see comment below)
6705 cc Omicron is flat angle depending on the value of first digit
6706 c(see comment below)
6709 do intertyp=1,3 !intertyp
6710 cc Added 09 May 2012 (Adasko)
6711 cc Intertyp means interaction type of backbone mainchain correlation:
6712 c 1 = SC...Ca...Ca...Ca
6713 c 2 = Ca...Ca...Ca...SC
6714 c 3 = SC...Ca...Ca...SCi
6716 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6717 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6718 & (itype(i-1).eq.21)))
6719 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6720 & .or.(itype(i-2).eq.21)))
6721 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6722 & (itype(i-1).eq.21)))) cycle
6723 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6724 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6726 do j=1,nterm_sccor(isccori,isccori1)
6727 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6728 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6729 cosphi=dcos(j*tauangle(intertyp,i))
6730 sinphi=dsin(j*tauangle(intertyp,i))
6731 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6732 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6734 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6735 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6736 c &gloc_sc(intertyp,i-3,icg)
6738 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6739 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6740 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6741 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6742 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6746 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6750 c----------------------------------------------------------------------------
6751 subroutine multibody(ecorr)
6752 C This subroutine calculates multi-body contributions to energy following
6753 C the idea of Skolnick et al. If side chains I and J make a contact and
6754 C at the same time side chains I+1 and J+1 make a contact, an extra
6755 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6756 implicit real*8 (a-h,o-z)
6757 include 'DIMENSIONS'
6758 include 'COMMON.IOUNITS'
6759 include 'COMMON.DERIV'
6760 include 'COMMON.INTERACT'
6761 include 'COMMON.CONTACTS'
6762 double precision gx(3),gx1(3)
6765 C Set lprn=.true. for debugging
6769 write (iout,'(a)') 'Contact function values:'
6771 write (iout,'(i2,20(1x,i2,f10.5))')
6772 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6787 num_conti=num_cont(i)
6788 num_conti1=num_cont(i1)
6793 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6794 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6795 cd & ' ishift=',ishift
6796 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6797 C The system gains extra energy.
6798 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6799 endif ! j1==j+-ishift
6808 c------------------------------------------------------------------------------
6809 double precision function esccorr(i,j,k,l,jj,kk)
6810 implicit real*8 (a-h,o-z)
6811 include 'DIMENSIONS'
6812 include 'COMMON.IOUNITS'
6813 include 'COMMON.DERIV'
6814 include 'COMMON.INTERACT'
6815 include 'COMMON.CONTACTS'
6816 double precision gx(3),gx1(3)
6821 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6822 C Calculate the multi-body contribution to energy.
6823 C Calculate multi-body contributions to the gradient.
6824 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6825 cd & k,l,(gacont(m,kk,k),m=1,3)
6827 gx(m) =ekl*gacont(m,jj,i)
6828 gx1(m)=eij*gacont(m,kk,k)
6829 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6830 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6831 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6832 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6836 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6841 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6847 c------------------------------------------------------------------------------
6848 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6849 C This subroutine calculates multi-body contributions to hydrogen-bonding
6850 implicit real*8 (a-h,o-z)
6851 include 'DIMENSIONS'
6852 include 'COMMON.IOUNITS'
6855 parameter (max_cont=maxconts)
6856 parameter (max_dim=26)
6857 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6858 double precision zapas(max_dim,maxconts,max_fg_procs),
6859 & zapas_recv(max_dim,maxconts,max_fg_procs)
6860 common /przechowalnia/ zapas
6861 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6862 & status_array(MPI_STATUS_SIZE,maxconts*2)
6864 include 'COMMON.SETUP'
6865 include 'COMMON.FFIELD'
6866 include 'COMMON.DERIV'
6867 include 'COMMON.INTERACT'
6868 include 'COMMON.CONTACTS'
6869 include 'COMMON.CONTROL'
6870 include 'COMMON.LOCAL'
6871 double precision gx(3),gx1(3),time00
6874 C Set lprn=.true. for debugging
6879 if (nfgtasks.le.1) goto 30
6881 write (iout,'(a)') 'Contact function values before RECEIVE:'
6883 write (iout,'(2i3,50(1x,i2,f5.2))')
6884 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6885 & j=1,num_cont_hb(i))
6889 do i=1,ntask_cont_from
6892 do i=1,ntask_cont_to
6895 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6897 C Make the list of contacts to send to send to other procesors
6898 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6900 do i=iturn3_start,iturn3_end
6901 c write (iout,*) "make contact list turn3",i," num_cont",
6903 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6905 do i=iturn4_start,iturn4_end
6906 c write (iout,*) "make contact list turn4",i," num_cont",
6908 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6912 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6914 do j=1,num_cont_hb(i)
6917 iproc=iint_sent_local(k,jjc,ii)
6918 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6919 if (iproc.gt.0) then
6920 ncont_sent(iproc)=ncont_sent(iproc)+1
6921 nn=ncont_sent(iproc)
6923 zapas(2,nn,iproc)=jjc
6924 zapas(3,nn,iproc)=facont_hb(j,i)
6925 zapas(4,nn,iproc)=ees0p(j,i)
6926 zapas(5,nn,iproc)=ees0m(j,i)
6927 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6928 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6929 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6930 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6931 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6932 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6933 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6934 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6935 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6936 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6937 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6938 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6939 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6940 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6941 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6942 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6943 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6944 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6945 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6946 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6947 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6954 & "Numbers of contacts to be sent to other processors",
6955 & (ncont_sent(i),i=1,ntask_cont_to)
6956 write (iout,*) "Contacts sent"
6957 do ii=1,ntask_cont_to
6959 iproc=itask_cont_to(ii)
6960 write (iout,*) nn," contacts to processor",iproc,
6961 & " of CONT_TO_COMM group"
6963 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6971 CorrelID1=nfgtasks+fg_rank+1
6973 C Receive the numbers of needed contacts from other processors
6974 do ii=1,ntask_cont_from
6975 iproc=itask_cont_from(ii)
6977 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6978 & FG_COMM,req(ireq),IERR)
6980 c write (iout,*) "IRECV ended"
6982 C Send the number of contacts needed by other processors
6983 do ii=1,ntask_cont_to
6984 iproc=itask_cont_to(ii)
6986 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6987 & FG_COMM,req(ireq),IERR)
6989 c write (iout,*) "ISEND ended"
6990 c write (iout,*) "number of requests (nn)",ireq
6993 & call MPI_Waitall(ireq,req,status_array,ierr)
6995 c & "Numbers of contacts to be received from other processors",
6996 c & (ncont_recv(i),i=1,ntask_cont_from)
7000 do ii=1,ntask_cont_from
7001 iproc=itask_cont_from(ii)
7003 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7004 c & " of CONT_TO_COMM group"
7008 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7009 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7010 c write (iout,*) "ireq,req",ireq,req(ireq)
7013 C Send the contacts to processors that need them
7014 do ii=1,ntask_cont_to
7015 iproc=itask_cont_to(ii)
7017 c write (iout,*) nn," contacts to processor",iproc,
7018 c & " of CONT_TO_COMM group"
7021 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7022 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7023 c write (iout,*) "ireq,req",ireq,req(ireq)
7025 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7029 c write (iout,*) "number of requests (contacts)",ireq
7030 c write (iout,*) "req",(req(i),i=1,4)
7033 & call MPI_Waitall(ireq,req,status_array,ierr)
7034 do iii=1,ntask_cont_from
7035 iproc=itask_cont_from(iii)
7038 write (iout,*) "Received",nn," contacts from processor",iproc,
7039 & " of CONT_FROM_COMM group"
7042 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7047 ii=zapas_recv(1,i,iii)
7048 c Flag the received contacts to prevent double-counting
7049 jj=-zapas_recv(2,i,iii)
7050 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7052 nnn=num_cont_hb(ii)+1
7055 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7056 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7057 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7058 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7059 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7060 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7061 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7062 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7063 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7064 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7065 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7066 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7067 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7068 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7069 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7070 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7071 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7072 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7073 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7074 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7075 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7076 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7077 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7078 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7083 write (iout,'(a)') 'Contact function values after receive:'
7085 write (iout,'(2i3,50(1x,i3,f5.2))')
7086 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7087 & j=1,num_cont_hb(i))
7094 write (iout,'(a)') 'Contact function values:'
7096 write (iout,'(2i3,50(1x,i3,f5.2))')
7097 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7098 & j=1,num_cont_hb(i))
7102 C Remove the loop below after debugging !!!
7109 C Calculate the local-electrostatic correlation terms
7110 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7112 num_conti=num_cont_hb(i)
7113 num_conti1=num_cont_hb(i+1)
7120 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7121 c & ' jj=',jj,' kk=',kk
7122 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7123 & .or. j.lt.0 .and. j1.gt.0) .and.
7124 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7125 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7126 C The system gains extra energy.
7127 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7128 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7129 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7131 else if (j1.eq.j) then
7132 C Contacts I-J and I-(J+1) occur simultaneously.
7133 C The system loses extra energy.
7134 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7139 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7140 c & ' jj=',jj,' kk=',kk
7142 C Contacts I-J and (I+1)-J occur simultaneously.
7143 C The system loses extra energy.
7144 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7151 c------------------------------------------------------------------------------
7152 subroutine add_hb_contact(ii,jj,itask)
7153 implicit real*8 (a-h,o-z)
7154 include "DIMENSIONS"
7155 include "COMMON.IOUNITS"
7158 parameter (max_cont=maxconts)
7159 parameter (max_dim=26)
7160 include "COMMON.CONTACTS"
7161 double precision zapas(max_dim,maxconts,max_fg_procs),
7162 & zapas_recv(max_dim,maxconts,max_fg_procs)
7163 common /przechowalnia/ zapas
7164 integer i,j,ii,jj,iproc,itask(4),nn
7165 c write (iout,*) "itask",itask
7168 if (iproc.gt.0) then
7169 do j=1,num_cont_hb(ii)
7171 c write (iout,*) "i",ii," j",jj," jjc",jjc
7173 ncont_sent(iproc)=ncont_sent(iproc)+1
7174 nn=ncont_sent(iproc)
7175 zapas(1,nn,iproc)=ii
7176 zapas(2,nn,iproc)=jjc
7177 zapas(3,nn,iproc)=facont_hb(j,ii)
7178 zapas(4,nn,iproc)=ees0p(j,ii)
7179 zapas(5,nn,iproc)=ees0m(j,ii)
7180 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7181 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7182 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7183 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7184 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7185 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7186 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7187 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7188 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7189 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7190 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7191 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7192 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7193 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7194 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7195 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7196 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7197 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7198 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7199 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7200 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7208 c------------------------------------------------------------------------------
7209 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7211 C This subroutine calculates multi-body contributions to hydrogen-bonding
7212 implicit real*8 (a-h,o-z)
7213 include 'DIMENSIONS'
7214 include 'COMMON.IOUNITS'
7217 parameter (max_cont=maxconts)
7218 parameter (max_dim=70)
7219 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7220 double precision zapas(max_dim,maxconts,max_fg_procs),
7221 & zapas_recv(max_dim,maxconts,max_fg_procs)
7222 common /przechowalnia/ zapas
7223 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7224 & status_array(MPI_STATUS_SIZE,maxconts*2)
7226 include 'COMMON.SETUP'
7227 include 'COMMON.FFIELD'
7228 include 'COMMON.DERIV'
7229 include 'COMMON.LOCAL'
7230 include 'COMMON.INTERACT'
7231 include 'COMMON.CONTACTS'
7232 include 'COMMON.CHAIN'
7233 include 'COMMON.CONTROL'
7234 double precision gx(3),gx1(3)
7235 integer num_cont_hb_old(maxres)
7237 double precision eello4,eello5,eelo6,eello_turn6
7238 external eello4,eello5,eello6,eello_turn6
7239 C Set lprn=.true. for debugging
7244 num_cont_hb_old(i)=num_cont_hb(i)
7248 if (nfgtasks.le.1) goto 30
7250 write (iout,'(a)') 'Contact function values before RECEIVE:'
7252 write (iout,'(2i3,50(1x,i2,f5.2))')
7253 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7254 & j=1,num_cont_hb(i))
7258 do i=1,ntask_cont_from
7261 do i=1,ntask_cont_to
7264 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7266 C Make the list of contacts to send to send to other procesors
7267 do i=iturn3_start,iturn3_end
7268 c write (iout,*) "make contact list turn3",i," num_cont",
7270 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7272 do i=iturn4_start,iturn4_end
7273 c write (iout,*) "make contact list turn4",i," num_cont",
7275 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7279 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7281 do j=1,num_cont_hb(i)
7284 iproc=iint_sent_local(k,jjc,ii)
7285 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7286 if (iproc.ne.0) then
7287 ncont_sent(iproc)=ncont_sent(iproc)+1
7288 nn=ncont_sent(iproc)
7290 zapas(2,nn,iproc)=jjc
7291 zapas(3,nn,iproc)=d_cont(j,i)
7295 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7300 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7308 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7319 & "Numbers of contacts to be sent to other processors",
7320 & (ncont_sent(i),i=1,ntask_cont_to)
7321 write (iout,*) "Contacts sent"
7322 do ii=1,ntask_cont_to
7324 iproc=itask_cont_to(ii)
7325 write (iout,*) nn," contacts to processor",iproc,
7326 & " of CONT_TO_COMM group"
7328 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7336 CorrelID1=nfgtasks+fg_rank+1
7338 C Receive the numbers of needed contacts from other processors
7339 do ii=1,ntask_cont_from
7340 iproc=itask_cont_from(ii)
7342 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7343 & FG_COMM,req(ireq),IERR)
7345 c write (iout,*) "IRECV ended"
7347 C Send the number of contacts needed by other processors
7348 do ii=1,ntask_cont_to
7349 iproc=itask_cont_to(ii)
7351 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7352 & FG_COMM,req(ireq),IERR)
7354 c write (iout,*) "ISEND ended"
7355 c write (iout,*) "number of requests (nn)",ireq
7358 & call MPI_Waitall(ireq,req,status_array,ierr)
7360 c & "Numbers of contacts to be received from other processors",
7361 c & (ncont_recv(i),i=1,ntask_cont_from)
7365 do ii=1,ntask_cont_from
7366 iproc=itask_cont_from(ii)
7368 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7369 c & " of CONT_TO_COMM group"
7373 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7374 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7375 c write (iout,*) "ireq,req",ireq,req(ireq)
7378 C Send the contacts to processors that need them
7379 do ii=1,ntask_cont_to
7380 iproc=itask_cont_to(ii)
7382 c write (iout,*) nn," contacts to processor",iproc,
7383 c & " of CONT_TO_COMM group"
7386 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7387 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7388 c write (iout,*) "ireq,req",ireq,req(ireq)
7390 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7394 c write (iout,*) "number of requests (contacts)",ireq
7395 c write (iout,*) "req",(req(i),i=1,4)
7398 & call MPI_Waitall(ireq,req,status_array,ierr)
7399 do iii=1,ntask_cont_from
7400 iproc=itask_cont_from(iii)
7403 write (iout,*) "Received",nn," contacts from processor",iproc,
7404 & " of CONT_FROM_COMM group"
7407 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7412 ii=zapas_recv(1,i,iii)
7413 c Flag the received contacts to prevent double-counting
7414 jj=-zapas_recv(2,i,iii)
7415 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7417 nnn=num_cont_hb(ii)+1
7420 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7424 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7429 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7437 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7446 write (iout,'(a)') 'Contact function values after receive:'
7448 write (iout,'(2i3,50(1x,i3,5f6.3))')
7449 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7450 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7457 write (iout,'(a)') 'Contact function values:'
7459 write (iout,'(2i3,50(1x,i2,5f6.3))')
7460 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7461 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7467 C Remove the loop below after debugging !!!
7474 C Calculate the dipole-dipole interaction energies
7475 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7476 do i=iatel_s,iatel_e+1
7477 num_conti=num_cont_hb(i)
7486 C Calculate the local-electrostatic correlation terms
7487 c write (iout,*) "gradcorr5 in eello5 before loop"
7489 c write (iout,'(i5,3f10.5)')
7490 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7492 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7493 c write (iout,*) "corr loop i",i
7495 num_conti=num_cont_hb(i)
7496 num_conti1=num_cont_hb(i+1)
7503 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7504 c & ' jj=',jj,' kk=',kk
7505 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7506 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7507 & .or. j.lt.0 .and. j1.gt.0) .and.
7508 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7509 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7510 C The system gains extra energy.
7512 sqd1=dsqrt(d_cont(jj,i))
7513 sqd2=dsqrt(d_cont(kk,i1))
7514 sred_geom = sqd1*sqd2
7515 IF (sred_geom.lt.cutoff_corr) THEN
7516 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7518 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7519 cd & ' jj=',jj,' kk=',kk
7520 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7521 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7523 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7524 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7527 cd write (iout,*) 'sred_geom=',sred_geom,
7528 cd & ' ekont=',ekont,' fprim=',fprimcont,
7529 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7530 cd write (iout,*) "g_contij",g_contij
7531 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7532 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7533 call calc_eello(i,jp,i+1,jp1,jj,kk)
7534 if (wcorr4.gt.0.0d0)
7535 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7536 if (energy_dec.and.wcorr4.gt.0.0d0)
7537 1 write (iout,'(a6,4i5,0pf7.3)')
7538 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7539 c write (iout,*) "gradcorr5 before eello5"
7541 c write (iout,'(i5,3f10.5)')
7542 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7544 if (wcorr5.gt.0.0d0)
7545 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7546 c write (iout,*) "gradcorr5 after eello5"
7548 c write (iout,'(i5,3f10.5)')
7549 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7551 if (energy_dec.and.wcorr5.gt.0.0d0)
7552 1 write (iout,'(a6,4i5,0pf7.3)')
7553 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7554 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7555 cd write(2,*)'ijkl',i,jp,i+1,jp1
7556 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7557 & .or. wturn6.eq.0.0d0))then
7558 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7559 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7560 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7561 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7562 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7563 cd & 'ecorr6=',ecorr6
7564 cd write (iout,'(4e15.5)') sred_geom,
7565 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7566 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7567 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7568 else if (wturn6.gt.0.0d0
7569 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7570 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7571 eturn6=eturn6+eello_turn6(i,jj,kk)
7572 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7573 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7574 cd write (2,*) 'multibody_eello:eturn6',eturn6
7583 num_cont_hb(i)=num_cont_hb_old(i)
7585 c write (iout,*) "gradcorr5 in eello5"
7587 c write (iout,'(i5,3f10.5)')
7588 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7592 c------------------------------------------------------------------------------
7593 subroutine add_hb_contact_eello(ii,jj,itask)
7594 implicit real*8 (a-h,o-z)
7595 include "DIMENSIONS"
7596 include "COMMON.IOUNITS"
7599 parameter (max_cont=maxconts)
7600 parameter (max_dim=70)
7601 include "COMMON.CONTACTS"
7602 double precision zapas(max_dim,maxconts,max_fg_procs),
7603 & zapas_recv(max_dim,maxconts,max_fg_procs)
7604 common /przechowalnia/ zapas
7605 integer i,j,ii,jj,iproc,itask(4),nn
7606 c write (iout,*) "itask",itask
7609 if (iproc.gt.0) then
7610 do j=1,num_cont_hb(ii)
7612 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7614 ncont_sent(iproc)=ncont_sent(iproc)+1
7615 nn=ncont_sent(iproc)
7616 zapas(1,nn,iproc)=ii
7617 zapas(2,nn,iproc)=jjc
7618 zapas(3,nn,iproc)=d_cont(j,ii)
7622 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7627 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7635 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7647 c------------------------------------------------------------------------------
7648 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7649 implicit real*8 (a-h,o-z)
7650 include 'DIMENSIONS'
7651 include 'COMMON.IOUNITS'
7652 include 'COMMON.DERIV'
7653 include 'COMMON.INTERACT'
7654 include 'COMMON.CONTACTS'
7655 double precision gx(3),gx1(3)
7665 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7666 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7667 C Following 4 lines for diagnostics.
7672 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7673 c & 'Contacts ',i,j,
7674 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7675 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7677 C Calculate the multi-body contribution to energy.
7678 c ecorr=ecorr+ekont*ees
7679 C Calculate multi-body contributions to the gradient.
7680 coeffpees0pij=coeffp*ees0pij
7681 coeffmees0mij=coeffm*ees0mij
7682 coeffpees0pkl=coeffp*ees0pkl
7683 coeffmees0mkl=coeffm*ees0mkl
7685 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7686 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7687 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7688 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7689 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7690 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7691 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7692 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7693 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7694 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7695 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7696 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7697 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7698 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7699 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7700 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7701 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7702 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7703 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7704 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7705 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7706 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7707 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7708 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7709 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7714 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7715 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7716 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7717 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7722 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7723 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7724 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7725 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7728 c write (iout,*) "ehbcorr",ekont*ees
7733 C---------------------------------------------------------------------------
7734 subroutine dipole(i,j,jj)
7735 implicit real*8 (a-h,o-z)
7736 include 'DIMENSIONS'
7737 include 'COMMON.IOUNITS'
7738 include 'COMMON.CHAIN'
7739 include 'COMMON.FFIELD'
7740 include 'COMMON.DERIV'
7741 include 'COMMON.INTERACT'
7742 include 'COMMON.CONTACTS'
7743 include 'COMMON.TORSION'
7744 include 'COMMON.VAR'
7745 include 'COMMON.GEO'
7746 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7748 iti1 = itortyp(itype(i+1))
7749 if (j.lt.nres-1) then
7750 itj1 = itortyp(itype(j+1))
7755 dipi(iii,1)=Ub2(iii,i)
7756 dipderi(iii)=Ub2der(iii,i)
7757 dipi(iii,2)=b1(iii,iti1)
7758 dipj(iii,1)=Ub2(iii,j)
7759 dipderj(iii)=Ub2der(iii,j)
7760 dipj(iii,2)=b1(iii,itj1)
7764 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7767 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7774 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7778 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7783 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7784 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7786 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7788 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7790 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7795 C---------------------------------------------------------------------------
7796 subroutine calc_eello(i,j,k,l,jj,kk)
7798 C This subroutine computes matrices and vectors needed to calculate
7799 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7801 implicit real*8 (a-h,o-z)
7802 include 'DIMENSIONS'
7803 include 'COMMON.IOUNITS'
7804 include 'COMMON.CHAIN'
7805 include 'COMMON.DERIV'
7806 include 'COMMON.INTERACT'
7807 include 'COMMON.CONTACTS'
7808 include 'COMMON.TORSION'
7809 include 'COMMON.VAR'
7810 include 'COMMON.GEO'
7811 include 'COMMON.FFIELD'
7812 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7813 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7816 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7817 cd & ' jj=',jj,' kk=',kk
7818 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7819 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7820 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7823 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7824 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7827 call transpose2(aa1(1,1),aa1t(1,1))
7828 call transpose2(aa2(1,1),aa2t(1,1))
7831 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7832 & aa1tder(1,1,lll,kkk))
7833 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7834 & aa2tder(1,1,lll,kkk))
7838 C parallel orientation of the two CA-CA-CA frames.
7840 iti=itortyp(itype(i))
7844 itk1=itortyp(itype(k+1))
7845 itj=itortyp(itype(j))
7846 if (l.lt.nres-1) then
7847 itl1=itortyp(itype(l+1))
7851 C A1 kernel(j+1) A2T
7853 cd write (iout,'(3f10.5,5x,3f10.5)')
7854 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7856 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7857 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7858 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7859 C Following matrices are needed only for 6-th order cumulants
7860 IF (wcorr6.gt.0.0d0) THEN
7861 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7862 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7863 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7864 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7865 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7866 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7867 & ADtEAderx(1,1,1,1,1,1))
7869 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7870 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7871 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7872 & ADtEA1derx(1,1,1,1,1,1))
7874 C End 6-th order cumulants
7877 cd write (2,*) 'In calc_eello6'
7879 cd write (2,*) 'iii=',iii
7881 cd write (2,*) 'kkk=',kkk
7883 cd write (2,'(3(2f10.5),5x)')
7884 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7889 call transpose2(EUgder(1,1,k),auxmat(1,1))
7890 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7891 call transpose2(EUg(1,1,k),auxmat(1,1))
7892 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7893 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7897 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7898 & EAEAderx(1,1,lll,kkk,iii,1))
7902 C A1T kernel(i+1) A2
7903 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7904 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7905 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7906 C Following matrices are needed only for 6-th order cumulants
7907 IF (wcorr6.gt.0.0d0) THEN
7908 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7909 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7910 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7911 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7912 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7913 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7914 & ADtEAderx(1,1,1,1,1,2))
7915 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7916 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7917 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7918 & ADtEA1derx(1,1,1,1,1,2))
7920 C End 6-th order cumulants
7921 call transpose2(EUgder(1,1,l),auxmat(1,1))
7922 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7923 call transpose2(EUg(1,1,l),auxmat(1,1))
7924 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7925 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7929 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7930 & EAEAderx(1,1,lll,kkk,iii,2))
7935 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7936 C They are needed only when the fifth- or the sixth-order cumulants are
7938 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7939 call transpose2(AEA(1,1,1),auxmat(1,1))
7940 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7941 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7942 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7943 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7944 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7945 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7946 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7947 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7948 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7949 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7950 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7951 call transpose2(AEA(1,1,2),auxmat(1,1))
7952 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7953 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7954 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7955 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7956 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7957 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7958 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7959 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7960 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7961 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7962 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7963 C Calculate the Cartesian derivatives of the vectors.
7967 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7968 call matvec2(auxmat(1,1),b1(1,iti),
7969 & AEAb1derx(1,lll,kkk,iii,1,1))
7970 call matvec2(auxmat(1,1),Ub2(1,i),
7971 & AEAb2derx(1,lll,kkk,iii,1,1))
7972 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7973 & AEAb1derx(1,lll,kkk,iii,2,1))
7974 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7975 & AEAb2derx(1,lll,kkk,iii,2,1))
7976 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7977 call matvec2(auxmat(1,1),b1(1,itj),
7978 & AEAb1derx(1,lll,kkk,iii,1,2))
7979 call matvec2(auxmat(1,1),Ub2(1,j),
7980 & AEAb2derx(1,lll,kkk,iii,1,2))
7981 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7982 & AEAb1derx(1,lll,kkk,iii,2,2))
7983 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7984 & AEAb2derx(1,lll,kkk,iii,2,2))
7991 C Antiparallel orientation of the two CA-CA-CA frames.
7993 iti=itortyp(itype(i))
7997 itk1=itortyp(itype(k+1))
7998 itl=itortyp(itype(l))
7999 itj=itortyp(itype(j))
8000 if (j.lt.nres-1) then
8001 itj1=itortyp(itype(j+1))
8005 C A2 kernel(j-1)T A1T
8006 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8007 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8008 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8009 C Following matrices are needed only for 6-th order cumulants
8010 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8011 & j.eq.i+4 .and. l.eq.i+3)) THEN
8012 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8013 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8014 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8015 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8016 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8017 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8018 & ADtEAderx(1,1,1,1,1,1))
8019 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8020 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8021 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8022 & ADtEA1derx(1,1,1,1,1,1))
8024 C End 6-th order cumulants
8025 call transpose2(EUgder(1,1,k),auxmat(1,1))
8026 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8027 call transpose2(EUg(1,1,k),auxmat(1,1))
8028 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8029 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8033 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8034 & EAEAderx(1,1,lll,kkk,iii,1))
8038 C A2T kernel(i+1)T A1
8039 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8040 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8041 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8042 C Following matrices are needed only for 6-th order cumulants
8043 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8044 & j.eq.i+4 .and. l.eq.i+3)) THEN
8045 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8046 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8047 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8048 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8049 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8050 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8051 & ADtEAderx(1,1,1,1,1,2))
8052 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8053 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8054 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8055 & ADtEA1derx(1,1,1,1,1,2))
8057 C End 6-th order cumulants
8058 call transpose2(EUgder(1,1,j),auxmat(1,1))
8059 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8060 call transpose2(EUg(1,1,j),auxmat(1,1))
8061 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8062 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8066 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8067 & EAEAderx(1,1,lll,kkk,iii,2))
8072 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8073 C They are needed only when the fifth- or the sixth-order cumulants are
8075 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8076 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8077 call transpose2(AEA(1,1,1),auxmat(1,1))
8078 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8079 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8080 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8081 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8082 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8083 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8084 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8085 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8086 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8087 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8088 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8089 call transpose2(AEA(1,1,2),auxmat(1,1))
8090 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8091 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8092 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8093 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8094 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8095 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8096 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8097 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8098 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8099 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8100 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8101 C Calculate the Cartesian derivatives of the vectors.
8105 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8106 call matvec2(auxmat(1,1),b1(1,iti),
8107 & AEAb1derx(1,lll,kkk,iii,1,1))
8108 call matvec2(auxmat(1,1),Ub2(1,i),
8109 & AEAb2derx(1,lll,kkk,iii,1,1))
8110 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8111 & AEAb1derx(1,lll,kkk,iii,2,1))
8112 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8113 & AEAb2derx(1,lll,kkk,iii,2,1))
8114 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8115 call matvec2(auxmat(1,1),b1(1,itl),
8116 & AEAb1derx(1,lll,kkk,iii,1,2))
8117 call matvec2(auxmat(1,1),Ub2(1,l),
8118 & AEAb2derx(1,lll,kkk,iii,1,2))
8119 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8120 & AEAb1derx(1,lll,kkk,iii,2,2))
8121 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8122 & AEAb2derx(1,lll,kkk,iii,2,2))
8131 C---------------------------------------------------------------------------
8132 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8133 & KK,KKderg,AKA,AKAderg,AKAderx)
8137 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8138 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8139 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8144 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8146 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8149 cd if (lprn) write (2,*) 'In kernel'
8151 cd if (lprn) write (2,*) 'kkk=',kkk
8153 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8154 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8156 cd write (2,*) 'lll=',lll
8157 cd write (2,*) 'iii=1'
8159 cd write (2,'(3(2f10.5),5x)')
8160 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8163 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8164 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8166 cd write (2,*) 'lll=',lll
8167 cd write (2,*) 'iii=2'
8169 cd write (2,'(3(2f10.5),5x)')
8170 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8177 C---------------------------------------------------------------------------
8178 double precision function eello4(i,j,k,l,jj,kk)
8179 implicit real*8 (a-h,o-z)
8180 include 'DIMENSIONS'
8181 include 'COMMON.IOUNITS'
8182 include 'COMMON.CHAIN'
8183 include 'COMMON.DERIV'
8184 include 'COMMON.INTERACT'
8185 include 'COMMON.CONTACTS'
8186 include 'COMMON.TORSION'
8187 include 'COMMON.VAR'
8188 include 'COMMON.GEO'
8189 double precision pizda(2,2),ggg1(3),ggg2(3)
8190 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8194 cd print *,'eello4:',i,j,k,l,jj,kk
8195 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8196 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8197 cold eij=facont_hb(jj,i)
8198 cold ekl=facont_hb(kk,k)
8200 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8201 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8202 gcorr_loc(k-1)=gcorr_loc(k-1)
8203 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8205 gcorr_loc(l-1)=gcorr_loc(l-1)
8206 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8208 gcorr_loc(j-1)=gcorr_loc(j-1)
8209 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8214 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8215 & -EAEAderx(2,2,lll,kkk,iii,1)
8216 cd derx(lll,kkk,iii)=0.0d0
8220 cd gcorr_loc(l-1)=0.0d0
8221 cd gcorr_loc(j-1)=0.0d0
8222 cd gcorr_loc(k-1)=0.0d0
8224 cd write (iout,*)'Contacts have occurred for peptide groups',
8225 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8226 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8227 if (j.lt.nres-1) then
8234 if (l.lt.nres-1) then
8242 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8243 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8244 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8245 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8246 cgrad ghalf=0.5d0*ggg1(ll)
8247 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8248 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8249 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8250 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8251 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8252 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8253 cgrad ghalf=0.5d0*ggg2(ll)
8254 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8255 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8256 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8257 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8258 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8259 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8263 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8268 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8273 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8278 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8282 cd write (2,*) iii,gcorr_loc(iii)
8285 cd write (2,*) 'ekont',ekont
8286 cd write (iout,*) 'eello4',ekont*eel4
8289 C---------------------------------------------------------------------------
8290 double precision function eello5(i,j,k,l,jj,kk)
8291 implicit real*8 (a-h,o-z)
8292 include 'DIMENSIONS'
8293 include 'COMMON.IOUNITS'
8294 include 'COMMON.CHAIN'
8295 include 'COMMON.DERIV'
8296 include 'COMMON.INTERACT'
8297 include 'COMMON.CONTACTS'
8298 include 'COMMON.TORSION'
8299 include 'COMMON.VAR'
8300 include 'COMMON.GEO'
8301 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8302 double precision ggg1(3),ggg2(3)
8303 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8308 C /l\ / \ \ / \ / \ / C
8309 C / \ / \ \ / \ / \ / C
8310 C j| o |l1 | o | o| o | | o |o C
8311 C \ |/k\| |/ \| / |/ \| |/ \| C
8312 C \i/ \ / \ / / \ / \ C
8314 C (I) (II) (III) (IV) C
8316 C eello5_1 eello5_2 eello5_3 eello5_4 C
8318 C Antiparallel chains C
8321 C /j\ / \ \ / \ / \ / C
8322 C / \ / \ \ / \ / \ / C
8323 C j1| o |l | o | o| o | | o |o C
8324 C \ |/k\| |/ \| / |/ \| |/ \| C
8325 C \i/ \ / \ / / \ / \ C
8327 C (I) (II) (III) (IV) C
8329 C eello5_1 eello5_2 eello5_3 eello5_4 C
8331 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8333 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8334 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8339 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8341 itk=itortyp(itype(k))
8342 itl=itortyp(itype(l))
8343 itj=itortyp(itype(j))
8348 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8349 cd & eel5_3_num,eel5_4_num)
8353 derx(lll,kkk,iii)=0.0d0
8357 cd eij=facont_hb(jj,i)
8358 cd ekl=facont_hb(kk,k)
8360 cd write (iout,*)'Contacts have occurred for peptide groups',
8361 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8363 C Contribution from the graph I.
8364 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8365 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8366 call transpose2(EUg(1,1,k),auxmat(1,1))
8367 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8368 vv(1)=pizda(1,1)-pizda(2,2)
8369 vv(2)=pizda(1,2)+pizda(2,1)
8370 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8371 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8372 C Explicit gradient in virtual-dihedral angles.
8373 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8374 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8375 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8376 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8377 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8378 vv(1)=pizda(1,1)-pizda(2,2)
8379 vv(2)=pizda(1,2)+pizda(2,1)
8380 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8381 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8382 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8383 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8384 vv(1)=pizda(1,1)-pizda(2,2)
8385 vv(2)=pizda(1,2)+pizda(2,1)
8387 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8388 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8389 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8391 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8392 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8393 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8395 C Cartesian gradient
8399 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8401 vv(1)=pizda(1,1)-pizda(2,2)
8402 vv(2)=pizda(1,2)+pizda(2,1)
8403 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8404 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8405 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8411 C Contribution from graph II
8412 call transpose2(EE(1,1,itk),auxmat(1,1))
8413 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8414 vv(1)=pizda(1,1)+pizda(2,2)
8415 vv(2)=pizda(2,1)-pizda(1,2)
8416 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8417 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8418 C Explicit gradient in virtual-dihedral angles.
8419 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8420 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8421 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8422 vv(1)=pizda(1,1)+pizda(2,2)
8423 vv(2)=pizda(2,1)-pizda(1,2)
8425 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8426 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8427 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8429 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8430 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8431 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8433 C Cartesian gradient
8437 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8439 vv(1)=pizda(1,1)+pizda(2,2)
8440 vv(2)=pizda(2,1)-pizda(1,2)
8441 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8442 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8443 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8451 C Parallel orientation
8452 C Contribution from graph III
8453 call transpose2(EUg(1,1,l),auxmat(1,1))
8454 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(1,2)+pizda(2,1)
8457 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8458 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8459 C Explicit gradient in virtual-dihedral angles.
8460 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8461 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8462 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8463 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8464 vv(1)=pizda(1,1)-pizda(2,2)
8465 vv(2)=pizda(1,2)+pizda(2,1)
8466 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8467 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8468 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8469 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8470 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8471 vv(1)=pizda(1,1)-pizda(2,2)
8472 vv(2)=pizda(1,2)+pizda(2,1)
8473 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8474 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8475 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8476 C Cartesian gradient
8480 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8482 vv(1)=pizda(1,1)-pizda(2,2)
8483 vv(2)=pizda(1,2)+pizda(2,1)
8484 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8485 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8486 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8491 C Contribution from graph IV
8493 call transpose2(EE(1,1,itl),auxmat(1,1))
8494 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8495 vv(1)=pizda(1,1)+pizda(2,2)
8496 vv(2)=pizda(2,1)-pizda(1,2)
8497 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8498 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8499 C Explicit gradient in virtual-dihedral angles.
8500 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8501 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8502 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8503 vv(1)=pizda(1,1)+pizda(2,2)
8504 vv(2)=pizda(2,1)-pizda(1,2)
8505 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8506 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8507 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8508 C Cartesian gradient
8512 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8514 vv(1)=pizda(1,1)+pizda(2,2)
8515 vv(2)=pizda(2,1)-pizda(1,2)
8516 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8517 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8518 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8523 C Antiparallel orientation
8524 C Contribution from graph III
8526 call transpose2(EUg(1,1,j),auxmat(1,1))
8527 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8528 vv(1)=pizda(1,1)-pizda(2,2)
8529 vv(2)=pizda(1,2)+pizda(2,1)
8530 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8531 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8532 C Explicit gradient in virtual-dihedral angles.
8533 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8534 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8535 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8536 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8537 vv(1)=pizda(1,1)-pizda(2,2)
8538 vv(2)=pizda(1,2)+pizda(2,1)
8539 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8540 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8541 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8542 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8543 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8544 vv(1)=pizda(1,1)-pizda(2,2)
8545 vv(2)=pizda(1,2)+pizda(2,1)
8546 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8547 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8548 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8549 C Cartesian gradient
8553 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8555 vv(1)=pizda(1,1)-pizda(2,2)
8556 vv(2)=pizda(1,2)+pizda(2,1)
8557 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8558 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8559 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8564 C Contribution from graph IV
8566 call transpose2(EE(1,1,itj),auxmat(1,1))
8567 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8568 vv(1)=pizda(1,1)+pizda(2,2)
8569 vv(2)=pizda(2,1)-pizda(1,2)
8570 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8571 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8572 C Explicit gradient in virtual-dihedral angles.
8573 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8574 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8575 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8576 vv(1)=pizda(1,1)+pizda(2,2)
8577 vv(2)=pizda(2,1)-pizda(1,2)
8578 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8579 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8580 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8581 C Cartesian gradient
8585 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8587 vv(1)=pizda(1,1)+pizda(2,2)
8588 vv(2)=pizda(2,1)-pizda(1,2)
8589 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8590 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8591 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8597 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8598 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8599 cd write (2,*) 'ijkl',i,j,k,l
8600 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8601 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8603 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8604 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8605 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8606 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8607 if (j.lt.nres-1) then
8614 if (l.lt.nres-1) then
8624 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8625 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8626 C summed up outside the subrouine as for the other subroutines
8627 C handling long-range interactions. The old code is commented out
8628 C with "cgrad" to keep track of changes.
8630 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8631 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8632 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8633 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8634 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8635 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8636 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8637 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8638 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8639 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8641 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8642 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8643 cgrad ghalf=0.5d0*ggg1(ll)
8645 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8646 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8647 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8648 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8649 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8650 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8651 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8652 cgrad ghalf=0.5d0*ggg2(ll)
8654 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8655 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8656 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8657 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8658 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8659 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8664 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8665 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8670 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8671 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8677 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8682 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8686 cd write (2,*) iii,g_corr5_loc(iii)
8689 cd write (2,*) 'ekont',ekont
8690 cd write (iout,*) 'eello5',ekont*eel5
8693 c--------------------------------------------------------------------------
8694 double precision function eello6(i,j,k,l,jj,kk)
8695 implicit real*8 (a-h,o-z)
8696 include 'DIMENSIONS'
8697 include 'COMMON.IOUNITS'
8698 include 'COMMON.CHAIN'
8699 include 'COMMON.DERIV'
8700 include 'COMMON.INTERACT'
8701 include 'COMMON.CONTACTS'
8702 include 'COMMON.TORSION'
8703 include 'COMMON.VAR'
8704 include 'COMMON.GEO'
8705 include 'COMMON.FFIELD'
8706 double precision ggg1(3),ggg2(3)
8707 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8712 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8720 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8721 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8725 derx(lll,kkk,iii)=0.0d0
8729 cd eij=facont_hb(jj,i)
8730 cd ekl=facont_hb(kk,k)
8736 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8737 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8738 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8739 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8740 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8741 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8743 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8744 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8745 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8746 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8747 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8748 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8752 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8754 C If turn contributions are considered, they will be handled separately.
8755 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8756 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8757 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8758 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8759 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8760 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8761 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8763 if (j.lt.nres-1) then
8770 if (l.lt.nres-1) then
8778 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8779 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8780 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8781 cgrad ghalf=0.5d0*ggg1(ll)
8783 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8784 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8785 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8786 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8787 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8788 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8789 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8790 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8791 cgrad ghalf=0.5d0*ggg2(ll)
8792 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8794 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8795 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8796 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8797 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8798 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8799 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8804 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8805 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8810 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8811 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8817 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8822 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8826 cd write (2,*) iii,g_corr6_loc(iii)
8829 cd write (2,*) 'ekont',ekont
8830 cd write (iout,*) 'eello6',ekont*eel6
8833 c--------------------------------------------------------------------------
8834 double precision function eello6_graph1(i,j,k,l,imat,swap)
8835 implicit real*8 (a-h,o-z)
8836 include 'DIMENSIONS'
8837 include 'COMMON.IOUNITS'
8838 include 'COMMON.CHAIN'
8839 include 'COMMON.DERIV'
8840 include 'COMMON.INTERACT'
8841 include 'COMMON.CONTACTS'
8842 include 'COMMON.TORSION'
8843 include 'COMMON.VAR'
8844 include 'COMMON.GEO'
8845 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8849 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8851 C Parallel Antiparallel
8857 C \ j|/k\| / \ |/k\|l /
8862 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8863 itk=itortyp(itype(k))
8864 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8865 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8866 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8867 call transpose2(EUgC(1,1,k),auxmat(1,1))
8868 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8869 vv1(1)=pizda1(1,1)-pizda1(2,2)
8870 vv1(2)=pizda1(1,2)+pizda1(2,1)
8871 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8872 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8873 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8874 s5=scalar2(vv(1),Dtobr2(1,i))
8875 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8876 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8877 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8878 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8879 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8880 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8881 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8882 & +scalar2(vv(1),Dtobr2der(1,i)))
8883 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8884 vv1(1)=pizda1(1,1)-pizda1(2,2)
8885 vv1(2)=pizda1(1,2)+pizda1(2,1)
8886 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8887 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8889 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8890 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8891 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8892 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8893 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8895 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8896 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8897 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8898 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8899 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8901 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8902 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8903 vv1(1)=pizda1(1,1)-pizda1(2,2)
8904 vv1(2)=pizda1(1,2)+pizda1(2,1)
8905 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8906 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8907 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8908 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8917 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8918 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8919 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8920 call transpose2(EUgC(1,1,k),auxmat(1,1))
8921 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8923 vv1(1)=pizda1(1,1)-pizda1(2,2)
8924 vv1(2)=pizda1(1,2)+pizda1(2,1)
8925 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8926 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8927 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8928 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8929 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8930 s5=scalar2(vv(1),Dtobr2(1,i))
8931 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8937 c----------------------------------------------------------------------------
8938 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8939 implicit real*8 (a-h,o-z)
8940 include 'DIMENSIONS'
8941 include 'COMMON.IOUNITS'
8942 include 'COMMON.CHAIN'
8943 include 'COMMON.DERIV'
8944 include 'COMMON.INTERACT'
8945 include 'COMMON.CONTACTS'
8946 include 'COMMON.TORSION'
8947 include 'COMMON.VAR'
8948 include 'COMMON.GEO'
8950 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8951 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8954 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8956 C Parallel Antiparallel C
8962 C \ j|/k\| \ |/k\|l C
8967 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8968 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8969 C AL 7/4/01 s1 would occur in the sixth-order moment,
8970 C but not in a cluster cumulant
8972 s1=dip(1,jj,i)*dip(1,kk,k)
8974 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8975 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8976 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8977 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8978 call transpose2(EUg(1,1,k),auxmat(1,1))
8979 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8980 vv(1)=pizda(1,1)-pizda(2,2)
8981 vv(2)=pizda(1,2)+pizda(2,1)
8982 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8983 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8985 eello6_graph2=-(s1+s2+s3+s4)
8987 eello6_graph2=-(s2+s3+s4)
8990 C Derivatives in gamma(i-1)
8993 s1=dipderg(1,jj,i)*dip(1,kk,k)
8995 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8996 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8997 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8998 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9000 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9002 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9004 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9006 C Derivatives in gamma(k-1)
9008 s1=dip(1,jj,i)*dipderg(1,kk,k)
9010 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9011 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9012 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9013 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9014 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9015 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9016 vv(1)=pizda(1,1)-pizda(2,2)
9017 vv(2)=pizda(1,2)+pizda(2,1)
9018 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9020 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9022 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9024 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9025 C Derivatives in gamma(j-1) or gamma(l-1)
9028 s1=dipderg(3,jj,i)*dip(1,kk,k)
9030 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9031 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9032 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9033 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9034 vv(1)=pizda(1,1)-pizda(2,2)
9035 vv(2)=pizda(1,2)+pizda(2,1)
9036 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9039 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9041 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9044 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9045 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9047 C Derivatives in gamma(l-1) or gamma(j-1)
9050 s1=dip(1,jj,i)*dipderg(3,kk,k)
9052 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9053 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9054 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9055 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9056 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9057 vv(1)=pizda(1,1)-pizda(2,2)
9058 vv(2)=pizda(1,2)+pizda(2,1)
9059 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9062 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9064 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9067 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9068 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9070 C Cartesian derivatives.
9072 write (2,*) 'In eello6_graph2'
9074 write (2,*) 'iii=',iii
9076 write (2,*) 'kkk=',kkk
9078 write (2,'(3(2f10.5),5x)')
9079 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9089 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9091 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9094 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9096 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9097 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9099 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9100 call transpose2(EUg(1,1,k),auxmat(1,1))
9101 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9103 vv(1)=pizda(1,1)-pizda(2,2)
9104 vv(2)=pizda(1,2)+pizda(2,1)
9105 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9106 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9108 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9110 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9113 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9115 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9122 c----------------------------------------------------------------------------
9123 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9124 implicit real*8 (a-h,o-z)
9125 include 'DIMENSIONS'
9126 include 'COMMON.IOUNITS'
9127 include 'COMMON.CHAIN'
9128 include 'COMMON.DERIV'
9129 include 'COMMON.INTERACT'
9130 include 'COMMON.CONTACTS'
9131 include 'COMMON.TORSION'
9132 include 'COMMON.VAR'
9133 include 'COMMON.GEO'
9134 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9136 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9138 C Parallel Antiparallel C
9144 C j|/k\| / |/k\|l / C
9149 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9151 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9152 C energy moment and not to the cluster cumulant.
9153 iti=itortyp(itype(i))
9154 if (j.lt.nres-1) then
9155 itj1=itortyp(itype(j+1))
9159 itk=itortyp(itype(k))
9160 itk1=itortyp(itype(k+1))
9161 if (l.lt.nres-1) then
9162 itl1=itortyp(itype(l+1))
9167 s1=dip(4,jj,i)*dip(4,kk,k)
9169 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9170 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9171 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9172 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9173 call transpose2(EE(1,1,itk),auxmat(1,1))
9174 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9175 vv(1)=pizda(1,1)+pizda(2,2)
9176 vv(2)=pizda(2,1)-pizda(1,2)
9177 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9178 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9179 cd & "sum",-(s2+s3+s4)
9181 eello6_graph3=-(s1+s2+s3+s4)
9183 eello6_graph3=-(s2+s3+s4)
9186 C Derivatives in gamma(k-1)
9187 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9188 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9189 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9190 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9191 C Derivatives in gamma(l-1)
9192 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9193 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9194 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9195 vv(1)=pizda(1,1)+pizda(2,2)
9196 vv(2)=pizda(2,1)-pizda(1,2)
9197 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9198 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9199 C Cartesian derivatives.
9205 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9207 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9210 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9212 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9213 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9215 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9216 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9218 vv(1)=pizda(1,1)+pizda(2,2)
9219 vv(2)=pizda(2,1)-pizda(1,2)
9220 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9222 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9224 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9227 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9229 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9231 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9237 c----------------------------------------------------------------------------
9238 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9239 implicit real*8 (a-h,o-z)
9240 include 'DIMENSIONS'
9241 include 'COMMON.IOUNITS'
9242 include 'COMMON.CHAIN'
9243 include 'COMMON.DERIV'
9244 include 'COMMON.INTERACT'
9245 include 'COMMON.CONTACTS'
9246 include 'COMMON.TORSION'
9247 include 'COMMON.VAR'
9248 include 'COMMON.GEO'
9249 include 'COMMON.FFIELD'
9250 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9251 & auxvec1(2),auxmat1(2,2)
9253 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9255 C Parallel Antiparallel C
9261 C \ j|/k\| \ |/k\|l C
9266 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9268 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9269 C energy moment and not to the cluster cumulant.
9270 cd write (2,*) 'eello_graph4: wturn6',wturn6
9271 iti=itortyp(itype(i))
9272 itj=itortyp(itype(j))
9273 if (j.lt.nres-1) then
9274 itj1=itortyp(itype(j+1))
9278 itk=itortyp(itype(k))
9279 if (k.lt.nres-1) then
9280 itk1=itortyp(itype(k+1))
9284 itl=itortyp(itype(l))
9285 if (l.lt.nres-1) then
9286 itl1=itortyp(itype(l+1))
9290 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9291 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9292 cd & ' itl',itl,' itl1',itl1
9295 s1=dip(3,jj,i)*dip(3,kk,k)
9297 s1=dip(2,jj,j)*dip(2,kk,l)
9300 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9301 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9303 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9304 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9306 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9307 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9309 call transpose2(EUg(1,1,k),auxmat(1,1))
9310 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9311 vv(1)=pizda(1,1)-pizda(2,2)
9312 vv(2)=pizda(2,1)+pizda(1,2)
9313 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9314 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9316 eello6_graph4=-(s1+s2+s3+s4)
9318 eello6_graph4=-(s2+s3+s4)
9320 C Derivatives in gamma(i-1)
9324 s1=dipderg(2,jj,i)*dip(3,kk,k)
9326 s1=dipderg(4,jj,j)*dip(2,kk,l)
9329 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9331 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9332 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9334 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9335 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9337 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9338 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9339 cd write (2,*) 'turn6 derivatives'
9341 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9343 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9347 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9349 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9353 C Derivatives in gamma(k-1)
9356 s1=dip(3,jj,i)*dipderg(2,kk,k)
9358 s1=dip(2,jj,j)*dipderg(4,kk,l)
9361 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9362 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9364 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9365 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9367 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9368 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9370 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9371 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9372 vv(1)=pizda(1,1)-pizda(2,2)
9373 vv(2)=pizda(2,1)+pizda(1,2)
9374 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9375 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9377 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9379 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9383 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9385 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9388 C Derivatives in gamma(j-1) or gamma(l-1)
9389 if (l.eq.j+1 .and. l.gt.1) then
9390 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9391 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9392 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9393 vv(1)=pizda(1,1)-pizda(2,2)
9394 vv(2)=pizda(2,1)+pizda(1,2)
9395 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9396 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9397 else if (j.gt.1) then
9398 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9399 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9400 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9401 vv(1)=pizda(1,1)-pizda(2,2)
9402 vv(2)=pizda(2,1)+pizda(1,2)
9403 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9404 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9405 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9407 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9410 C Cartesian derivatives.
9417 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9419 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9423 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9425 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9429 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9431 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9433 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9434 & b1(1,itj1),auxvec(1))
9435 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9437 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9438 & b1(1,itl1),auxvec(1))
9439 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9441 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9443 vv(1)=pizda(1,1)-pizda(2,2)
9444 vv(2)=pizda(2,1)+pizda(1,2)
9445 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9447 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9449 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9452 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9455 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9458 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9460 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9462 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9466 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9468 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9471 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9473 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9481 c----------------------------------------------------------------------------
9482 double precision function eello_turn6(i,jj,kk)
9483 implicit real*8 (a-h,o-z)
9484 include 'DIMENSIONS'
9485 include 'COMMON.IOUNITS'
9486 include 'COMMON.CHAIN'
9487 include 'COMMON.DERIV'
9488 include 'COMMON.INTERACT'
9489 include 'COMMON.CONTACTS'
9490 include 'COMMON.TORSION'
9491 include 'COMMON.VAR'
9492 include 'COMMON.GEO'
9493 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9494 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9496 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9497 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9498 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9499 C the respective energy moment and not to the cluster cumulant.
9508 iti=itortyp(itype(i))
9509 itk=itortyp(itype(k))
9510 itk1=itortyp(itype(k+1))
9511 itl=itortyp(itype(l))
9512 itj=itortyp(itype(j))
9513 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9514 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9515 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9520 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9522 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9526 derx_turn(lll,kkk,iii)=0.0d0
9533 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9535 cd write (2,*) 'eello6_5',eello6_5
9537 call transpose2(AEA(1,1,1),auxmat(1,1))
9538 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9539 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9540 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9542 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9543 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9544 s2 = scalar2(b1(1,itk),vtemp1(1))
9546 call transpose2(AEA(1,1,2),atemp(1,1))
9547 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9548 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9549 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9551 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9552 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9553 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9555 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9556 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9557 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9558 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9559 ss13 = scalar2(b1(1,itk),vtemp4(1))
9560 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9562 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9568 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9569 C Derivatives in gamma(i+2)
9573 call transpose2(AEA(1,1,1),auxmatd(1,1))
9574 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9575 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9576 call transpose2(AEAderg(1,1,2),atempd(1,1))
9577 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9578 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9580 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9581 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9582 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9588 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9589 C Derivatives in gamma(i+3)
9591 call transpose2(AEA(1,1,1),auxmatd(1,1))
9592 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9593 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9594 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9596 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9597 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9598 s2d = scalar2(b1(1,itk),vtemp1d(1))
9600 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9601 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9603 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9605 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9606 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9607 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9615 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9616 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9618 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9619 & -0.5d0*ekont*(s2d+s12d)
9621 C Derivatives in gamma(i+4)
9622 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9623 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9624 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9626 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9627 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9628 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9636 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9638 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9640 C Derivatives in gamma(i+5)
9642 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9643 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9644 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9646 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9647 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9648 s2d = scalar2(b1(1,itk),vtemp1d(1))
9650 call transpose2(AEA(1,1,2),atempd(1,1))
9651 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9652 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9654 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9655 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9657 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9658 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9659 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9667 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9668 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9670 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9671 & -0.5d0*ekont*(s2d+s12d)
9673 C Cartesian derivatives
9678 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9679 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9680 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9682 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9683 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9685 s2d = scalar2(b1(1,itk),vtemp1d(1))
9687 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9688 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9689 s8d = -(atempd(1,1)+atempd(2,2))*
9690 & scalar2(cc(1,1,itl),vtemp2(1))
9692 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9694 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9695 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9702 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9705 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9709 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9710 & - 0.5d0*(s8d+s12d)
9712 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9721 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9723 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9724 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9725 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9726 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9727 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9729 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9730 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9731 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9735 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9736 cd & 16*eel_turn6_num
9738 if (j.lt.nres-1) then
9745 if (l.lt.nres-1) then
9753 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9754 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9755 cgrad ghalf=0.5d0*ggg1(ll)
9757 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9758 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9759 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9760 & +ekont*derx_turn(ll,2,1)
9761 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9762 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9763 & +ekont*derx_turn(ll,4,1)
9764 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9765 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9766 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9767 cgrad ghalf=0.5d0*ggg2(ll)
9769 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9770 & +ekont*derx_turn(ll,2,2)
9771 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9772 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9773 & +ekont*derx_turn(ll,4,2)
9774 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9775 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9776 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9781 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9786 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9792 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9797 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9801 cd write (2,*) iii,g_corr6_loc(iii)
9803 eello_turn6=ekont*eel_turn6
9804 cd write (2,*) 'ekont',ekont
9805 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9809 C-----------------------------------------------------------------------------
9810 double precision function scalar(u,v)
9811 !DIR$ INLINEALWAYS scalar
9813 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9816 double precision u(3),v(3)
9817 cd double precision sc
9825 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9828 crc-------------------------------------------------
9829 SUBROUTINE MATVEC2(A1,V1,V2)
9830 !DIR$ INLINEALWAYS MATVEC2
9832 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9834 implicit real*8 (a-h,o-z)
9835 include 'DIMENSIONS'
9836 DIMENSION A1(2,2),V1(2),V2(2)
9840 c 3 VI=VI+A1(I,K)*V1(K)
9844 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9845 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9850 C---------------------------------------
9851 SUBROUTINE MATMAT2(A1,A2,A3)
9853 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9855 implicit real*8 (a-h,o-z)
9856 include 'DIMENSIONS'
9857 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9858 c DIMENSION AI3(2,2)
9862 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9868 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9869 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9870 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9871 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9879 c-------------------------------------------------------------------------
9880 double precision function scalar2(u,v)
9881 !DIR$ INLINEALWAYS scalar2
9883 double precision u(2),v(2)
9886 scalar2=u(1)*v(1)+u(2)*v(2)
9890 C-----------------------------------------------------------------------------
9892 subroutine transpose2(a,at)
9893 !DIR$ INLINEALWAYS transpose2
9895 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9898 double precision a(2,2),at(2,2)
9905 c--------------------------------------------------------------------------
9906 subroutine transpose(n,a,at)
9909 double precision a(n,n),at(n,n)
9917 C---------------------------------------------------------------------------
9918 subroutine prodmat3(a1,a2,kk,transp,prod)
9919 !DIR$ INLINEALWAYS prodmat3
9921 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9925 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9927 crc double precision auxmat(2,2),prod_(2,2)
9930 crc call transpose2(kk(1,1),auxmat(1,1))
9931 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9932 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9934 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9935 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9936 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9937 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9938 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9939 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9940 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9941 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9944 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9945 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9947 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9948 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9949 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9950 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9951 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9952 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9953 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9954 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9957 c call transpose2(a2(1,1),a2t(1,1))
9960 crc print *,((prod_(i,j),i=1,2),j=1,2)
9961 crc print *,((prod(i,j),i=1,2),j=1,2)