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'
4364 include 'COMMON.CONTROL'
4367 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4368 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4369 if (link_end.eq.0) return
4370 do i=link_start,link_end
4371 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4372 C CA-CA distance used in regularization of structure.
4375 C iii and jjj point to the residues for which the distance is assigned.
4376 if (ii.gt.nres) then
4383 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4384 c & dhpb(i),dhpb1(i),forcon(i)
4385 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4386 C distance and angle dependent SS bond potential.
4387 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4388 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4389 if (.not.dyn_ss .and. i.le.nss) then
4390 C 15/02/13 CC dynamic SSbond - additional check
4392 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4393 call ssbond_ene(iii,jjj,eij)
4396 cd write (iout,*) "eij",eij
4397 else if (ii.gt.nres .and. jj.gt.nres) then
4398 c Restraints from contact prediction
4400 if (constr_dist.eq.11) then
4401 ehpb=ehpb+fordepth(i)**4.0d0
4402 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4403 fac=fordepth(i)**4.0d0
4404 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4405 if (energy_dec) write (iout,'(a6,2i5,f15.6,2f8.3)')
4407 & fordepth(i)**4.0d0*rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)),
4410 if (dhpb1(i).gt.0.0d0) then
4411 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4412 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4413 c write (iout,*) "beta nmr",
4414 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4418 C Get the force constant corresponding to this distance.
4420 C Calculate the contribution to energy.
4421 ehpb=ehpb+waga*rdis*rdis
4422 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4424 C Evaluate gradient.
4430 ggg(j)=fac*(c(j,jj)-c(j,ii))
4433 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4434 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4437 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4438 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4441 C Calculate the distance between the two points and its difference from the
4444 if (constr_dist.eq.11) then
4445 ehpb=ehpb+fordepth(i)**4.0d0
4446 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4447 fac=fordepth(i)**4.0d0
4448 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4449 if (energy_dec) write (iout,'(a6,2i5,f15.6,2f8.3)')
4451 & fordepth(i)**4.0d0*rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)),
4454 c & write (iout,*) fac
4456 if (dhpb1(i).gt.0.0d0) then
4457 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4458 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4459 c write (iout,*) "alph nmr",
4460 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4463 C Get the force constant corresponding to this distance.
4465 C Calculate the contribution to energy.
4466 ehpb=ehpb+waga*rdis*rdis
4467 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4469 C Evaluate gradient.
4474 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4475 cd & ' waga=',waga,' fac=',fac
4477 ggg(j)=fac*(c(j,jj)-c(j,ii))
4479 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4480 C If this is a SC-SC distance, we need to calculate the contributions to the
4481 C Cartesian gradient in the SC vectors (ghpbx).
4484 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4485 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4488 cgrad do j=iii,jjj-1
4490 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4494 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4495 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4499 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4501 c write (iout,*) "ghpbc",i,(ghpbc(j,i),j=1,3)
4505 C--------------------------------------------------------------------------
4506 subroutine ssbond_ene(i,j,eij)
4508 C Calculate the distance and angle dependent SS-bond potential energy
4509 C using a free-energy function derived based on RHF/6-31G** ab initio
4510 C calculations of diethyl disulfide.
4512 C A. Liwo and U. Kozlowska, 11/24/03
4514 implicit real*8 (a-h,o-z)
4515 include 'DIMENSIONS'
4516 include 'COMMON.SBRIDGE'
4517 include 'COMMON.CHAIN'
4518 include 'COMMON.DERIV'
4519 include 'COMMON.LOCAL'
4520 include 'COMMON.INTERACT'
4521 include 'COMMON.VAR'
4522 include 'COMMON.IOUNITS'
4523 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4528 dxi=dc_norm(1,nres+i)
4529 dyi=dc_norm(2,nres+i)
4530 dzi=dc_norm(3,nres+i)
4531 c dsci_inv=dsc_inv(itypi)
4532 dsci_inv=vbld_inv(nres+i)
4534 c dscj_inv=dsc_inv(itypj)
4535 dscj_inv=vbld_inv(nres+j)
4539 dxj=dc_norm(1,nres+j)
4540 dyj=dc_norm(2,nres+j)
4541 dzj=dc_norm(3,nres+j)
4542 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4547 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4548 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4549 om12=dxi*dxj+dyi*dyj+dzi*dzj
4551 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4552 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4558 deltat12=om2-om1+2.0d0
4560 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4561 & +akct*deltad*deltat12+ebr
4562 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4563 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4564 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4565 c & " deltat12",deltat12," eij",eij
4566 ed=2*akcm*deltad+akct*deltat12
4568 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4569 eom1=-2*akth*deltat1-pom1-om2*pom2
4570 eom2= 2*akth*deltat2+pom1-om1*pom2
4573 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4574 ghpbx(k,i)=ghpbx(k,i)-ggk
4575 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4576 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4577 ghpbx(k,j)=ghpbx(k,j)+ggk
4578 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4579 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4580 ghpbc(k,i)=ghpbc(k,i)-ggk
4581 ghpbc(k,j)=ghpbc(k,j)+ggk
4584 C Calculate the components of the gradient in DC and X
4588 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4593 C--------------------------------------------------------------------------
4594 subroutine ebond(estr)
4596 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4598 implicit real*8 (a-h,o-z)
4599 include 'DIMENSIONS'
4600 include 'COMMON.LOCAL'
4601 include 'COMMON.GEO'
4602 include 'COMMON.INTERACT'
4603 include 'COMMON.DERIV'
4604 include 'COMMON.VAR'
4605 include 'COMMON.CHAIN'
4606 include 'COMMON.IOUNITS'
4607 include 'COMMON.NAMES'
4608 include 'COMMON.FFIELD'
4609 include 'COMMON.CONTROL'
4610 include 'COMMON.SETUP'
4611 double precision u(3),ud(3)
4613 do i=ibondp_start,ibondp_end
4614 diff = vbld(i)-vbldp0
4615 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4616 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4617 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4620 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4622 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4626 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4628 do i=ibond_start,ibond_end
4633 diff=vbld(i+nres)-vbldsc0(1,iti)
4634 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4635 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4636 if (energy_dec) then
4638 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4639 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4642 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4644 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4648 diff=vbld(i+nres)-vbldsc0(j,iti)
4649 ud(j)=aksc(j,iti)*diff
4650 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4664 uprod2=uprod2*u(k)*u(k)
4668 usumsqder=usumsqder+ud(j)*uprod2
4670 estr=estr+uprod/usum
4672 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4680 C--------------------------------------------------------------------------
4681 subroutine ebend(etheta)
4683 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4684 C angles gamma and its derivatives in consecutive thetas and gammas.
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 include 'COMMON.LOCAL'
4689 include 'COMMON.GEO'
4690 include 'COMMON.INTERACT'
4691 include 'COMMON.DERIV'
4692 include 'COMMON.VAR'
4693 include 'COMMON.CHAIN'
4694 include 'COMMON.IOUNITS'
4695 include 'COMMON.NAMES'
4696 include 'COMMON.FFIELD'
4697 include 'COMMON.CONTROL'
4698 common /calcthet/ term1,term2,termm,diffak,ratak,
4699 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4700 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4701 double precision y(2),z(2)
4703 c time11=dexp(-2*time)
4706 c write (*,'(a,i2)') 'EBEND ICG=',icg
4707 do i=ithet_start,ithet_end
4708 C Zero the energy function and its derivative at 0 or pi.
4709 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4714 if (phii.ne.phii) phii=150.0
4727 if (phii1.ne.phii1) phii1=150.0
4739 C Calculate the "mean" value of theta from the part of the distribution
4740 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4741 C In following comments this theta will be referred to as t_c.
4742 thet_pred_mean=0.0d0
4746 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4748 dthett=thet_pred_mean*ssd
4749 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4750 C Derivatives of the "mean" values in gamma1 and gamma2.
4751 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4752 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4753 if (theta(i).gt.pi-delta) then
4754 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4756 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4757 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4758 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4760 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4762 else if (theta(i).lt.delta) then
4763 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4764 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4765 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4767 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4768 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4771 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4774 etheta=etheta+ethetai
4775 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4777 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4778 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4779 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4781 C Ufff.... We've done all this!!!
4784 C---------------------------------------------------------------------------
4785 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4787 implicit real*8 (a-h,o-z)
4788 include 'DIMENSIONS'
4789 include 'COMMON.LOCAL'
4790 include 'COMMON.IOUNITS'
4791 common /calcthet/ term1,term2,termm,diffak,ratak,
4792 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4793 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4794 C Calculate the contributions to both Gaussian lobes.
4795 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4796 C The "polynomial part" of the "standard deviation" of this part of
4800 sig=sig*thet_pred_mean+polthet(j,it)
4802 C Derivative of the "interior part" of the "standard deviation of the"
4803 C gamma-dependent Gaussian lobe in t_c.
4804 sigtc=3*polthet(3,it)
4806 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4809 C Set the parameters of both Gaussian lobes of the distribution.
4810 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4811 fac=sig*sig+sigc0(it)
4814 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4815 sigsqtc=-4.0D0*sigcsq*sigtc
4816 c print *,i,sig,sigtc,sigsqtc
4817 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4818 sigtc=-sigtc/(fac*fac)
4819 C Following variable is sigma(t_c)**(-2)
4820 sigcsq=sigcsq*sigcsq
4822 sig0inv=1.0D0/sig0i**2
4823 delthec=thetai-thet_pred_mean
4824 delthe0=thetai-theta0i
4825 term1=-0.5D0*sigcsq*delthec*delthec
4826 term2=-0.5D0*sig0inv*delthe0*delthe0
4827 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4828 C NaNs in taking the logarithm. We extract the largest exponent which is added
4829 C to the energy (this being the log of the distribution) at the end of energy
4830 C term evaluation for this virtual-bond angle.
4831 if (term1.gt.term2) then
4833 term2=dexp(term2-termm)
4837 term1=dexp(term1-termm)
4840 C The ratio between the gamma-independent and gamma-dependent lobes of
4841 C the distribution is a Gaussian function of thet_pred_mean too.
4842 diffak=gthet(2,it)-thet_pred_mean
4843 ratak=diffak/gthet(3,it)**2
4844 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4845 C Let's differentiate it in thet_pred_mean NOW.
4847 C Now put together the distribution terms to make complete distribution.
4848 termexp=term1+ak*term2
4849 termpre=sigc+ak*sig0i
4850 C Contribution of the bending energy from this theta is just the -log of
4851 C the sum of the contributions from the two lobes and the pre-exponential
4852 C factor. Simple enough, isn't it?
4853 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4854 C NOW the derivatives!!!
4855 C 6/6/97 Take into account the deformation.
4856 E_theta=(delthec*sigcsq*term1
4857 & +ak*delthe0*sig0inv*term2)/termexp
4858 E_tc=((sigtc+aktc*sig0i)/termpre
4859 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4860 & aktc*term2)/termexp)
4863 c-----------------------------------------------------------------------------
4864 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4865 implicit real*8 (a-h,o-z)
4866 include 'DIMENSIONS'
4867 include 'COMMON.LOCAL'
4868 include 'COMMON.IOUNITS'
4869 common /calcthet/ term1,term2,termm,diffak,ratak,
4870 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4871 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4872 delthec=thetai-thet_pred_mean
4873 delthe0=thetai-theta0i
4874 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4875 t3 = thetai-thet_pred_mean
4879 t14 = t12+t6*sigsqtc
4881 t21 = thetai-theta0i
4887 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4888 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4889 & *(-t12*t9-ak*sig0inv*t27)
4893 C--------------------------------------------------------------------------
4894 subroutine ebend(etheta)
4896 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4897 C angles gamma and its derivatives in consecutive thetas and gammas.
4898 C ab initio-derived potentials from
4899 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4901 implicit real*8 (a-h,o-z)
4902 include 'DIMENSIONS'
4903 include 'COMMON.LOCAL'
4904 include 'COMMON.GEO'
4905 include 'COMMON.INTERACT'
4906 include 'COMMON.DERIV'
4907 include 'COMMON.VAR'
4908 include 'COMMON.CHAIN'
4909 include 'COMMON.IOUNITS'
4910 include 'COMMON.NAMES'
4911 include 'COMMON.FFIELD'
4912 include 'COMMON.CONTROL'
4913 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4914 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4915 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4916 & sinph1ph2(maxdouble,maxdouble)
4917 logical lprn /.false./, lprn1 /.false./
4919 c write (iout,*) "EBEND ithet_start",ithet_start,
4920 c & " ithet_end",ithet_end
4921 do i=ithet_start,ithet_end
4922 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4923 &(itype(i).eq.ntyp1)) cycle
4927 theti2=0.5d0*theta(i)
4928 ityp2=ithetyp(itype(i-1))
4930 coskt(k)=dcos(k*theti2)
4931 sinkt(k)=dsin(k*theti2)
4934 if (i.gt.3 .and. itype(imax0(i-3,1)).ne.ntyp1) then
4937 if (phii.ne.phii) phii=150.0
4941 ityp1=ithetyp(itype(i-2))
4943 cosph1(k)=dcos(k*phii)
4944 sinph1(k)=dsin(k*phii)
4948 ityp1=ithetyp(itype(i-2))
4954 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4957 if (phii1.ne.phii1) phii1=150.0
4962 ityp3=ithetyp(itype(i))
4964 cosph2(k)=dcos(k*phii1)
4965 sinph2(k)=dsin(k*phii1)
4969 ityp3=ithetyp(itype(i))
4975 ethetai=aa0thet(ityp1,ityp2,ityp3)
4978 ccl=cosph1(l)*cosph2(k-l)
4979 ssl=sinph1(l)*sinph2(k-l)
4980 scl=sinph1(l)*cosph2(k-l)
4981 csl=cosph1(l)*sinph2(k-l)
4982 cosph1ph2(l,k)=ccl-ssl
4983 cosph1ph2(k,l)=ccl+ssl
4984 sinph1ph2(l,k)=scl+csl
4985 sinph1ph2(k,l)=scl-csl
4989 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4990 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4991 write (iout,*) "coskt and sinkt"
4993 write (iout,*) k,coskt(k),sinkt(k)
4997 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4998 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5001 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5002 & " ethetai",ethetai
5005 write (iout,*) "cosph and sinph"
5007 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5009 write (iout,*) "cosph1ph2 and sinph2ph2"
5012 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5013 & sinph1ph2(l,k),sinph1ph2(k,l)
5016 write(iout,*) "ethetai",ethetai
5020 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5021 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5022 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5023 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5024 ethetai=ethetai+sinkt(m)*aux
5025 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5026 dephii=dephii+k*sinkt(m)*(
5027 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5028 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5029 dephii1=dephii1+k*sinkt(m)*(
5030 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5031 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5033 & write (iout,*) "m",m," k",k," bbthet",
5034 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5035 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5036 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5037 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5041 & write(iout,*) "ethetai",ethetai
5045 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5046 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5047 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5048 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5049 ethetai=ethetai+sinkt(m)*aux
5050 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5051 dephii=dephii+l*sinkt(m)*(
5052 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5053 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5054 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5055 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5056 dephii1=dephii1+(k-l)*sinkt(m)*(
5057 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5058 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5059 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5060 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5062 write (iout,*) "m",m," k",k," l",l," ffthet",
5063 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5064 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5065 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5066 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5067 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5068 & cosph1ph2(k,l)*sinkt(m),
5069 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5076 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5077 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5078 & phii1*rad2deg,ethetai
5080 etheta=etheta+ethetai
5081 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5083 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5084 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5085 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5091 c-----------------------------------------------------------------------------
5092 subroutine esc(escloc)
5093 C Calculate the local energy of a side chain and its derivatives in the
5094 C corresponding virtual-bond valence angles THETA and the spherical angles
5096 implicit real*8 (a-h,o-z)
5097 include 'DIMENSIONS'
5098 include 'COMMON.GEO'
5099 include 'COMMON.LOCAL'
5100 include 'COMMON.VAR'
5101 include 'COMMON.INTERACT'
5102 include 'COMMON.DERIV'
5103 include 'COMMON.CHAIN'
5104 include 'COMMON.IOUNITS'
5105 include 'COMMON.NAMES'
5106 include 'COMMON.FFIELD'
5107 include 'COMMON.CONTROL'
5108 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5109 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5110 common /sccalc/ time11,time12,time112,theti,it,nlobit
5113 c write (iout,'(a)') 'ESC'
5114 do i=loc_start,loc_end
5116 if (it.eq.10) goto 1
5118 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5119 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5120 theti=theta(i+1)-pipol
5125 if (x(2).gt.pi-delta) then
5129 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5131 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5132 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5134 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5135 & ddersc0(1),dersc(1))
5136 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5137 & ddersc0(3),dersc(3))
5139 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5141 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5142 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5143 & dersc0(2),esclocbi,dersc02)
5144 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5146 call splinthet(x(2),0.5d0*delta,ss,ssd)
5151 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5153 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5154 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5156 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5158 c write (iout,*) escloci
5159 else if (x(2).lt.delta) then
5163 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5165 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5166 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5168 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5169 & ddersc0(1),dersc(1))
5170 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5171 & ddersc0(3),dersc(3))
5173 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5175 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5176 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5177 & dersc0(2),esclocbi,dersc02)
5178 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5183 call splinthet(x(2),0.5d0*delta,ss,ssd)
5185 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5187 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5188 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5190 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5191 c write (iout,*) escloci
5193 call enesc(x,escloci,dersc,ddummy,.false.)
5196 escloc=escloc+escloci
5197 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5198 & 'escloc',i,escloci
5199 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5201 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5203 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5204 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5209 C---------------------------------------------------------------------------
5210 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5211 implicit real*8 (a-h,o-z)
5212 include 'DIMENSIONS'
5213 include 'COMMON.GEO'
5214 include 'COMMON.LOCAL'
5215 include 'COMMON.IOUNITS'
5216 common /sccalc/ time11,time12,time112,theti,it,nlobit
5217 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5218 double precision contr(maxlob,-1:1)
5220 c write (iout,*) 'it=',it,' nlobit=',nlobit
5224 if (mixed) ddersc(j)=0.0d0
5228 C Because of periodicity of the dependence of the SC energy in omega we have
5229 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5230 C To avoid underflows, first compute & store the exponents.
5238 z(k)=x(k)-censc(k,j,it)
5243 Axk=Axk+gaussc(l,k,j,it)*z(l)
5249 expfac=expfac+Ax(k,j,iii)*z(k)
5257 C As in the case of ebend, we want to avoid underflows in exponentiation and
5258 C subsequent NaNs and INFs in energy calculation.
5259 C Find the largest exponent
5263 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5267 cd print *,'it=',it,' emin=',emin
5269 C Compute the contribution to SC energy and derivatives
5274 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5275 if(adexp.ne.adexp) adexp=1.0
5278 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5280 cd print *,'j=',j,' expfac=',expfac
5281 escloc_i=escloc_i+expfac
5283 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5287 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5288 & +gaussc(k,2,j,it))*expfac
5295 dersc(1)=dersc(1)/cos(theti)**2
5296 ddersc(1)=ddersc(1)/cos(theti)**2
5299 escloci=-(dlog(escloc_i)-emin)
5301 dersc(j)=dersc(j)/escloc_i
5305 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5310 C------------------------------------------------------------------------------
5311 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5312 implicit real*8 (a-h,o-z)
5313 include 'DIMENSIONS'
5314 include 'COMMON.GEO'
5315 include 'COMMON.LOCAL'
5316 include 'COMMON.IOUNITS'
5317 common /sccalc/ time11,time12,time112,theti,it,nlobit
5318 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5319 double precision contr(maxlob)
5330 z(k)=x(k)-censc(k,j,it)
5336 Axk=Axk+gaussc(l,k,j,it)*z(l)
5342 expfac=expfac+Ax(k,j)*z(k)
5347 C As in the case of ebend, we want to avoid underflows in exponentiation and
5348 C subsequent NaNs and INFs in energy calculation.
5349 C Find the largest exponent
5352 if (emin.gt.contr(j)) emin=contr(j)
5356 C Compute the contribution to SC energy and derivatives
5360 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5361 escloc_i=escloc_i+expfac
5363 dersc(k)=dersc(k)+Ax(k,j)*expfac
5365 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5366 & +gaussc(1,2,j,it))*expfac
5370 dersc(1)=dersc(1)/cos(theti)**2
5371 dersc12=dersc12/cos(theti)**2
5372 escloci=-(dlog(escloc_i)-emin)
5374 dersc(j)=dersc(j)/escloc_i
5376 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5380 c----------------------------------------------------------------------------------
5381 subroutine esc(escloc)
5382 C Calculate the local energy of a side chain and its derivatives in the
5383 C corresponding virtual-bond valence angles THETA and the spherical angles
5384 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5385 C added by Urszula Kozlowska. 07/11/2007
5387 implicit real*8 (a-h,o-z)
5388 include 'DIMENSIONS'
5389 include 'COMMON.GEO'
5390 include 'COMMON.LOCAL'
5391 include 'COMMON.VAR'
5392 include 'COMMON.SCROT'
5393 include 'COMMON.INTERACT'
5394 include 'COMMON.DERIV'
5395 include 'COMMON.CHAIN'
5396 include 'COMMON.IOUNITS'
5397 include 'COMMON.NAMES'
5398 include 'COMMON.FFIELD'
5399 include 'COMMON.CONTROL'
5400 include 'COMMON.VECTORS'
5401 double precision x_prime(3),y_prime(3),z_prime(3)
5402 & , sumene,dsc_i,dp2_i,x(65),
5403 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5404 & de_dxx,de_dyy,de_dzz,de_dt
5405 double precision s1_t,s1_6_t,s2_t,s2_6_t
5407 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5408 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5409 & dt_dCi(3),dt_dCi1(3)
5410 common /sccalc/ time11,time12,time112,theti,it,nlobit
5413 c write(iout,*) "ESC: loc_start",loc_start," loc_end",loc_end
5414 do i=loc_start,loc_end
5415 costtab(i+1) =dcos(theta(i+1))
5416 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5417 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5418 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5419 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5420 cosfac=dsqrt(cosfac2)
5421 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5422 sinfac=dsqrt(sinfac2)
5424 if (it.eq.10) goto 1
5426 C Compute the axes of tghe local cartesian coordinates system; store in
5427 c x_prime, y_prime and z_prime
5434 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5435 C & dc_norm(3,i+nres)
5437 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5438 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5441 z_prime(j) = -uz(j,i-1)
5444 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5445 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5446 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5447 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5448 c & " xy",scalar(x_prime(1),y_prime(1)),
5449 c & " xz",scalar(x_prime(1),z_prime(1)),
5450 c & " yy",scalar(y_prime(1),y_prime(1)),
5451 c & " yz",scalar(y_prime(1),z_prime(1)),
5452 c & " zz",scalar(z_prime(1),z_prime(1))
5454 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5455 C to local coordinate system. Store in xx, yy, zz.
5461 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5462 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5463 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5470 C Compute the energy of the ith side cbain
5472 c write (2,*) "xx",xx," yy",yy," zz",zz
5475 x(j) = sc_parmin(j,it)
5478 Cc diagnostics - remove later
5480 yy1 = dsin(alph(2))*dcos(omeg(2))
5481 zz1 = -dsin(alph(2))*dsin(omeg(2))
5482 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5483 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5485 C," --- ", xx_w,yy_w,zz_w
5488 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5489 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5491 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5492 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5494 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5495 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5496 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5497 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5498 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5500 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5501 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5502 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5503 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5504 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5506 dsc_i = 0.743d0+x(61)
5508 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5509 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5510 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5511 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5512 s1=(1+x(63))/(0.1d0 + dscp1)
5513 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5514 s2=(1+x(65))/(0.1d0 + dscp2)
5515 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5516 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5517 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5518 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5520 c & dscp1,dscp2,sumene
5521 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5522 escloc = escloc + sumene
5523 c write (2,*) "i",i," escloc",sumene,escloc
5526 C This section to check the numerical derivatives of the energy of ith side
5527 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5528 C #define DEBUG in the code to turn it on.
5530 write (2,*) "sumene =",sumene
5534 write (2,*) xx,yy,zz
5535 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5536 de_dxx_num=(sumenep-sumene)/aincr
5538 write (2,*) "xx+ sumene from enesc=",sumenep
5541 write (2,*) xx,yy,zz
5542 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5543 de_dyy_num=(sumenep-sumene)/aincr
5545 write (2,*) "yy+ sumene from enesc=",sumenep
5548 write (2,*) xx,yy,zz
5549 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5550 de_dzz_num=(sumenep-sumene)/aincr
5552 write (2,*) "zz+ sumene from enesc=",sumenep
5553 costsave=cost2tab(i+1)
5554 sintsave=sint2tab(i+1)
5555 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5556 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5557 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5558 de_dt_num=(sumenep-sumene)/aincr
5559 write (2,*) " t+ sumene from enesc=",sumenep
5560 cost2tab(i+1)=costsave
5561 sint2tab(i+1)=sintsave
5562 C End of diagnostics section.
5565 C Compute the gradient of esc
5567 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5568 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5569 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5570 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5571 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5572 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5573 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5574 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5575 pom1=(sumene3*sint2tab(i+1)+sumene1)
5576 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5577 pom2=(sumene4*cost2tab(i+1)+sumene2)
5578 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5579 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5580 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5581 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5583 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5584 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5585 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5587 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5588 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5589 & +(pom1+pom2)*pom_dx
5591 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5594 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5595 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5596 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5598 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5599 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5600 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5601 & +x(59)*zz**2 +x(60)*xx*zz
5602 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5603 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5604 & +(pom1-pom2)*pom_dy
5606 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5609 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5610 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5611 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5612 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5613 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5614 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5615 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5616 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5618 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5621 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5622 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5623 & +pom1*pom_dt1+pom2*pom_dt2
5625 write(2,*), "de_dt = ", de_dt,de_dt_num
5629 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5630 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5631 cosfac2xx=cosfac2*xx
5632 sinfac2yy=sinfac2*yy
5634 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5636 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5638 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5639 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5640 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5641 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5642 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5643 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5644 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5645 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5646 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5647 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5651 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5652 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5655 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5656 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5657 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5659 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5660 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5664 dXX_Ctab(k,i)=dXX_Ci(k)
5665 dXX_C1tab(k,i)=dXX_Ci1(k)
5666 dYY_Ctab(k,i)=dYY_Ci(k)
5667 dYY_C1tab(k,i)=dYY_Ci1(k)
5668 dZZ_Ctab(k,i)=dZZ_Ci(k)
5669 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5670 dXX_XYZtab(k,i)=dXX_XYZ(k)
5671 dYY_XYZtab(k,i)=dYY_XYZ(k)
5672 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5676 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5677 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5678 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5679 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5680 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5682 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5683 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5684 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5685 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5686 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5687 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5688 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5689 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5691 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5692 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5694 C to check gradient call subroutine check_grad
5700 c------------------------------------------------------------------------------
5701 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5703 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5704 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5705 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5706 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5708 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5709 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5711 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5712 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5713 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5714 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5715 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5717 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5718 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5719 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5720 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5721 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5723 dsc_i = 0.743d0+x(61)
5725 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5726 & *(xx*cost2+yy*sint2))
5727 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5728 & *(xx*cost2-yy*sint2))
5729 s1=(1+x(63))/(0.1d0 + dscp1)
5730 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5731 s2=(1+x(65))/(0.1d0 + dscp2)
5732 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5733 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5734 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5739 c------------------------------------------------------------------------------
5740 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5742 C This procedure calculates two-body contact function g(rij) and its derivative:
5745 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5748 C where x=(rij-r0ij)/delta
5750 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5753 double precision rij,r0ij,eps0ij,fcont,fprimcont
5754 double precision x,x2,x4,delta
5758 if (x.lt.-1.0D0) then
5761 else if (x.le.1.0D0) then
5764 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5765 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5772 c------------------------------------------------------------------------------
5773 subroutine splinthet(theti,delta,ss,ssder)
5774 implicit real*8 (a-h,o-z)
5775 include 'DIMENSIONS'
5776 include 'COMMON.VAR'
5777 include 'COMMON.GEO'
5780 if (theti.gt.pipol) then
5781 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5783 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5788 c------------------------------------------------------------------------------
5789 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5791 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5792 double precision ksi,ksi2,ksi3,a1,a2,a3
5793 a1=fprim0*delta/(f1-f0)
5799 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5800 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5803 c------------------------------------------------------------------------------
5804 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5806 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5807 double precision ksi,ksi2,ksi3,a1,a2,a3
5812 a2=3*(f1x-f0x)-2*fprim0x*delta
5813 a3=fprim0x*delta-2*(f1x-f0x)
5814 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5817 C-----------------------------------------------------------------------------
5819 C-----------------------------------------------------------------------------
5820 subroutine etor(etors,edihcnstr)
5821 implicit real*8 (a-h,o-z)
5822 include 'DIMENSIONS'
5823 include 'COMMON.VAR'
5824 include 'COMMON.GEO'
5825 include 'COMMON.LOCAL'
5826 include 'COMMON.TORSION'
5827 include 'COMMON.INTERACT'
5828 include 'COMMON.DERIV'
5829 include 'COMMON.CHAIN'
5830 include 'COMMON.NAMES'
5831 include 'COMMON.IOUNITS'
5832 include 'COMMON.FFIELD'
5833 include 'COMMON.TORCNSTR'
5834 include 'COMMON.CONTROL'
5836 C Set lprn=.true. for debugging
5840 do i=iphi_start,iphi_end
5842 itori=itortyp(itype(i-2))
5843 itori1=itortyp(itype(i-1))
5846 C Proline-Proline pair is a special case...
5847 if (itori.eq.3 .and. itori1.eq.3) then
5848 if (phii.gt.-dwapi3) then
5850 fac=1.0D0/(1.0D0-cosphi)
5851 etorsi=v1(1,3,3)*fac
5852 etorsi=etorsi+etorsi
5853 etors=etors+etorsi-v1(1,3,3)
5854 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5855 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5858 v1ij=v1(j+1,itori,itori1)
5859 v2ij=v2(j+1,itori,itori1)
5862 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5863 if (energy_dec) etors_ii=etors_ii+
5864 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5865 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5869 v1ij=v1(j,itori,itori1)
5870 v2ij=v2(j,itori,itori1)
5873 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5874 if (energy_dec) etors_ii=etors_ii+
5875 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5876 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5879 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5882 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5883 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5884 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5885 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5886 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5888 ! 6/20/98 - dihedral angle constraints
5891 itori=idih_constr(i)
5894 if (difi.gt.drange(i)) then
5896 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5897 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5898 else if (difi.lt.-drange(i)) then
5900 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5901 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5903 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5904 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5906 ! write (iout,*) 'edihcnstr',edihcnstr
5909 c------------------------------------------------------------------------------
5910 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5911 subroutine e_modeller(ehomology_constr)
5912 ehomology_constr=0.0d0
5913 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5916 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5918 c------------------------------------------------------------------------------
5919 subroutine etor_d(etors_d)
5923 c----------------------------------------------------------------------------
5925 subroutine etor(etors,edihcnstr)
5926 implicit real*8 (a-h,o-z)
5927 include 'DIMENSIONS'
5928 include 'COMMON.VAR'
5929 include 'COMMON.GEO'
5930 include 'COMMON.LOCAL'
5931 include 'COMMON.TORSION'
5932 include 'COMMON.INTERACT'
5933 include 'COMMON.DERIV'
5934 include 'COMMON.CHAIN'
5935 include 'COMMON.NAMES'
5936 include 'COMMON.IOUNITS'
5937 include 'COMMON.FFIELD'
5938 include 'COMMON.TORCNSTR'
5939 include 'COMMON.CONTROL'
5941 C Set lprn=.true. for debugging
5945 do i=iphi_start,iphi_end
5947 itori=itortyp(itype(i-2))
5948 itori1=itortyp(itype(i-1))
5951 C Regular cosine and sine terms
5952 do j=1,nterm(itori,itori1)
5953 v1ij=v1(j,itori,itori1)
5954 v2ij=v2(j,itori,itori1)
5957 etors=etors+v1ij*cosphi+v2ij*sinphi
5958 if (energy_dec) etors_ii=etors_ii+
5959 & v1ij*cosphi+v2ij*sinphi
5960 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5964 C E = SUM ----------------------------------- - v1
5965 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5967 cosphi=dcos(0.5d0*phii)
5968 sinphi=dsin(0.5d0*phii)
5969 do j=1,nlor(itori,itori1)
5970 vl1ij=vlor1(j,itori,itori1)
5971 vl2ij=vlor2(j,itori,itori1)
5972 vl3ij=vlor3(j,itori,itori1)
5973 pom=vl2ij*cosphi+vl3ij*sinphi
5974 pom1=1.0d0/(pom*pom+1.0d0)
5975 etors=etors+vl1ij*pom1
5976 if (energy_dec) etors_ii=etors_ii+
5979 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5981 C Subtract the constant term
5982 etors=etors-v0(itori,itori1)
5983 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5984 & 'etor',i,etors_ii-v0(itori,itori1)
5986 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5987 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5988 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5989 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5990 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5992 ! 6/20/98 - dihedral angle constraints
5994 c do i=1,ndih_constr
5995 do i=idihconstr_start,idihconstr_end
5996 itori=idih_constr(i)
5998 difi=pinorm(phii-phi0(i))
5999 if (difi.gt.drange(i)) then
6001 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6002 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6003 else if (difi.lt.-drange(i)) then
6005 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6006 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6010 c write (iout,*) "gloci", gloc(i-3,icg)
6011 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6012 cd & rad2deg*phi0(i), rad2deg*drange(i),
6013 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6015 cd write (iout,*) 'edihcnstr',edihcnstr
6018 c----------------------------------------------------------------------------
6019 c MODELLER restraint function
6020 subroutine e_modeller(ehomology_constr)
6021 implicit real*8 (a-h,o-z)
6022 include 'DIMENSIONS'
6024 integer nnn, i, j, k, ki, irec, l
6025 integer katy, odleglosci, test7
6026 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6028 real*8 distance(max_template),distancek(max_template),
6029 & min_odl,godl(max_template),dih_diff(max_template)
6032 c FP - 30/10/2014 Temporary specifications for homology restraints
6034 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6036 double precision, dimension (maxres) :: guscdiff,usc_diff
6037 double precision, dimension (max_template) ::
6038 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6042 include 'COMMON.SBRIDGE'
6043 include 'COMMON.CHAIN'
6044 include 'COMMON.GEO'
6045 include 'COMMON.DERIV'
6046 include 'COMMON.LOCAL'
6047 include 'COMMON.INTERACT'
6048 include 'COMMON.VAR'
6049 include 'COMMON.IOUNITS'
6051 include 'COMMON.CONTROL'
6053 c From subroutine Econstr_back
6055 include 'COMMON.NAMES'
6056 include 'COMMON.TIME1'
6061 distancek(i)=9999999.9
6067 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6069 C AL 5/2/14 - Introduce list of restraints
6070 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6072 write(iout,*) "------- dist restrs start -------"
6074 do ii = link_start_homo,link_end_homo
6078 c write (iout,*) "dij(",i,j,") =",dij
6079 do k=1,constr_homology
6080 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6081 if(.not.l_homo(k,ii)) cycle
6082 distance(k)=odl(k,ii)-dij
6083 c write (iout,*) "distance(",k,") =",distance(k)
6085 c For Gaussian-type Urestr
6087 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6088 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6089 c write (iout,*) "distancek(",k,") =",distancek(k)
6090 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6092 c For Lorentzian-type Urestr
6094 if (waga_dist.lt.0.0d0) then
6095 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6096 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6097 & (distance(k)**2+sigma_odlir(k,ii)**2))
6102 c min_odl=minval(distancek)
6103 do kk=1,constr_homology
6104 if(l_homo(kk,ii)) then
6105 min_odl=distancek(kk)
6109 do kk=1,constr_homology
6110 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
6111 & min_odl=distancek(kk)
6113 c write (iout,* )"min_odl",min_odl
6115 write (iout,*) "ij dij",i,j,dij
6116 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6117 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6118 write (iout,* )"min_odl",min_odl
6121 do k=1,constr_homology
6122 c Nie wiem po co to liczycie jeszcze raz!
6123 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6124 c & (2*(sigma_odl(i,j,k))**2))
6125 if(.not.l_homo(k,ii)) cycle
6126 if (waga_dist.ge.0.0d0) then
6128 c For Gaussian-type Urestr
6130 godl(k)=dexp(-distancek(k)+min_odl)
6131 odleg2=odleg2+godl(k)
6133 c For Lorentzian-type Urestr
6136 odleg2=odleg2+distancek(k)
6139 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6140 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6141 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6142 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6145 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6146 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6148 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6149 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6151 if (waga_dist.ge.0.0d0) then
6153 c For Gaussian-type Urestr
6155 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6157 c For Lorentzian-type Urestr
6160 odleg=odleg+odleg2/constr_homology
6163 c write (iout,*) "odleg",odleg ! sum of -ln-s
6166 c For Gaussian-type Urestr
6168 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6170 do k=1,constr_homology
6171 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6172 c & *waga_dist)+min_odl
6173 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6175 if(.not.l_homo(k,ii)) cycle
6176 if (waga_dist.ge.0.0d0) then
6177 c For Gaussian-type Urestr
6179 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6181 c For Lorentzian-type Urestr
6184 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6185 & sigma_odlir(k,ii)**2)**2)
6187 sum_sgodl=sum_sgodl+sgodl
6189 c sgodl2=sgodl2+sgodl
6190 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6191 c write(iout,*) "constr_homology=",constr_homology
6192 c write(iout,*) i, j, k, "TEST K"
6194 if (waga_dist.ge.0.0d0) then
6196 c For Gaussian-type Urestr
6198 grad_odl3=waga_homology(iset)*waga_dist
6199 & *sum_sgodl/(sum_godl*dij)
6201 c For Lorentzian-type Urestr
6204 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6205 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6206 grad_odl3=-waga_homology(iset)*waga_dist*
6207 & sum_sgodl/(constr_homology*dij)
6210 c grad_odl3=sum_sgodl/(sum_godl*dij)
6213 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6214 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6215 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6217 ccc write(iout,*) godl, sgodl, grad_odl3
6219 c grad_odl=grad_odl+grad_odl3
6222 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6223 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6224 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6225 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6226 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6227 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6228 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6229 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6230 c if (i.eq.25.and.j.eq.27) then
6231 c write(iout,*) "jik",jik,"i",i,"j",j
6232 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
6233 c write(iout,*) "grad_odl3",grad_odl3
6234 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
6235 c write(iout,*) "ggodl",ggodl
6236 c write(iout,*) "ghpbc(",jik,i,")",
6237 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
6241 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6242 ccc & dLOG(odleg2),"-odleg=", -odleg
6244 enddo ! ii-loop for dist
6246 write(iout,*) "------- dist restrs end -------"
6247 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
6248 c & waga_d.eq.1.0d0) call sum_gradient
6250 c Pseudo-energy and gradient from dihedral-angle restraints from
6251 c homology templates
6252 c write (iout,*) "End of distance loop"
6255 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6257 write(iout,*) "------- dih restrs start -------"
6258 do i=idihconstr_start_homo,idihconstr_end_homo
6259 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
6262 do i=idihconstr_start_homo,idihconstr_end_homo
6264 c betai=beta(i,i+1,i+2,i+3)
6266 c write (iout,*) "betai =",betai
6267 do k=1,constr_homology
6268 dih_diff(k)=pinorm(dih(k,i)-betai)
6269 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
6270 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6271 c & -(6.28318-dih_diff(i,k))
6272 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6273 c & 6.28318+dih_diff(i,k)
6275 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6276 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
6279 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6282 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
6283 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
6285 write (iout,*) "i",i," betai",betai," kat2",kat2
6286 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6288 if (kat2.le.1.0d-14) cycle
6289 kat=kat-dLOG(kat2/constr_homology)
6290 c write (iout,*) "kat",kat ! sum of -ln-s
6292 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6293 ccc & dLOG(kat2), "-kat=", -kat
6295 c ----------------------------------------------------------------------
6297 c ----------------------------------------------------------------------
6301 do k=1,constr_homology
6302 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
6303 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
6304 sum_sgdih=sum_sgdih+sgdih
6306 c grad_dih3=sum_sgdih/sum_gdih
6307 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
6309 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6310 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6311 ccc & gloc(nphi+i-3,icg)
6312 gloc(i,icg)=gloc(i,icg)+grad_dih3
6314 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
6316 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6317 ccc & gloc(nphi+i-3,icg)
6319 enddo ! i-loop for dih
6321 write(iout,*) "------- dih restrs end -------"
6324 c Pseudo-energy and gradient for theta angle restraints from
6325 c homology templates
6326 c FP 01/15 - inserted from econstr_local_test.F, loop structure
6330 c For constr_homology reference structures (FP)
6332 c Uconst_back_tot=0.0d0
6335 c Econstr_back legacy
6337 c do i=ithet_start,ithet_end
6340 c do i=loc_start,loc_end
6343 duscdiffx(j,i)=0.0d0
6348 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
6349 c write (iout,*) "waga_theta",waga_theta
6350 if (waga_theta.gt.0.0d0) then
6352 write (iout,*) "usampl",usampl
6353 write(iout,*) "------- theta restrs start -------"
6354 c do i=ithet_start,ithet_end
6355 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
6358 c write (iout,*) "maxres",maxres,"nres",nres
6360 do i=ithet_start,ithet_end
6363 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
6365 c Deviation of theta angles wrt constr_homology ref structures
6367 utheta_i=0.0d0 ! argument of Gaussian for single k
6368 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6369 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
6370 c over residues in a fragment
6371 c write (iout,*) "theta(",i,")=",theta(i)
6372 do k=1,constr_homology
6374 c dtheta_i=theta(j)-thetaref(j,iref)
6375 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
6376 theta_diff(k)=thetatpl(k,i)-theta(i)
6378 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
6379 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
6380 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
6381 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
6382 c Gradient for single Gaussian restraint in subr Econstr_back
6383 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
6386 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
6387 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
6390 c Gradient for multiple Gaussian restraint
6391 sum_gtheta=gutheta_i
6393 do k=1,constr_homology
6394 c New generalized expr for multiple Gaussian from Econstr_back
6395 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
6397 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
6398 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
6400 c Final value of gradient using same var as in Econstr_back
6401 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
6402 & +sum_sgtheta/sum_gtheta*waga_theta
6403 & *waga_homology(iset)
6404 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
6405 c & *waga_homology(iset)
6406 c dutheta(i)=sum_sgtheta/sum_gtheta
6408 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
6409 Eval=Eval-dLOG(gutheta_i/constr_homology)
6410 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
6411 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
6412 c Uconst_back=Uconst_back+utheta(i)
6413 enddo ! (i-loop for theta)
6415 write(iout,*) "------- theta restrs end -------"
6419 c Deviation of local SC geometry
6421 c Separation of two i-loops (instructed by AL - 11/3/2014)
6423 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
6424 c write (iout,*) "waga_d",waga_d
6427 write(iout,*) "------- SC restrs start -------"
6428 write (iout,*) "Initial duscdiff,duscdiffx"
6429 do i=loc_start,loc_end
6430 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
6431 & (duscdiffx(jik,i),jik=1,3)
6434 do i=loc_start,loc_end
6435 usc_diff_i=0.0d0 ! argument of Gaussian for single k
6436 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6437 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
6438 c write(iout,*) "xxtab, yytab, zztab"
6439 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
6440 do k=1,constr_homology
6442 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6443 c Original sign inverted for calc of gradients (s. Econstr_back)
6444 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6445 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6446 c write(iout,*) "dxx, dyy, dzz"
6447 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6449 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
6450 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
6451 c uscdiffk(k)=usc_diff(i)
6452 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
6453 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
6454 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
6455 c & xxref(j),yyref(j),zzref(j)
6460 c Generalized expression for multiple Gaussian acc to that for a single
6461 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
6463 c Original implementation
6464 c sum_guscdiff=guscdiff(i)
6466 c sum_sguscdiff=0.0d0
6467 c do k=1,constr_homology
6468 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
6469 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
6470 c sum_sguscdiff=sum_sguscdiff+sguscdiff
6473 c Implementation of new expressions for gradient (Jan. 2015)
6475 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
6476 do k=1,constr_homology
6478 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
6479 c before. Now the drivatives should be correct
6481 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6482 c Original sign inverted for calc of gradients (s. Econstr_back)
6483 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6484 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6486 c New implementation
6488 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
6489 & sigma_d(k,i) ! for the grad wrt r'
6490 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
6493 c New implementation
6494 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
6496 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
6497 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
6498 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
6499 duscdiff(jik,i)=duscdiff(jik,i)+
6500 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
6501 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
6502 duscdiffx(jik,i)=duscdiffx(jik,i)+
6503 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
6504 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
6507 write(iout,*) "jik",jik,"i",i
6508 write(iout,*) "dxx, dyy, dzz"
6509 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6510 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
6511 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
6512 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
6513 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
6514 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
6515 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
6516 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
6517 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
6518 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
6519 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
6520 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
6521 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
6522 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
6523 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
6529 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
6530 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
6532 c write (iout,*) i," uscdiff",uscdiff(i)
6534 c Put together deviations from local geometry
6536 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
6537 c & wfrag_back(3,i,iset)*uscdiff(i)
6538 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
6539 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
6540 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
6541 c Uconst_back=Uconst_back+usc_diff(i)
6543 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
6545 c New implment: multiplied by sum_sguscdiff
6548 enddo ! (i-loop for dscdiff)
6553 write(iout,*) "------- SC restrs end -------"
6554 write (iout,*) "------ After SC loop in e_modeller ------"
6555 do i=loc_start,loc_end
6556 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
6557 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
6559 if (waga_theta.eq.1.0d0) then
6560 write (iout,*) "in e_modeller after SC restr end: dutheta"
6561 do i=ithet_start,ithet_end
6562 write (iout,*) i,dutheta(i)
6565 if (waga_d.eq.1.0d0) then
6566 write (iout,*) "e_modeller after SC loop: duscdiff/x"
6568 write (iout,*) i,(duscdiff(j,i),j=1,3)
6569 write (iout,*) i,(duscdiffx(j,i),j=1,3)
6574 c Total energy from homology restraints
6576 write (iout,*) "odleg",odleg," kat",kat
6579 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
6581 c ehomology_constr=odleg+kat
6583 c For Lorentzian-type Urestr
6586 if (waga_dist.ge.0.0d0) then
6588 c For Gaussian-type Urestr
6590 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
6591 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6592 c write (iout,*) "ehomology_constr=",ehomology_constr
6595 c For Lorentzian-type Urestr
6597 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
6598 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6599 c write (iout,*) "ehomology_constr=",ehomology_constr
6602 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
6603 & "Eval",waga_theta,eval,
6604 & "Erot",waga_d,Erot
6605 write (iout,*) "ehomology_constr",ehomology_constr
6611 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6612 747 format(a12,i4,i4,i4,f8.3,f8.3)
6613 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6614 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6615 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6616 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6619 c------------------------------------------------------------------------------
6620 subroutine etor_d(etors_d)
6621 C 6/23/01 Compute double torsional energy
6622 implicit real*8 (a-h,o-z)
6623 include 'DIMENSIONS'
6624 include 'COMMON.VAR'
6625 include 'COMMON.GEO'
6626 include 'COMMON.LOCAL'
6627 include 'COMMON.TORSION'
6628 include 'COMMON.INTERACT'
6629 include 'COMMON.DERIV'
6630 include 'COMMON.CHAIN'
6631 include 'COMMON.NAMES'
6632 include 'COMMON.IOUNITS'
6633 include 'COMMON.FFIELD'
6634 include 'COMMON.TORCNSTR'
6635 include 'COMMON.CONTROL'
6637 C Set lprn=.true. for debugging
6641 do i=iphid_start,iphid_end
6643 itori=itortyp(itype(i-2))
6644 itori1=itortyp(itype(i-1))
6645 itori2=itortyp(itype(i))
6650 do j=1,ntermd_1(itori,itori1,itori2)
6651 v1cij=v1c(1,j,itori,itori1,itori2)
6652 v1sij=v1s(1,j,itori,itori1,itori2)
6653 v2cij=v1c(2,j,itori,itori1,itori2)
6654 v2sij=v1s(2,j,itori,itori1,itori2)
6655 cosphi1=dcos(j*phii)
6656 sinphi1=dsin(j*phii)
6657 cosphi2=dcos(j*phii1)
6658 sinphi2=dsin(j*phii1)
6659 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6660 & v2cij*cosphi2+v2sij*sinphi2
6661 if (energy_dec) etors_d_ii=etors_d_ii+
6662 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6663 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6664 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6666 do k=2,ntermd_2(itori,itori1,itori2)
6668 v1cdij = v2c(k,l,itori,itori1,itori2)
6669 v2cdij = v2c(l,k,itori,itori1,itori2)
6670 v1sdij = v2s(k,l,itori,itori1,itori2)
6671 v2sdij = v2s(l,k,itori,itori1,itori2)
6672 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6673 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6674 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6675 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6676 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6677 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6678 if (energy_dec) etors_d_ii=etors_d_ii+
6679 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6680 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6681 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6682 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6683 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6684 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6687 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6688 & 'etor_d',i,etors_d_ii
6689 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6690 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6691 c write (iout,*) "gloci", gloc(i-3,icg)
6696 c------------------------------------------------------------------------------
6697 subroutine eback_sc_corr(esccor)
6698 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6699 c conformational states; temporarily implemented as differences
6700 c between UNRES torsional potentials (dependent on three types of
6701 c residues) and the torsional potentials dependent on all 20 types
6702 c of residues computed from AM1 energy surfaces of terminally-blocked
6703 c amino-acid residues.
6704 implicit real*8 (a-h,o-z)
6705 include 'DIMENSIONS'
6706 include 'COMMON.VAR'
6707 include 'COMMON.GEO'
6708 include 'COMMON.LOCAL'
6709 include 'COMMON.TORSION'
6710 include 'COMMON.SCCOR'
6711 include 'COMMON.INTERACT'
6712 include 'COMMON.DERIV'
6713 include 'COMMON.CHAIN'
6714 include 'COMMON.NAMES'
6715 include 'COMMON.IOUNITS'
6716 include 'COMMON.FFIELD'
6717 include 'COMMON.CONTROL'
6719 C Set lprn=.true. for debugging
6722 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6724 do i=itau_start,itau_end
6726 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6727 isccori=isccortyp(itype(i-2))
6728 isccori1=isccortyp(itype(i-1))
6730 cccc Added 9 May 2012
6731 cc Tauangle is torsional engle depending on the value of first digit
6732 c(see comment below)
6733 cc Omicron is flat angle depending on the value of first digit
6734 c(see comment below)
6737 do intertyp=1,3 !intertyp
6738 cc Added 09 May 2012 (Adasko)
6739 cc Intertyp means interaction type of backbone mainchain correlation:
6740 c 1 = SC...Ca...Ca...Ca
6741 c 2 = Ca...Ca...Ca...SC
6742 c 3 = SC...Ca...Ca...SCi
6744 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6745 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6746 & (itype(i-1).eq.21)))
6747 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6748 & .or.(itype(i-2).eq.21)))
6749 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6750 & (itype(i-1).eq.21)))) cycle
6751 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6752 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6754 do j=1,nterm_sccor(isccori,isccori1)
6755 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6756 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6757 cosphi=dcos(j*tauangle(intertyp,i))
6758 sinphi=dsin(j*tauangle(intertyp,i))
6759 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6760 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6762 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6763 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6764 c &gloc_sc(intertyp,i-3,icg)
6766 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6767 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6768 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6769 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6770 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6774 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6778 c----------------------------------------------------------------------------
6779 subroutine multibody(ecorr)
6780 C This subroutine calculates multi-body contributions to energy following
6781 C the idea of Skolnick et al. If side chains I and J make a contact and
6782 C at the same time side chains I+1 and J+1 make a contact, an extra
6783 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6784 implicit real*8 (a-h,o-z)
6785 include 'DIMENSIONS'
6786 include 'COMMON.IOUNITS'
6787 include 'COMMON.DERIV'
6788 include 'COMMON.INTERACT'
6789 include 'COMMON.CONTACTS'
6790 double precision gx(3),gx1(3)
6793 C Set lprn=.true. for debugging
6797 write (iout,'(a)') 'Contact function values:'
6799 write (iout,'(i2,20(1x,i2,f10.5))')
6800 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6815 num_conti=num_cont(i)
6816 num_conti1=num_cont(i1)
6821 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6822 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6823 cd & ' ishift=',ishift
6824 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6825 C The system gains extra energy.
6826 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6827 endif ! j1==j+-ishift
6836 c------------------------------------------------------------------------------
6837 double precision function esccorr(i,j,k,l,jj,kk)
6838 implicit real*8 (a-h,o-z)
6839 include 'DIMENSIONS'
6840 include 'COMMON.IOUNITS'
6841 include 'COMMON.DERIV'
6842 include 'COMMON.INTERACT'
6843 include 'COMMON.CONTACTS'
6844 double precision gx(3),gx1(3)
6849 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6850 C Calculate the multi-body contribution to energy.
6851 C Calculate multi-body contributions to the gradient.
6852 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6853 cd & k,l,(gacont(m,kk,k),m=1,3)
6855 gx(m) =ekl*gacont(m,jj,i)
6856 gx1(m)=eij*gacont(m,kk,k)
6857 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6858 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6859 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6860 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6864 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6869 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6875 c------------------------------------------------------------------------------
6876 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6877 C This subroutine calculates multi-body contributions to hydrogen-bonding
6878 implicit real*8 (a-h,o-z)
6879 include 'DIMENSIONS'
6880 include 'COMMON.IOUNITS'
6883 parameter (max_cont=maxconts)
6884 parameter (max_dim=26)
6885 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6886 double precision zapas(max_dim,maxconts,max_fg_procs),
6887 & zapas_recv(max_dim,maxconts,max_fg_procs)
6888 common /przechowalnia/ zapas
6889 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6890 & status_array(MPI_STATUS_SIZE,maxconts*2)
6892 include 'COMMON.SETUP'
6893 include 'COMMON.FFIELD'
6894 include 'COMMON.DERIV'
6895 include 'COMMON.INTERACT'
6896 include 'COMMON.CONTACTS'
6897 include 'COMMON.CONTROL'
6898 include 'COMMON.LOCAL'
6899 double precision gx(3),gx1(3),time00
6902 C Set lprn=.true. for debugging
6907 if (nfgtasks.le.1) goto 30
6909 write (iout,'(a)') 'Contact function values before RECEIVE:'
6911 write (iout,'(2i3,50(1x,i2,f5.2))')
6912 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6913 & j=1,num_cont_hb(i))
6917 do i=1,ntask_cont_from
6920 do i=1,ntask_cont_to
6923 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6925 C Make the list of contacts to send to send to other procesors
6926 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6928 do i=iturn3_start,iturn3_end
6929 c write (iout,*) "make contact list turn3",i," num_cont",
6931 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6933 do i=iturn4_start,iturn4_end
6934 c write (iout,*) "make contact list turn4",i," num_cont",
6936 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6940 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6942 do j=1,num_cont_hb(i)
6945 iproc=iint_sent_local(k,jjc,ii)
6946 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6947 if (iproc.gt.0) then
6948 ncont_sent(iproc)=ncont_sent(iproc)+1
6949 nn=ncont_sent(iproc)
6951 zapas(2,nn,iproc)=jjc
6952 zapas(3,nn,iproc)=facont_hb(j,i)
6953 zapas(4,nn,iproc)=ees0p(j,i)
6954 zapas(5,nn,iproc)=ees0m(j,i)
6955 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6956 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6957 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6958 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6959 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6960 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6961 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6962 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6963 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6964 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6965 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6966 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6967 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6968 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6969 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6970 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6971 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6972 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6973 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6974 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6975 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6982 & "Numbers of contacts to be sent to other processors",
6983 & (ncont_sent(i),i=1,ntask_cont_to)
6984 write (iout,*) "Contacts sent"
6985 do ii=1,ntask_cont_to
6987 iproc=itask_cont_to(ii)
6988 write (iout,*) nn," contacts to processor",iproc,
6989 & " of CONT_TO_COMM group"
6991 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6999 CorrelID1=nfgtasks+fg_rank+1
7001 C Receive the numbers of needed contacts from other processors
7002 do ii=1,ntask_cont_from
7003 iproc=itask_cont_from(ii)
7005 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7006 & FG_COMM,req(ireq),IERR)
7008 c write (iout,*) "IRECV ended"
7010 C Send the number of contacts needed by other processors
7011 do ii=1,ntask_cont_to
7012 iproc=itask_cont_to(ii)
7014 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7015 & FG_COMM,req(ireq),IERR)
7017 c write (iout,*) "ISEND ended"
7018 c write (iout,*) "number of requests (nn)",ireq
7021 & call MPI_Waitall(ireq,req,status_array,ierr)
7023 c & "Numbers of contacts to be received from other processors",
7024 c & (ncont_recv(i),i=1,ntask_cont_from)
7028 do ii=1,ntask_cont_from
7029 iproc=itask_cont_from(ii)
7031 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7032 c & " of CONT_TO_COMM group"
7036 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7037 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7038 c write (iout,*) "ireq,req",ireq,req(ireq)
7041 C Send the contacts to processors that need them
7042 do ii=1,ntask_cont_to
7043 iproc=itask_cont_to(ii)
7045 c write (iout,*) nn," contacts to processor",iproc,
7046 c & " of CONT_TO_COMM group"
7049 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7050 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7051 c write (iout,*) "ireq,req",ireq,req(ireq)
7053 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7057 c write (iout,*) "number of requests (contacts)",ireq
7058 c write (iout,*) "req",(req(i),i=1,4)
7061 & call MPI_Waitall(ireq,req,status_array,ierr)
7062 do iii=1,ntask_cont_from
7063 iproc=itask_cont_from(iii)
7066 write (iout,*) "Received",nn," contacts from processor",iproc,
7067 & " of CONT_FROM_COMM group"
7070 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7075 ii=zapas_recv(1,i,iii)
7076 c Flag the received contacts to prevent double-counting
7077 jj=-zapas_recv(2,i,iii)
7078 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7080 nnn=num_cont_hb(ii)+1
7083 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7084 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7085 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7086 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7087 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7088 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7089 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7090 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7091 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7092 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7093 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7094 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7095 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7096 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7097 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7098 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7099 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7100 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7101 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7102 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7103 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7104 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7105 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7106 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7111 write (iout,'(a)') 'Contact function values after receive:'
7113 write (iout,'(2i3,50(1x,i3,f5.2))')
7114 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7115 & j=1,num_cont_hb(i))
7122 write (iout,'(a)') 'Contact function values:'
7124 write (iout,'(2i3,50(1x,i3,f5.2))')
7125 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7126 & j=1,num_cont_hb(i))
7130 C Remove the loop below after debugging !!!
7137 C Calculate the local-electrostatic correlation terms
7138 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7140 num_conti=num_cont_hb(i)
7141 num_conti1=num_cont_hb(i+1)
7148 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7149 c & ' jj=',jj,' kk=',kk
7150 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7151 & .or. j.lt.0 .and. j1.gt.0) .and.
7152 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7153 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7154 C The system gains extra energy.
7155 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7156 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7157 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7159 else if (j1.eq.j) then
7160 C Contacts I-J and I-(J+1) occur simultaneously.
7161 C The system loses extra energy.
7162 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7167 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7168 c & ' jj=',jj,' kk=',kk
7170 C Contacts I-J and (I+1)-J occur simultaneously.
7171 C The system loses extra energy.
7172 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7179 c------------------------------------------------------------------------------
7180 subroutine add_hb_contact(ii,jj,itask)
7181 implicit real*8 (a-h,o-z)
7182 include "DIMENSIONS"
7183 include "COMMON.IOUNITS"
7186 parameter (max_cont=maxconts)
7187 parameter (max_dim=26)
7188 include "COMMON.CONTACTS"
7189 double precision zapas(max_dim,maxconts,max_fg_procs),
7190 & zapas_recv(max_dim,maxconts,max_fg_procs)
7191 common /przechowalnia/ zapas
7192 integer i,j,ii,jj,iproc,itask(4),nn
7193 c write (iout,*) "itask",itask
7196 if (iproc.gt.0) then
7197 do j=1,num_cont_hb(ii)
7199 c write (iout,*) "i",ii," j",jj," jjc",jjc
7201 ncont_sent(iproc)=ncont_sent(iproc)+1
7202 nn=ncont_sent(iproc)
7203 zapas(1,nn,iproc)=ii
7204 zapas(2,nn,iproc)=jjc
7205 zapas(3,nn,iproc)=facont_hb(j,ii)
7206 zapas(4,nn,iproc)=ees0p(j,ii)
7207 zapas(5,nn,iproc)=ees0m(j,ii)
7208 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7209 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7210 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7211 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7212 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7213 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7214 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7215 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7216 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7217 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7218 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7219 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7220 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7221 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7222 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7223 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7224 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7225 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7226 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7227 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7228 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7236 c------------------------------------------------------------------------------
7237 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7239 C This subroutine calculates multi-body contributions to hydrogen-bonding
7240 implicit real*8 (a-h,o-z)
7241 include 'DIMENSIONS'
7242 include 'COMMON.IOUNITS'
7245 parameter (max_cont=maxconts)
7246 parameter (max_dim=70)
7247 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7248 double precision zapas(max_dim,maxconts,max_fg_procs),
7249 & zapas_recv(max_dim,maxconts,max_fg_procs)
7250 common /przechowalnia/ zapas
7251 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7252 & status_array(MPI_STATUS_SIZE,maxconts*2)
7254 include 'COMMON.SETUP'
7255 include 'COMMON.FFIELD'
7256 include 'COMMON.DERIV'
7257 include 'COMMON.LOCAL'
7258 include 'COMMON.INTERACT'
7259 include 'COMMON.CONTACTS'
7260 include 'COMMON.CHAIN'
7261 include 'COMMON.CONTROL'
7262 double precision gx(3),gx1(3)
7263 integer num_cont_hb_old(maxres)
7265 double precision eello4,eello5,eelo6,eello_turn6
7266 external eello4,eello5,eello6,eello_turn6
7267 C Set lprn=.true. for debugging
7272 num_cont_hb_old(i)=num_cont_hb(i)
7276 if (nfgtasks.le.1) goto 30
7278 write (iout,'(a)') 'Contact function values before RECEIVE:'
7280 write (iout,'(2i3,50(1x,i2,f5.2))')
7281 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7282 & j=1,num_cont_hb(i))
7286 do i=1,ntask_cont_from
7289 do i=1,ntask_cont_to
7292 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7294 C Make the list of contacts to send to send to other procesors
7295 do i=iturn3_start,iturn3_end
7296 c write (iout,*) "make contact list turn3",i," num_cont",
7298 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7300 do i=iturn4_start,iturn4_end
7301 c write (iout,*) "make contact list turn4",i," num_cont",
7303 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7307 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7309 do j=1,num_cont_hb(i)
7312 iproc=iint_sent_local(k,jjc,ii)
7313 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7314 if (iproc.ne.0) then
7315 ncont_sent(iproc)=ncont_sent(iproc)+1
7316 nn=ncont_sent(iproc)
7318 zapas(2,nn,iproc)=jjc
7319 zapas(3,nn,iproc)=d_cont(j,i)
7323 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7328 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7336 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7347 & "Numbers of contacts to be sent to other processors",
7348 & (ncont_sent(i),i=1,ntask_cont_to)
7349 write (iout,*) "Contacts sent"
7350 do ii=1,ntask_cont_to
7352 iproc=itask_cont_to(ii)
7353 write (iout,*) nn," contacts to processor",iproc,
7354 & " of CONT_TO_COMM group"
7356 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7364 CorrelID1=nfgtasks+fg_rank+1
7366 C Receive the numbers of needed contacts from other processors
7367 do ii=1,ntask_cont_from
7368 iproc=itask_cont_from(ii)
7370 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7371 & FG_COMM,req(ireq),IERR)
7373 c write (iout,*) "IRECV ended"
7375 C Send the number of contacts needed by other processors
7376 do ii=1,ntask_cont_to
7377 iproc=itask_cont_to(ii)
7379 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7380 & FG_COMM,req(ireq),IERR)
7382 c write (iout,*) "ISEND ended"
7383 c write (iout,*) "number of requests (nn)",ireq
7386 & call MPI_Waitall(ireq,req,status_array,ierr)
7388 c & "Numbers of contacts to be received from other processors",
7389 c & (ncont_recv(i),i=1,ntask_cont_from)
7393 do ii=1,ntask_cont_from
7394 iproc=itask_cont_from(ii)
7396 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7397 c & " of CONT_TO_COMM group"
7401 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7402 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7403 c write (iout,*) "ireq,req",ireq,req(ireq)
7406 C Send the contacts to processors that need them
7407 do ii=1,ntask_cont_to
7408 iproc=itask_cont_to(ii)
7410 c write (iout,*) nn," contacts to processor",iproc,
7411 c & " of CONT_TO_COMM group"
7414 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7415 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7416 c write (iout,*) "ireq,req",ireq,req(ireq)
7418 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7422 c write (iout,*) "number of requests (contacts)",ireq
7423 c write (iout,*) "req",(req(i),i=1,4)
7426 & call MPI_Waitall(ireq,req,status_array,ierr)
7427 do iii=1,ntask_cont_from
7428 iproc=itask_cont_from(iii)
7431 write (iout,*) "Received",nn," contacts from processor",iproc,
7432 & " of CONT_FROM_COMM group"
7435 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7440 ii=zapas_recv(1,i,iii)
7441 c Flag the received contacts to prevent double-counting
7442 jj=-zapas_recv(2,i,iii)
7443 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7445 nnn=num_cont_hb(ii)+1
7448 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7452 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7457 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7465 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7474 write (iout,'(a)') 'Contact function values after receive:'
7476 write (iout,'(2i3,50(1x,i3,5f6.3))')
7477 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7478 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7485 write (iout,'(a)') 'Contact function values:'
7487 write (iout,'(2i3,50(1x,i2,5f6.3))')
7488 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7489 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7495 C Remove the loop below after debugging !!!
7502 C Calculate the dipole-dipole interaction energies
7503 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7504 do i=iatel_s,iatel_e+1
7505 num_conti=num_cont_hb(i)
7514 C Calculate the local-electrostatic correlation terms
7515 c write (iout,*) "gradcorr5 in eello5 before loop"
7517 c write (iout,'(i5,3f10.5)')
7518 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7520 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7521 c write (iout,*) "corr loop i",i
7523 num_conti=num_cont_hb(i)
7524 num_conti1=num_cont_hb(i+1)
7531 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7532 c & ' jj=',jj,' kk=',kk
7533 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7534 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7535 & .or. j.lt.0 .and. j1.gt.0) .and.
7536 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7537 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7538 C The system gains extra energy.
7540 sqd1=dsqrt(d_cont(jj,i))
7541 sqd2=dsqrt(d_cont(kk,i1))
7542 sred_geom = sqd1*sqd2
7543 IF (sred_geom.lt.cutoff_corr) THEN
7544 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7546 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7547 cd & ' jj=',jj,' kk=',kk
7548 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7549 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7551 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7552 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7555 cd write (iout,*) 'sred_geom=',sred_geom,
7556 cd & ' ekont=',ekont,' fprim=',fprimcont,
7557 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7558 cd write (iout,*) "g_contij",g_contij
7559 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7560 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7561 call calc_eello(i,jp,i+1,jp1,jj,kk)
7562 if (wcorr4.gt.0.0d0)
7563 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7564 if (energy_dec.and.wcorr4.gt.0.0d0)
7565 1 write (iout,'(a6,4i5,0pf7.3)')
7566 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7567 c write (iout,*) "gradcorr5 before eello5"
7569 c write (iout,'(i5,3f10.5)')
7570 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7572 if (wcorr5.gt.0.0d0)
7573 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7574 c write (iout,*) "gradcorr5 after eello5"
7576 c write (iout,'(i5,3f10.5)')
7577 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7579 if (energy_dec.and.wcorr5.gt.0.0d0)
7580 1 write (iout,'(a6,4i5,0pf7.3)')
7581 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7582 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7583 cd write(2,*)'ijkl',i,jp,i+1,jp1
7584 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7585 & .or. wturn6.eq.0.0d0))then
7586 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7587 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7588 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7589 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7590 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7591 cd & 'ecorr6=',ecorr6
7592 cd write (iout,'(4e15.5)') sred_geom,
7593 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7594 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7595 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7596 else if (wturn6.gt.0.0d0
7597 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7598 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7599 eturn6=eturn6+eello_turn6(i,jj,kk)
7600 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7601 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7602 cd write (2,*) 'multibody_eello:eturn6',eturn6
7611 num_cont_hb(i)=num_cont_hb_old(i)
7613 c write (iout,*) "gradcorr5 in eello5"
7615 c write (iout,'(i5,3f10.5)')
7616 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7620 c------------------------------------------------------------------------------
7621 subroutine add_hb_contact_eello(ii,jj,itask)
7622 implicit real*8 (a-h,o-z)
7623 include "DIMENSIONS"
7624 include "COMMON.IOUNITS"
7627 parameter (max_cont=maxconts)
7628 parameter (max_dim=70)
7629 include "COMMON.CONTACTS"
7630 double precision zapas(max_dim,maxconts,max_fg_procs),
7631 & zapas_recv(max_dim,maxconts,max_fg_procs)
7632 common /przechowalnia/ zapas
7633 integer i,j,ii,jj,iproc,itask(4),nn
7634 c write (iout,*) "itask",itask
7637 if (iproc.gt.0) then
7638 do j=1,num_cont_hb(ii)
7640 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7642 ncont_sent(iproc)=ncont_sent(iproc)+1
7643 nn=ncont_sent(iproc)
7644 zapas(1,nn,iproc)=ii
7645 zapas(2,nn,iproc)=jjc
7646 zapas(3,nn,iproc)=d_cont(j,ii)
7650 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7655 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7663 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7675 c------------------------------------------------------------------------------
7676 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7677 implicit real*8 (a-h,o-z)
7678 include 'DIMENSIONS'
7679 include 'COMMON.IOUNITS'
7680 include 'COMMON.DERIV'
7681 include 'COMMON.INTERACT'
7682 include 'COMMON.CONTACTS'
7683 double precision gx(3),gx1(3)
7693 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7694 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7695 C Following 4 lines for diagnostics.
7700 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7701 c & 'Contacts ',i,j,
7702 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7703 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7705 C Calculate the multi-body contribution to energy.
7706 c ecorr=ecorr+ekont*ees
7707 C Calculate multi-body contributions to the gradient.
7708 coeffpees0pij=coeffp*ees0pij
7709 coeffmees0mij=coeffm*ees0mij
7710 coeffpees0pkl=coeffp*ees0pkl
7711 coeffmees0mkl=coeffm*ees0mkl
7713 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7714 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7715 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7716 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7717 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7718 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7719 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7720 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7721 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7722 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7723 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7724 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7725 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7726 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7727 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7728 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7729 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7730 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7731 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7732 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7733 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7734 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7735 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7736 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7737 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7742 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7743 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7744 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7745 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7750 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7751 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7752 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7753 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7756 c write (iout,*) "ehbcorr",ekont*ees
7761 C---------------------------------------------------------------------------
7762 subroutine dipole(i,j,jj)
7763 implicit real*8 (a-h,o-z)
7764 include 'DIMENSIONS'
7765 include 'COMMON.IOUNITS'
7766 include 'COMMON.CHAIN'
7767 include 'COMMON.FFIELD'
7768 include 'COMMON.DERIV'
7769 include 'COMMON.INTERACT'
7770 include 'COMMON.CONTACTS'
7771 include 'COMMON.TORSION'
7772 include 'COMMON.VAR'
7773 include 'COMMON.GEO'
7774 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7776 iti1 = itortyp(itype(i+1))
7777 if (j.lt.nres-1) then
7778 itj1 = itortyp(itype(j+1))
7783 dipi(iii,1)=Ub2(iii,i)
7784 dipderi(iii)=Ub2der(iii,i)
7785 dipi(iii,2)=b1(iii,iti1)
7786 dipj(iii,1)=Ub2(iii,j)
7787 dipderj(iii)=Ub2der(iii,j)
7788 dipj(iii,2)=b1(iii,itj1)
7792 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7795 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7802 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7806 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7811 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7812 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7814 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7816 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7818 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7823 C---------------------------------------------------------------------------
7824 subroutine calc_eello(i,j,k,l,jj,kk)
7826 C This subroutine computes matrices and vectors needed to calculate
7827 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7829 implicit real*8 (a-h,o-z)
7830 include 'DIMENSIONS'
7831 include 'COMMON.IOUNITS'
7832 include 'COMMON.CHAIN'
7833 include 'COMMON.DERIV'
7834 include 'COMMON.INTERACT'
7835 include 'COMMON.CONTACTS'
7836 include 'COMMON.TORSION'
7837 include 'COMMON.VAR'
7838 include 'COMMON.GEO'
7839 include 'COMMON.FFIELD'
7840 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7841 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7844 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7845 cd & ' jj=',jj,' kk=',kk
7846 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7847 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7848 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7851 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7852 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7855 call transpose2(aa1(1,1),aa1t(1,1))
7856 call transpose2(aa2(1,1),aa2t(1,1))
7859 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7860 & aa1tder(1,1,lll,kkk))
7861 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7862 & aa2tder(1,1,lll,kkk))
7866 C parallel orientation of the two CA-CA-CA frames.
7868 iti=itortyp(itype(i))
7872 itk1=itortyp(itype(k+1))
7873 itj=itortyp(itype(j))
7874 if (l.lt.nres-1) then
7875 itl1=itortyp(itype(l+1))
7879 C A1 kernel(j+1) A2T
7881 cd write (iout,'(3f10.5,5x,3f10.5)')
7882 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7884 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7885 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7886 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7887 C Following matrices are needed only for 6-th order cumulants
7888 IF (wcorr6.gt.0.0d0) THEN
7889 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7890 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7891 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7892 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7893 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7894 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7895 & ADtEAderx(1,1,1,1,1,1))
7897 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7898 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7899 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7900 & ADtEA1derx(1,1,1,1,1,1))
7902 C End 6-th order cumulants
7905 cd write (2,*) 'In calc_eello6'
7907 cd write (2,*) 'iii=',iii
7909 cd write (2,*) 'kkk=',kkk
7911 cd write (2,'(3(2f10.5),5x)')
7912 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7917 call transpose2(EUgder(1,1,k),auxmat(1,1))
7918 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7919 call transpose2(EUg(1,1,k),auxmat(1,1))
7920 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7921 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7925 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7926 & EAEAderx(1,1,lll,kkk,iii,1))
7930 C A1T kernel(i+1) A2
7931 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7932 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7933 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7934 C Following matrices are needed only for 6-th order cumulants
7935 IF (wcorr6.gt.0.0d0) THEN
7936 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7937 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7938 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7939 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7940 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7941 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7942 & ADtEAderx(1,1,1,1,1,2))
7943 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7944 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7945 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7946 & ADtEA1derx(1,1,1,1,1,2))
7948 C End 6-th order cumulants
7949 call transpose2(EUgder(1,1,l),auxmat(1,1))
7950 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7951 call transpose2(EUg(1,1,l),auxmat(1,1))
7952 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7953 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7957 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7958 & EAEAderx(1,1,lll,kkk,iii,2))
7963 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7964 C They are needed only when the fifth- or the sixth-order cumulants are
7966 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7967 call transpose2(AEA(1,1,1),auxmat(1,1))
7968 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7969 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7970 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7971 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7972 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7973 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7974 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7975 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7976 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7977 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7978 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7979 call transpose2(AEA(1,1,2),auxmat(1,1))
7980 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7981 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7982 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7983 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7984 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7985 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7986 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7987 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7988 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7989 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7990 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7991 C Calculate the Cartesian derivatives of the vectors.
7995 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7996 call matvec2(auxmat(1,1),b1(1,iti),
7997 & AEAb1derx(1,lll,kkk,iii,1,1))
7998 call matvec2(auxmat(1,1),Ub2(1,i),
7999 & AEAb2derx(1,lll,kkk,iii,1,1))
8000 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8001 & AEAb1derx(1,lll,kkk,iii,2,1))
8002 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8003 & AEAb2derx(1,lll,kkk,iii,2,1))
8004 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8005 call matvec2(auxmat(1,1),b1(1,itj),
8006 & AEAb1derx(1,lll,kkk,iii,1,2))
8007 call matvec2(auxmat(1,1),Ub2(1,j),
8008 & AEAb2derx(1,lll,kkk,iii,1,2))
8009 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8010 & AEAb1derx(1,lll,kkk,iii,2,2))
8011 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8012 & AEAb2derx(1,lll,kkk,iii,2,2))
8019 C Antiparallel orientation of the two CA-CA-CA frames.
8021 iti=itortyp(itype(i))
8025 itk1=itortyp(itype(k+1))
8026 itl=itortyp(itype(l))
8027 itj=itortyp(itype(j))
8028 if (j.lt.nres-1) then
8029 itj1=itortyp(itype(j+1))
8033 C A2 kernel(j-1)T A1T
8034 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8035 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8036 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8037 C Following matrices are needed only for 6-th order cumulants
8038 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8039 & j.eq.i+4 .and. l.eq.i+3)) THEN
8040 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8041 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8042 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8043 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8044 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8045 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8046 & ADtEAderx(1,1,1,1,1,1))
8047 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8048 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8049 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8050 & ADtEA1derx(1,1,1,1,1,1))
8052 C End 6-th order cumulants
8053 call transpose2(EUgder(1,1,k),auxmat(1,1))
8054 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8055 call transpose2(EUg(1,1,k),auxmat(1,1))
8056 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8057 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8061 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8062 & EAEAderx(1,1,lll,kkk,iii,1))
8066 C A2T kernel(i+1)T A1
8067 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8068 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8069 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8070 C Following matrices are needed only for 6-th order cumulants
8071 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8072 & j.eq.i+4 .and. l.eq.i+3)) THEN
8073 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8074 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8075 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8076 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8077 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8078 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8079 & ADtEAderx(1,1,1,1,1,2))
8080 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8081 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8082 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8083 & ADtEA1derx(1,1,1,1,1,2))
8085 C End 6-th order cumulants
8086 call transpose2(EUgder(1,1,j),auxmat(1,1))
8087 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8088 call transpose2(EUg(1,1,j),auxmat(1,1))
8089 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8090 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8094 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8095 & EAEAderx(1,1,lll,kkk,iii,2))
8100 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8101 C They are needed only when the fifth- or the sixth-order cumulants are
8103 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8104 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8105 call transpose2(AEA(1,1,1),auxmat(1,1))
8106 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8107 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8108 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8109 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8110 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8111 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8112 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8113 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8114 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8115 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8116 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8117 call transpose2(AEA(1,1,2),auxmat(1,1))
8118 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8119 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8120 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8121 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8122 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8123 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8124 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8125 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8126 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8127 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8128 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8129 C Calculate the Cartesian derivatives of the vectors.
8133 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8134 call matvec2(auxmat(1,1),b1(1,iti),
8135 & AEAb1derx(1,lll,kkk,iii,1,1))
8136 call matvec2(auxmat(1,1),Ub2(1,i),
8137 & AEAb2derx(1,lll,kkk,iii,1,1))
8138 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8139 & AEAb1derx(1,lll,kkk,iii,2,1))
8140 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8141 & AEAb2derx(1,lll,kkk,iii,2,1))
8142 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8143 call matvec2(auxmat(1,1),b1(1,itl),
8144 & AEAb1derx(1,lll,kkk,iii,1,2))
8145 call matvec2(auxmat(1,1),Ub2(1,l),
8146 & AEAb2derx(1,lll,kkk,iii,1,2))
8147 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8148 & AEAb1derx(1,lll,kkk,iii,2,2))
8149 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8150 & AEAb2derx(1,lll,kkk,iii,2,2))
8159 C---------------------------------------------------------------------------
8160 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8161 & KK,KKderg,AKA,AKAderg,AKAderx)
8165 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8166 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8167 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8172 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8174 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8177 cd if (lprn) write (2,*) 'In kernel'
8179 cd if (lprn) write (2,*) 'kkk=',kkk
8181 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8182 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8184 cd write (2,*) 'lll=',lll
8185 cd write (2,*) 'iii=1'
8187 cd write (2,'(3(2f10.5),5x)')
8188 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8191 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8192 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8194 cd write (2,*) 'lll=',lll
8195 cd write (2,*) 'iii=2'
8197 cd write (2,'(3(2f10.5),5x)')
8198 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8205 C---------------------------------------------------------------------------
8206 double precision function eello4(i,j,k,l,jj,kk)
8207 implicit real*8 (a-h,o-z)
8208 include 'DIMENSIONS'
8209 include 'COMMON.IOUNITS'
8210 include 'COMMON.CHAIN'
8211 include 'COMMON.DERIV'
8212 include 'COMMON.INTERACT'
8213 include 'COMMON.CONTACTS'
8214 include 'COMMON.TORSION'
8215 include 'COMMON.VAR'
8216 include 'COMMON.GEO'
8217 double precision pizda(2,2),ggg1(3),ggg2(3)
8218 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8222 cd print *,'eello4:',i,j,k,l,jj,kk
8223 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8224 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8225 cold eij=facont_hb(jj,i)
8226 cold ekl=facont_hb(kk,k)
8228 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8229 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8230 gcorr_loc(k-1)=gcorr_loc(k-1)
8231 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8233 gcorr_loc(l-1)=gcorr_loc(l-1)
8234 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8236 gcorr_loc(j-1)=gcorr_loc(j-1)
8237 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8242 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8243 & -EAEAderx(2,2,lll,kkk,iii,1)
8244 cd derx(lll,kkk,iii)=0.0d0
8248 cd gcorr_loc(l-1)=0.0d0
8249 cd gcorr_loc(j-1)=0.0d0
8250 cd gcorr_loc(k-1)=0.0d0
8252 cd write (iout,*)'Contacts have occurred for peptide groups',
8253 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8254 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8255 if (j.lt.nres-1) then
8262 if (l.lt.nres-1) then
8270 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8271 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8272 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8273 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8274 cgrad ghalf=0.5d0*ggg1(ll)
8275 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8276 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8277 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8278 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8279 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8280 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8281 cgrad ghalf=0.5d0*ggg2(ll)
8282 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8283 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8284 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8285 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8286 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8287 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8291 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8296 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8301 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8306 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8310 cd write (2,*) iii,gcorr_loc(iii)
8313 cd write (2,*) 'ekont',ekont
8314 cd write (iout,*) 'eello4',ekont*eel4
8317 C---------------------------------------------------------------------------
8318 double precision function eello5(i,j,k,l,jj,kk)
8319 implicit real*8 (a-h,o-z)
8320 include 'DIMENSIONS'
8321 include 'COMMON.IOUNITS'
8322 include 'COMMON.CHAIN'
8323 include 'COMMON.DERIV'
8324 include 'COMMON.INTERACT'
8325 include 'COMMON.CONTACTS'
8326 include 'COMMON.TORSION'
8327 include 'COMMON.VAR'
8328 include 'COMMON.GEO'
8329 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8330 double precision ggg1(3),ggg2(3)
8331 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8336 C /l\ / \ \ / \ / \ / C
8337 C / \ / \ \ / \ / \ / C
8338 C j| o |l1 | o | o| o | | o |o C
8339 C \ |/k\| |/ \| / |/ \| |/ \| C
8340 C \i/ \ / \ / / \ / \ C
8342 C (I) (II) (III) (IV) C
8344 C eello5_1 eello5_2 eello5_3 eello5_4 C
8346 C Antiparallel chains C
8349 C /j\ / \ \ / \ / \ / C
8350 C / \ / \ \ / \ / \ / C
8351 C j1| o |l | o | o| o | | o |o C
8352 C \ |/k\| |/ \| / |/ \| |/ \| C
8353 C \i/ \ / \ / / \ / \ C
8355 C (I) (II) (III) (IV) C
8357 C eello5_1 eello5_2 eello5_3 eello5_4 C
8359 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8362 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8367 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8369 itk=itortyp(itype(k))
8370 itl=itortyp(itype(l))
8371 itj=itortyp(itype(j))
8376 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8377 cd & eel5_3_num,eel5_4_num)
8381 derx(lll,kkk,iii)=0.0d0
8385 cd eij=facont_hb(jj,i)
8386 cd ekl=facont_hb(kk,k)
8388 cd write (iout,*)'Contacts have occurred for peptide groups',
8389 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8391 C Contribution from the graph I.
8392 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8393 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8394 call transpose2(EUg(1,1,k),auxmat(1,1))
8395 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8396 vv(1)=pizda(1,1)-pizda(2,2)
8397 vv(2)=pizda(1,2)+pizda(2,1)
8398 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8399 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8400 C Explicit gradient in virtual-dihedral angles.
8401 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8402 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8403 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8404 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8405 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8406 vv(1)=pizda(1,1)-pizda(2,2)
8407 vv(2)=pizda(1,2)+pizda(2,1)
8408 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8409 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8410 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8411 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8412 vv(1)=pizda(1,1)-pizda(2,2)
8413 vv(2)=pizda(1,2)+pizda(2,1)
8415 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8416 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8417 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8419 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8420 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8421 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8423 C Cartesian gradient
8427 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8429 vv(1)=pizda(1,1)-pizda(2,2)
8430 vv(2)=pizda(1,2)+pizda(2,1)
8431 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8432 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8433 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8439 C Contribution from graph II
8440 call transpose2(EE(1,1,itk),auxmat(1,1))
8441 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8442 vv(1)=pizda(1,1)+pizda(2,2)
8443 vv(2)=pizda(2,1)-pizda(1,2)
8444 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8445 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8446 C Explicit gradient in virtual-dihedral angles.
8447 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8448 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8449 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8450 vv(1)=pizda(1,1)+pizda(2,2)
8451 vv(2)=pizda(2,1)-pizda(1,2)
8453 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8454 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8455 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8457 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8458 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8459 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8461 C Cartesian gradient
8465 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8467 vv(1)=pizda(1,1)+pizda(2,2)
8468 vv(2)=pizda(2,1)-pizda(1,2)
8469 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8470 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8471 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8479 C Parallel orientation
8480 C Contribution from graph III
8481 call transpose2(EUg(1,1,l),auxmat(1,1))
8482 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8483 vv(1)=pizda(1,1)-pizda(2,2)
8484 vv(2)=pizda(1,2)+pizda(2,1)
8485 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8486 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8487 C Explicit gradient in virtual-dihedral angles.
8488 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8489 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8490 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8491 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8492 vv(1)=pizda(1,1)-pizda(2,2)
8493 vv(2)=pizda(1,2)+pizda(2,1)
8494 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8495 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8496 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8497 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8498 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8499 vv(1)=pizda(1,1)-pizda(2,2)
8500 vv(2)=pizda(1,2)+pizda(2,1)
8501 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8502 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8503 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8504 C Cartesian gradient
8508 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8510 vv(1)=pizda(1,1)-pizda(2,2)
8511 vv(2)=pizda(1,2)+pizda(2,1)
8512 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8513 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8514 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8519 C Contribution from graph IV
8521 call transpose2(EE(1,1,itl),auxmat(1,1))
8522 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8523 vv(1)=pizda(1,1)+pizda(2,2)
8524 vv(2)=pizda(2,1)-pizda(1,2)
8525 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8526 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8527 C Explicit gradient in virtual-dihedral angles.
8528 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8529 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8530 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8531 vv(1)=pizda(1,1)+pizda(2,2)
8532 vv(2)=pizda(2,1)-pizda(1,2)
8533 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8534 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8535 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8536 C Cartesian gradient
8540 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8542 vv(1)=pizda(1,1)+pizda(2,2)
8543 vv(2)=pizda(2,1)-pizda(1,2)
8544 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8545 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8546 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8551 C Antiparallel orientation
8552 C Contribution from graph III
8554 call transpose2(EUg(1,1,j),auxmat(1,1))
8555 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8556 vv(1)=pizda(1,1)-pizda(2,2)
8557 vv(2)=pizda(1,2)+pizda(2,1)
8558 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8559 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8560 C Explicit gradient in virtual-dihedral angles.
8561 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8562 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8563 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8564 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)-pizda(2,2)
8566 vv(2)=pizda(1,2)+pizda(2,1)
8567 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8568 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8569 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8570 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8571 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8572 vv(1)=pizda(1,1)-pizda(2,2)
8573 vv(2)=pizda(1,2)+pizda(2,1)
8574 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8575 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8576 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8577 C Cartesian gradient
8581 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8583 vv(1)=pizda(1,1)-pizda(2,2)
8584 vv(2)=pizda(1,2)+pizda(2,1)
8585 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8586 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8587 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8592 C Contribution from graph IV
8594 call transpose2(EE(1,1,itj),auxmat(1,1))
8595 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8596 vv(1)=pizda(1,1)+pizda(2,2)
8597 vv(2)=pizda(2,1)-pizda(1,2)
8598 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8599 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8600 C Explicit gradient in virtual-dihedral angles.
8601 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8602 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8603 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8604 vv(1)=pizda(1,1)+pizda(2,2)
8605 vv(2)=pizda(2,1)-pizda(1,2)
8606 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8607 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8608 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8609 C Cartesian gradient
8613 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8615 vv(1)=pizda(1,1)+pizda(2,2)
8616 vv(2)=pizda(2,1)-pizda(1,2)
8617 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8618 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8619 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8625 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8626 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8627 cd write (2,*) 'ijkl',i,j,k,l
8628 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8629 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8631 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8632 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8633 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8634 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8635 if (j.lt.nres-1) then
8642 if (l.lt.nres-1) then
8652 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8653 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8654 C summed up outside the subrouine as for the other subroutines
8655 C handling long-range interactions. The old code is commented out
8656 C with "cgrad" to keep track of changes.
8658 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8659 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8660 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8661 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8662 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8663 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8664 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8665 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8666 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8667 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8669 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8670 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8671 cgrad ghalf=0.5d0*ggg1(ll)
8673 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8674 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8675 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8676 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8677 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8678 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8679 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8680 cgrad ghalf=0.5d0*ggg2(ll)
8682 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8683 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8684 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8685 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8686 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8687 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8692 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8693 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8698 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8699 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8705 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8710 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8714 cd write (2,*) iii,g_corr5_loc(iii)
8717 cd write (2,*) 'ekont',ekont
8718 cd write (iout,*) 'eello5',ekont*eel5
8721 c--------------------------------------------------------------------------
8722 double precision function eello6(i,j,k,l,jj,kk)
8723 implicit real*8 (a-h,o-z)
8724 include 'DIMENSIONS'
8725 include 'COMMON.IOUNITS'
8726 include 'COMMON.CHAIN'
8727 include 'COMMON.DERIV'
8728 include 'COMMON.INTERACT'
8729 include 'COMMON.CONTACTS'
8730 include 'COMMON.TORSION'
8731 include 'COMMON.VAR'
8732 include 'COMMON.GEO'
8733 include 'COMMON.FFIELD'
8734 double precision ggg1(3),ggg2(3)
8735 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8740 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8748 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8749 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8753 derx(lll,kkk,iii)=0.0d0
8757 cd eij=facont_hb(jj,i)
8758 cd ekl=facont_hb(kk,k)
8764 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8765 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8766 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8767 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8768 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8769 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8771 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8772 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8773 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8774 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8775 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8776 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8780 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8782 C If turn contributions are considered, they will be handled separately.
8783 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8784 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8785 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8786 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8787 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8788 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8789 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8791 if (j.lt.nres-1) then
8798 if (l.lt.nres-1) then
8806 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8807 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8808 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8809 cgrad ghalf=0.5d0*ggg1(ll)
8811 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8812 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8813 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8814 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8815 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8816 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8817 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8818 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8819 cgrad ghalf=0.5d0*ggg2(ll)
8820 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8822 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8823 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8824 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8825 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8826 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8827 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8832 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8833 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8838 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8839 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8845 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8850 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8854 cd write (2,*) iii,g_corr6_loc(iii)
8857 cd write (2,*) 'ekont',ekont
8858 cd write (iout,*) 'eello6',ekont*eel6
8861 c--------------------------------------------------------------------------
8862 double precision function eello6_graph1(i,j,k,l,imat,swap)
8863 implicit real*8 (a-h,o-z)
8864 include 'DIMENSIONS'
8865 include 'COMMON.IOUNITS'
8866 include 'COMMON.CHAIN'
8867 include 'COMMON.DERIV'
8868 include 'COMMON.INTERACT'
8869 include 'COMMON.CONTACTS'
8870 include 'COMMON.TORSION'
8871 include 'COMMON.VAR'
8872 include 'COMMON.GEO'
8873 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8877 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8879 C Parallel Antiparallel
8885 C \ j|/k\| / \ |/k\|l /
8890 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8891 itk=itortyp(itype(k))
8892 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8893 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8894 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8895 call transpose2(EUgC(1,1,k),auxmat(1,1))
8896 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8897 vv1(1)=pizda1(1,1)-pizda1(2,2)
8898 vv1(2)=pizda1(1,2)+pizda1(2,1)
8899 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8900 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8901 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8902 s5=scalar2(vv(1),Dtobr2(1,i))
8903 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8904 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8905 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8906 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8907 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8908 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8909 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8910 & +scalar2(vv(1),Dtobr2der(1,i)))
8911 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8912 vv1(1)=pizda1(1,1)-pizda1(2,2)
8913 vv1(2)=pizda1(1,2)+pizda1(2,1)
8914 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8915 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8917 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8918 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8919 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8920 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8921 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8923 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8924 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8925 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8926 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8927 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8929 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8930 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8931 vv1(1)=pizda1(1,1)-pizda1(2,2)
8932 vv1(2)=pizda1(1,2)+pizda1(2,1)
8933 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8934 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8935 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8936 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8945 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8946 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8947 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8948 call transpose2(EUgC(1,1,k),auxmat(1,1))
8949 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8951 vv1(1)=pizda1(1,1)-pizda1(2,2)
8952 vv1(2)=pizda1(1,2)+pizda1(2,1)
8953 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8954 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8955 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8956 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8957 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8958 s5=scalar2(vv(1),Dtobr2(1,i))
8959 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8965 c----------------------------------------------------------------------------
8966 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8967 implicit real*8 (a-h,o-z)
8968 include 'DIMENSIONS'
8969 include 'COMMON.IOUNITS'
8970 include 'COMMON.CHAIN'
8971 include 'COMMON.DERIV'
8972 include 'COMMON.INTERACT'
8973 include 'COMMON.CONTACTS'
8974 include 'COMMON.TORSION'
8975 include 'COMMON.VAR'
8976 include 'COMMON.GEO'
8978 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8979 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8982 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8984 C Parallel Antiparallel C
8990 C \ j|/k\| \ |/k\|l C
8995 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8996 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8997 C AL 7/4/01 s1 would occur in the sixth-order moment,
8998 C but not in a cluster cumulant
9000 s1=dip(1,jj,i)*dip(1,kk,k)
9002 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9003 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9004 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9005 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9006 call transpose2(EUg(1,1,k),auxmat(1,1))
9007 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9008 vv(1)=pizda(1,1)-pizda(2,2)
9009 vv(2)=pizda(1,2)+pizda(2,1)
9010 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9011 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9013 eello6_graph2=-(s1+s2+s3+s4)
9015 eello6_graph2=-(s2+s3+s4)
9018 C Derivatives in gamma(i-1)
9021 s1=dipderg(1,jj,i)*dip(1,kk,k)
9023 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9024 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9025 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9026 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9028 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9030 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9032 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9034 C Derivatives in gamma(k-1)
9036 s1=dip(1,jj,i)*dipderg(1,kk,k)
9038 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9039 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9040 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9041 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9042 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9043 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9044 vv(1)=pizda(1,1)-pizda(2,2)
9045 vv(2)=pizda(1,2)+pizda(2,1)
9046 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9048 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9050 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9052 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9053 C Derivatives in gamma(j-1) or gamma(l-1)
9056 s1=dipderg(3,jj,i)*dip(1,kk,k)
9058 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9059 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9060 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9061 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9062 vv(1)=pizda(1,1)-pizda(2,2)
9063 vv(2)=pizda(1,2)+pizda(2,1)
9064 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9067 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9069 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9072 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9073 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9075 C Derivatives in gamma(l-1) or gamma(j-1)
9078 s1=dip(1,jj,i)*dipderg(3,kk,k)
9080 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9081 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9082 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9083 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9084 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9085 vv(1)=pizda(1,1)-pizda(2,2)
9086 vv(2)=pizda(1,2)+pizda(2,1)
9087 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9090 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9092 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9095 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9096 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9098 C Cartesian derivatives.
9100 write (2,*) 'In eello6_graph2'
9102 write (2,*) 'iii=',iii
9104 write (2,*) 'kkk=',kkk
9106 write (2,'(3(2f10.5),5x)')
9107 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9117 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9119 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9122 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9124 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9125 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9127 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9128 call transpose2(EUg(1,1,k),auxmat(1,1))
9129 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9131 vv(1)=pizda(1,1)-pizda(2,2)
9132 vv(2)=pizda(1,2)+pizda(2,1)
9133 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9134 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9136 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9138 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9141 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9143 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9150 c----------------------------------------------------------------------------
9151 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9152 implicit real*8 (a-h,o-z)
9153 include 'DIMENSIONS'
9154 include 'COMMON.IOUNITS'
9155 include 'COMMON.CHAIN'
9156 include 'COMMON.DERIV'
9157 include 'COMMON.INTERACT'
9158 include 'COMMON.CONTACTS'
9159 include 'COMMON.TORSION'
9160 include 'COMMON.VAR'
9161 include 'COMMON.GEO'
9162 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9164 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9166 C Parallel Antiparallel C
9172 C j|/k\| / |/k\|l / C
9177 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9179 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9180 C energy moment and not to the cluster cumulant.
9181 iti=itortyp(itype(i))
9182 if (j.lt.nres-1) then
9183 itj1=itortyp(itype(j+1))
9187 itk=itortyp(itype(k))
9188 itk1=itortyp(itype(k+1))
9189 if (l.lt.nres-1) then
9190 itl1=itortyp(itype(l+1))
9195 s1=dip(4,jj,i)*dip(4,kk,k)
9197 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9198 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9199 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9200 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9201 call transpose2(EE(1,1,itk),auxmat(1,1))
9202 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9203 vv(1)=pizda(1,1)+pizda(2,2)
9204 vv(2)=pizda(2,1)-pizda(1,2)
9205 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9206 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9207 cd & "sum",-(s2+s3+s4)
9209 eello6_graph3=-(s1+s2+s3+s4)
9211 eello6_graph3=-(s2+s3+s4)
9214 C Derivatives in gamma(k-1)
9215 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9216 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9217 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9218 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9219 C Derivatives in gamma(l-1)
9220 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9221 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9222 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9223 vv(1)=pizda(1,1)+pizda(2,2)
9224 vv(2)=pizda(2,1)-pizda(1,2)
9225 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9226 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9227 C Cartesian derivatives.
9233 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9235 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9238 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9240 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9241 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9243 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9244 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9246 vv(1)=pizda(1,1)+pizda(2,2)
9247 vv(2)=pizda(2,1)-pizda(1,2)
9248 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9250 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9252 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9255 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9257 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9259 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9265 c----------------------------------------------------------------------------
9266 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9267 implicit real*8 (a-h,o-z)
9268 include 'DIMENSIONS'
9269 include 'COMMON.IOUNITS'
9270 include 'COMMON.CHAIN'
9271 include 'COMMON.DERIV'
9272 include 'COMMON.INTERACT'
9273 include 'COMMON.CONTACTS'
9274 include 'COMMON.TORSION'
9275 include 'COMMON.VAR'
9276 include 'COMMON.GEO'
9277 include 'COMMON.FFIELD'
9278 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9279 & auxvec1(2),auxmat1(2,2)
9281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9283 C Parallel Antiparallel C
9289 C \ j|/k\| \ |/k\|l C
9294 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9296 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9297 C energy moment and not to the cluster cumulant.
9298 cd write (2,*) 'eello_graph4: wturn6',wturn6
9299 iti=itortyp(itype(i))
9300 itj=itortyp(itype(j))
9301 if (j.lt.nres-1) then
9302 itj1=itortyp(itype(j+1))
9306 itk=itortyp(itype(k))
9307 if (k.lt.nres-1) then
9308 itk1=itortyp(itype(k+1))
9312 itl=itortyp(itype(l))
9313 if (l.lt.nres-1) then
9314 itl1=itortyp(itype(l+1))
9318 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9319 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9320 cd & ' itl',itl,' itl1',itl1
9323 s1=dip(3,jj,i)*dip(3,kk,k)
9325 s1=dip(2,jj,j)*dip(2,kk,l)
9328 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9329 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9331 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9332 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9334 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9335 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9337 call transpose2(EUg(1,1,k),auxmat(1,1))
9338 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9339 vv(1)=pizda(1,1)-pizda(2,2)
9340 vv(2)=pizda(2,1)+pizda(1,2)
9341 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9342 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9344 eello6_graph4=-(s1+s2+s3+s4)
9346 eello6_graph4=-(s2+s3+s4)
9348 C Derivatives in gamma(i-1)
9352 s1=dipderg(2,jj,i)*dip(3,kk,k)
9354 s1=dipderg(4,jj,j)*dip(2,kk,l)
9357 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9359 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9360 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9362 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9363 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9365 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9366 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9367 cd write (2,*) 'turn6 derivatives'
9369 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9371 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9375 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9377 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9381 C Derivatives in gamma(k-1)
9384 s1=dip(3,jj,i)*dipderg(2,kk,k)
9386 s1=dip(2,jj,j)*dipderg(4,kk,l)
9389 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9390 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9392 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9393 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9395 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9396 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9398 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9399 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9400 vv(1)=pizda(1,1)-pizda(2,2)
9401 vv(2)=pizda(2,1)+pizda(1,2)
9402 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9403 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9405 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9407 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9411 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9413 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9416 C Derivatives in gamma(j-1) or gamma(l-1)
9417 if (l.eq.j+1 .and. l.gt.1) then
9418 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9419 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9420 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9421 vv(1)=pizda(1,1)-pizda(2,2)
9422 vv(2)=pizda(2,1)+pizda(1,2)
9423 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9424 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9425 else if (j.gt.1) then
9426 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9427 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9428 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9429 vv(1)=pizda(1,1)-pizda(2,2)
9430 vv(2)=pizda(2,1)+pizda(1,2)
9431 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9432 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9433 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9435 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9438 C Cartesian derivatives.
9445 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9447 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9451 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9453 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9457 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9459 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9461 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9462 & b1(1,itj1),auxvec(1))
9463 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9465 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9466 & b1(1,itl1),auxvec(1))
9467 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9469 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9471 vv(1)=pizda(1,1)-pizda(2,2)
9472 vv(2)=pizda(2,1)+pizda(1,2)
9473 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9475 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9477 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9480 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9483 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9486 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9488 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9490 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9494 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9496 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9499 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9501 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9509 c----------------------------------------------------------------------------
9510 double precision function eello_turn6(i,jj,kk)
9511 implicit real*8 (a-h,o-z)
9512 include 'DIMENSIONS'
9513 include 'COMMON.IOUNITS'
9514 include 'COMMON.CHAIN'
9515 include 'COMMON.DERIV'
9516 include 'COMMON.INTERACT'
9517 include 'COMMON.CONTACTS'
9518 include 'COMMON.TORSION'
9519 include 'COMMON.VAR'
9520 include 'COMMON.GEO'
9521 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9522 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9524 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9525 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9526 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9527 C the respective energy moment and not to the cluster cumulant.
9536 iti=itortyp(itype(i))
9537 itk=itortyp(itype(k))
9538 itk1=itortyp(itype(k+1))
9539 itl=itortyp(itype(l))
9540 itj=itortyp(itype(j))
9541 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9542 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9543 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9548 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9550 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9554 derx_turn(lll,kkk,iii)=0.0d0
9561 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9563 cd write (2,*) 'eello6_5',eello6_5
9565 call transpose2(AEA(1,1,1),auxmat(1,1))
9566 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9567 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9568 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9570 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9571 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9572 s2 = scalar2(b1(1,itk),vtemp1(1))
9574 call transpose2(AEA(1,1,2),atemp(1,1))
9575 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9576 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9577 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9579 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9580 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9581 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9583 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9584 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9585 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9586 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9587 ss13 = scalar2(b1(1,itk),vtemp4(1))
9588 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9590 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9596 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9597 C Derivatives in gamma(i+2)
9601 call transpose2(AEA(1,1,1),auxmatd(1,1))
9602 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9603 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9604 call transpose2(AEAderg(1,1,2),atempd(1,1))
9605 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9606 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9608 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9609 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9610 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9616 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9617 C Derivatives in gamma(i+3)
9619 call transpose2(AEA(1,1,1),auxmatd(1,1))
9620 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9621 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9622 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9624 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9625 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9626 s2d = scalar2(b1(1,itk),vtemp1d(1))
9628 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9629 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9631 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9633 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9634 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9635 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9643 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9644 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9646 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9647 & -0.5d0*ekont*(s2d+s12d)
9649 C Derivatives in gamma(i+4)
9650 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9651 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9652 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9654 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9655 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9656 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9664 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9666 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9668 C Derivatives in gamma(i+5)
9670 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9671 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9672 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9674 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9675 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9676 s2d = scalar2(b1(1,itk),vtemp1d(1))
9678 call transpose2(AEA(1,1,2),atempd(1,1))
9679 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9680 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9682 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9683 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9685 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9686 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9687 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9695 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9696 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9698 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9699 & -0.5d0*ekont*(s2d+s12d)
9701 C Cartesian derivatives
9706 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9707 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9708 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9710 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9711 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9713 s2d = scalar2(b1(1,itk),vtemp1d(1))
9715 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9716 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9717 s8d = -(atempd(1,1)+atempd(2,2))*
9718 & scalar2(cc(1,1,itl),vtemp2(1))
9720 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9722 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9723 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9730 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9733 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9737 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9738 & - 0.5d0*(s8d+s12d)
9740 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9749 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9751 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9752 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9753 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9754 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9755 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9757 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9758 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9759 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9763 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9764 cd & 16*eel_turn6_num
9766 if (j.lt.nres-1) then
9773 if (l.lt.nres-1) then
9781 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9782 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9783 cgrad ghalf=0.5d0*ggg1(ll)
9785 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9786 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9787 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9788 & +ekont*derx_turn(ll,2,1)
9789 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9790 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9791 & +ekont*derx_turn(ll,4,1)
9792 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9793 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9794 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9795 cgrad ghalf=0.5d0*ggg2(ll)
9797 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9798 & +ekont*derx_turn(ll,2,2)
9799 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9800 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9801 & +ekont*derx_turn(ll,4,2)
9802 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9803 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9804 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9809 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9814 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9820 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9825 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9829 cd write (2,*) iii,g_corr6_loc(iii)
9831 eello_turn6=ekont*eel_turn6
9832 cd write (2,*) 'ekont',ekont
9833 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9837 C-----------------------------------------------------------------------------
9838 double precision function scalar(u,v)
9839 !DIR$ INLINEALWAYS scalar
9841 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9844 double precision u(3),v(3)
9845 cd double precision sc
9853 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9856 crc-------------------------------------------------
9857 SUBROUTINE MATVEC2(A1,V1,V2)
9858 !DIR$ INLINEALWAYS MATVEC2
9860 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9862 implicit real*8 (a-h,o-z)
9863 include 'DIMENSIONS'
9864 DIMENSION A1(2,2),V1(2),V2(2)
9868 c 3 VI=VI+A1(I,K)*V1(K)
9872 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9873 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9878 C---------------------------------------
9879 SUBROUTINE MATMAT2(A1,A2,A3)
9881 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9883 implicit real*8 (a-h,o-z)
9884 include 'DIMENSIONS'
9885 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9886 c DIMENSION AI3(2,2)
9890 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9896 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9897 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9898 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9899 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9907 c-------------------------------------------------------------------------
9908 double precision function scalar2(u,v)
9909 !DIR$ INLINEALWAYS scalar2
9911 double precision u(2),v(2)
9914 scalar2=u(1)*v(1)+u(2)*v(2)
9918 C-----------------------------------------------------------------------------
9920 subroutine transpose2(a,at)
9921 !DIR$ INLINEALWAYS transpose2
9923 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9926 double precision a(2,2),at(2,2)
9933 c--------------------------------------------------------------------------
9934 subroutine transpose(n,a,at)
9937 double precision a(n,n),at(n,n)
9945 C---------------------------------------------------------------------------
9946 subroutine prodmat3(a1,a2,kk,transp,prod)
9947 !DIR$ INLINEALWAYS prodmat3
9949 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9953 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9955 crc double precision auxmat(2,2),prod_(2,2)
9958 crc call transpose2(kk(1,1),auxmat(1,1))
9959 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9960 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9962 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9963 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9964 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9965 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9966 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9967 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9968 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9969 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9972 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9973 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9975 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9976 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9977 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9978 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9979 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9980 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9981 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9982 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9985 c call transpose2(a2(1,1),a2t(1,1))
9988 crc print *,((prod_(i,j),i=1,2),j=1,2)
9989 crc print *,((prod(i,j),i=1,2),j=1,2)