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) write (iout,'(a6,2i5,0pf7.3)')
1787 C Calculate gradient components.
1788 e1=e1*eps1*eps2rt**2*eps3rt**2
1789 fac=-expon*(e1+evdwij)*rij_shift
1793 C Calculate the radial part of the gradient
1797 C Calculate angular part of the gradient.
1799 if (bb(itypi,itypj).gt.0) then
1811 c write (iout,*) "Number of loop steps in EGB:",ind
1812 cccc energy_dec=.false.
1815 C-----------------------------------------------------------------------------
1816 subroutine egbv(evdw,evdw_p,evdw_m)
1818 C This subroutine calculates the interaction energy of nonbonded side chains
1819 C assuming the Gay-Berne-Vorobjev potential of interaction.
1821 implicit real*8 (a-h,o-z)
1822 include 'DIMENSIONS'
1823 include 'COMMON.GEO'
1824 include 'COMMON.VAR'
1825 include 'COMMON.LOCAL'
1826 include 'COMMON.CHAIN'
1827 include 'COMMON.DERIV'
1828 include 'COMMON.NAMES'
1829 include 'COMMON.INTERACT'
1830 include 'COMMON.IOUNITS'
1831 include 'COMMON.CALC'
1832 common /srutu/ icall
1835 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1838 c if (icall.eq.0) lprn=.true.
1840 do i=iatsc_s,iatsc_e
1846 dxi=dc_norm(1,nres+i)
1847 dyi=dc_norm(2,nres+i)
1848 dzi=dc_norm(3,nres+i)
1849 c dsci_inv=dsc_inv(itypi)
1850 dsci_inv=vbld_inv(i+nres)
1852 C Calculate SC interaction energy.
1854 do iint=1,nint_gr(i)
1855 do j=istart(i,iint),iend(i,iint)
1858 c dscj_inv=dsc_inv(itypj)
1859 dscj_inv=vbld_inv(j+nres)
1860 sig0ij=sigma(itypi,itypj)
1861 r0ij=r0(itypi,itypj)
1862 chi1=chi(itypi,itypj)
1863 chi2=chi(itypj,itypi)
1870 alf12=0.5D0*(alf1+alf2)
1871 C For diagnostics only!!!
1884 dxj=dc_norm(1,nres+j)
1885 dyj=dc_norm(2,nres+j)
1886 dzj=dc_norm(3,nres+j)
1887 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1889 C Calculate angle-dependent terms of energy and contributions to their
1893 sig=sig0ij*dsqrt(sigsq)
1894 rij_shift=1.0D0/rij-sig+r0ij
1895 C I hate to put IF's in the loops, but here don't have another choice!!!!
1896 if (rij_shift.le.0.0D0) then
1901 c---------------------------------------------------------------
1902 rij_shift=1.0D0/rij_shift
1903 fac=rij_shift**expon
1904 e1=fac*fac*aa(itypi,itypj)
1905 e2=fac*bb(itypi,itypj)
1906 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1907 eps2der=evdwij*eps3rt
1908 eps3der=evdwij*eps2rt
1909 fac_augm=rrij**expon
1910 e_augm=augm(itypi,itypj)*fac_augm
1911 evdwij=evdwij*eps2rt*eps3rt
1913 if (bb(itypi,itypj).gt.0) then
1914 evdw_p=evdw_p+evdwij+e_augm
1916 evdw_m=evdw_m+evdwij+e_augm
1919 evdw=evdw+evdwij+e_augm
1922 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1923 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1924 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1925 & restyp(itypi),i,restyp(itypj),j,
1926 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1927 & chi1,chi2,chip1,chip2,
1928 & eps1,eps2rt**2,eps3rt**2,
1929 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1932 C Calculate gradient components.
1933 e1=e1*eps1*eps2rt**2*eps3rt**2
1934 fac=-expon*(e1+evdwij)*rij_shift
1936 fac=rij*fac-2*expon*rrij*e_augm
1937 C Calculate the radial part of the gradient
1941 C Calculate angular part of the gradient.
1943 if (bb(itypi,itypj).gt.0) then
1955 C-----------------------------------------------------------------------------
1956 subroutine sc_angular
1957 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1958 C om12. Called by ebp, egb, and egbv.
1960 include 'COMMON.CALC'
1961 include 'COMMON.IOUNITS'
1965 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1966 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1967 om12=dxi*dxj+dyi*dyj+dzi*dzj
1969 C Calculate eps1(om12) and its derivative in om12
1970 faceps1=1.0D0-om12*chiom12
1971 faceps1_inv=1.0D0/faceps1
1972 eps1=dsqrt(faceps1_inv)
1973 C Following variable is eps1*deps1/dom12
1974 eps1_om12=faceps1_inv*chiom12
1979 c write (iout,*) "om12",om12," eps1",eps1
1980 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1985 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1986 sigsq=1.0D0-facsig*faceps1_inv
1987 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1988 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1989 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1995 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1996 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1998 C Calculate eps2 and its derivatives in om1, om2, and om12.
2001 chipom12=chip12*om12
2002 facp=1.0D0-om12*chipom12
2004 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2005 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2006 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2007 C Following variable is the square root of eps2
2008 eps2rt=1.0D0-facp1*facp_inv
2009 C Following three variables are the derivatives of the square root of eps
2010 C in om1, om2, and om12.
2011 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2012 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2013 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2014 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2015 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2016 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2017 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2018 c & " eps2rt_om12",eps2rt_om12
2019 C Calculate whole angle-dependent part of epsilon and contributions
2020 C to its derivatives
2024 C----------------------------------------------------------------------------
2025 subroutine sc_grad_T
2026 implicit real*8 (a-h,o-z)
2027 include 'DIMENSIONS'
2028 include 'COMMON.CHAIN'
2029 include 'COMMON.DERIV'
2030 include 'COMMON.CALC'
2031 include 'COMMON.IOUNITS'
2032 double precision dcosom1(3),dcosom2(3)
2033 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2034 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2035 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2036 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2040 c eom12=evdwij*eps1_om12
2042 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2043 c & " sigder",sigder
2044 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2045 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2047 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2048 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2051 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2053 c write (iout,*) "gg",(gg(k),k=1,3)
2055 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2056 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2057 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2058 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2059 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2060 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2061 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2062 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2063 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2064 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2067 C Calculate the components of the gradient in DC and X
2071 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2075 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2076 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2081 C----------------------------------------------------------------------------
2083 implicit real*8 (a-h,o-z)
2084 include 'DIMENSIONS'
2085 include 'COMMON.CHAIN'
2086 include 'COMMON.DERIV'
2087 include 'COMMON.CALC'
2088 include 'COMMON.IOUNITS'
2089 double precision dcosom1(3),dcosom2(3)
2090 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2091 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2092 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2093 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2097 c eom12=evdwij*eps1_om12
2099 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2100 c & " sigder",sigder
2101 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2102 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2104 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2105 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2108 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2110 c write (iout,*) "gg",(gg(k),k=1,3)
2112 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2113 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2114 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2115 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2116 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2117 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2118 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2119 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2120 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2121 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2124 C Calculate the components of the gradient in DC and X
2128 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2132 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2133 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2137 C-----------------------------------------------------------------------
2138 subroutine e_softsphere(evdw)
2140 C This subroutine calculates the interaction energy of nonbonded side chains
2141 C assuming the LJ potential of interaction.
2143 implicit real*8 (a-h,o-z)
2144 include 'DIMENSIONS'
2145 parameter (accur=1.0d-10)
2146 include 'COMMON.GEO'
2147 include 'COMMON.VAR'
2148 include 'COMMON.LOCAL'
2149 include 'COMMON.CHAIN'
2150 include 'COMMON.DERIV'
2151 include 'COMMON.INTERACT'
2152 include 'COMMON.TORSION'
2153 include 'COMMON.SBRIDGE'
2154 include 'COMMON.NAMES'
2155 include 'COMMON.IOUNITS'
2156 include 'COMMON.CONTACTS'
2158 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2160 do i=iatsc_s,iatsc_e
2167 C Calculate SC interaction energy.
2169 do iint=1,nint_gr(i)
2170 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2171 cd & 'iend=',iend(i,iint)
2172 do j=istart(i,iint),iend(i,iint)
2177 rij=xj*xj+yj*yj+zj*zj
2178 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2179 r0ij=r0(itypi,itypj)
2181 c print *,i,j,r0ij,dsqrt(rij)
2182 if (rij.lt.r0ijsq) then
2183 evdwij=0.25d0*(rij-r0ijsq)**2
2191 C Calculate the components of the gradient in DC and X
2197 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2198 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2199 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2200 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2204 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2212 C--------------------------------------------------------------------------
2213 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2216 C Soft-sphere potential of p-p interaction
2218 implicit real*8 (a-h,o-z)
2219 include 'DIMENSIONS'
2220 include 'COMMON.CONTROL'
2221 include 'COMMON.IOUNITS'
2222 include 'COMMON.GEO'
2223 include 'COMMON.VAR'
2224 include 'COMMON.LOCAL'
2225 include 'COMMON.CHAIN'
2226 include 'COMMON.DERIV'
2227 include 'COMMON.INTERACT'
2228 include 'COMMON.CONTACTS'
2229 include 'COMMON.TORSION'
2230 include 'COMMON.VECTORS'
2231 include 'COMMON.FFIELD'
2233 cd write(iout,*) 'In EELEC_soft_sphere'
2240 do i=iatel_s,iatel_e
2244 xmedi=c(1,i)+0.5d0*dxi
2245 ymedi=c(2,i)+0.5d0*dyi
2246 zmedi=c(3,i)+0.5d0*dzi
2248 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2249 do j=ielstart(i),ielend(i)
2253 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2254 r0ij=rpp(iteli,itelj)
2259 xj=c(1,j)+0.5D0*dxj-xmedi
2260 yj=c(2,j)+0.5D0*dyj-ymedi
2261 zj=c(3,j)+0.5D0*dzj-zmedi
2262 rij=xj*xj+yj*yj+zj*zj
2263 if (rij.lt.r0ijsq) then
2264 evdw1ij=0.25d0*(rij-r0ijsq)**2
2272 C Calculate contributions to the Cartesian gradient.
2278 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2279 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2282 * Loop over residues i+1 thru j-1.
2286 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2291 cgrad do i=nnt,nct-1
2293 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2295 cgrad do j=i+1,nct-1
2297 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2303 c------------------------------------------------------------------------------
2304 subroutine vec_and_deriv
2305 implicit real*8 (a-h,o-z)
2306 include 'DIMENSIONS'
2310 include 'COMMON.IOUNITS'
2311 include 'COMMON.GEO'
2312 include 'COMMON.VAR'
2313 include 'COMMON.LOCAL'
2314 include 'COMMON.CHAIN'
2315 include 'COMMON.VECTORS'
2316 include 'COMMON.SETUP'
2317 include 'COMMON.TIME1'
2318 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2319 C Compute the local reference systems. For reference system (i), the
2320 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2321 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2323 do i=ivec_start,ivec_end
2327 if (i.eq.nres-1) then
2328 C Case of the last full residue
2329 C Compute the Z-axis
2330 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2331 costh=dcos(pi-theta(nres))
2332 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2336 C Compute the derivatives of uz
2338 uzder(2,1,1)=-dc_norm(3,i-1)
2339 uzder(3,1,1)= dc_norm(2,i-1)
2340 uzder(1,2,1)= dc_norm(3,i-1)
2342 uzder(3,2,1)=-dc_norm(1,i-1)
2343 uzder(1,3,1)=-dc_norm(2,i-1)
2344 uzder(2,3,1)= dc_norm(1,i-1)
2347 uzder(2,1,2)= dc_norm(3,i)
2348 uzder(3,1,2)=-dc_norm(2,i)
2349 uzder(1,2,2)=-dc_norm(3,i)
2351 uzder(3,2,2)= dc_norm(1,i)
2352 uzder(1,3,2)= dc_norm(2,i)
2353 uzder(2,3,2)=-dc_norm(1,i)
2355 C Compute the Y-axis
2358 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2360 C Compute the derivatives of uy
2363 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2364 & -dc_norm(k,i)*dc_norm(j,i-1)
2365 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2367 uyder(j,j,1)=uyder(j,j,1)-costh
2368 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2373 uygrad(l,k,j,i)=uyder(l,k,j)
2374 uzgrad(l,k,j,i)=uzder(l,k,j)
2378 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2379 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2380 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2381 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2384 C Compute the Z-axis
2385 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2386 costh=dcos(pi-theta(i+2))
2387 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2391 C Compute the derivatives of uz
2393 uzder(2,1,1)=-dc_norm(3,i+1)
2394 uzder(3,1,1)= dc_norm(2,i+1)
2395 uzder(1,2,1)= dc_norm(3,i+1)
2397 uzder(3,2,1)=-dc_norm(1,i+1)
2398 uzder(1,3,1)=-dc_norm(2,i+1)
2399 uzder(2,3,1)= dc_norm(1,i+1)
2402 uzder(2,1,2)= dc_norm(3,i)
2403 uzder(3,1,2)=-dc_norm(2,i)
2404 uzder(1,2,2)=-dc_norm(3,i)
2406 uzder(3,2,2)= dc_norm(1,i)
2407 uzder(1,3,2)= dc_norm(2,i)
2408 uzder(2,3,2)=-dc_norm(1,i)
2410 C Compute the Y-axis
2413 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2415 C Compute the derivatives of uy
2418 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2419 & -dc_norm(k,i)*dc_norm(j,i+1)
2420 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2422 uyder(j,j,1)=uyder(j,j,1)-costh
2423 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2428 uygrad(l,k,j,i)=uyder(l,k,j)
2429 uzgrad(l,k,j,i)=uzder(l,k,j)
2433 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2434 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2435 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2436 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2440 vbld_inv_temp(1)=vbld_inv(i+1)
2441 if (i.lt.nres-1) then
2442 vbld_inv_temp(2)=vbld_inv(i+2)
2444 vbld_inv_temp(2)=vbld_inv(i)
2449 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2450 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2455 #if defined(PARVEC) && defined(MPI)
2456 if (nfgtasks1.gt.1) then
2458 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2459 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2460 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2461 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2462 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2464 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2465 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2467 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2468 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2469 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2470 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2471 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2472 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2473 time_gather=time_gather+MPI_Wtime()-time00
2475 c if (fg_rank.eq.0) then
2476 c write (iout,*) "Arrays UY and UZ"
2478 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2485 C-----------------------------------------------------------------------------
2486 subroutine check_vecgrad
2487 implicit real*8 (a-h,o-z)
2488 include 'DIMENSIONS'
2489 include 'COMMON.IOUNITS'
2490 include 'COMMON.GEO'
2491 include 'COMMON.VAR'
2492 include 'COMMON.LOCAL'
2493 include 'COMMON.CHAIN'
2494 include 'COMMON.VECTORS'
2495 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2496 dimension uyt(3,maxres),uzt(3,maxres)
2497 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2498 double precision delta /1.0d-7/
2501 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2502 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2503 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2504 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2505 cd & (dc_norm(if90,i),if90=1,3)
2506 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2507 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2508 cd write(iout,'(a)')
2514 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2515 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2528 cd write (iout,*) 'i=',i
2530 erij(k)=dc_norm(k,i)
2534 dc_norm(k,i)=erij(k)
2536 dc_norm(j,i)=dc_norm(j,i)+delta
2537 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2539 c dc_norm(k,i)=dc_norm(k,i)/fac
2541 c write (iout,*) (dc_norm(k,i),k=1,3)
2542 c write (iout,*) (erij(k),k=1,3)
2545 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2546 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2547 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2548 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2550 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2551 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2552 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2555 dc_norm(k,i)=erij(k)
2558 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2559 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2560 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2561 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2562 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2563 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2564 cd write (iout,'(a)')
2569 C--------------------------------------------------------------------------
2570 subroutine set_matrices
2571 implicit real*8 (a-h,o-z)
2572 include 'DIMENSIONS'
2575 include "COMMON.SETUP"
2577 integer status(MPI_STATUS_SIZE)
2579 include 'COMMON.IOUNITS'
2580 include 'COMMON.GEO'
2581 include 'COMMON.VAR'
2582 include 'COMMON.LOCAL'
2583 include 'COMMON.CHAIN'
2584 include 'COMMON.DERIV'
2585 include 'COMMON.INTERACT'
2586 include 'COMMON.CONTACTS'
2587 include 'COMMON.TORSION'
2588 include 'COMMON.VECTORS'
2589 include 'COMMON.FFIELD'
2590 double precision auxvec(2),auxmat(2,2)
2592 C Compute the virtual-bond-torsional-angle dependent quantities needed
2593 C to calculate the el-loc multibody terms of various order.
2596 do i=ivec_start+2,ivec_end+2
2600 if (i .lt. nres+1) then
2637 if (i .gt. 3 .and. i .lt. nres+1) then
2638 obrot_der(1,i-2)=-sin1
2639 obrot_der(2,i-2)= cos1
2640 Ugder(1,1,i-2)= sin1
2641 Ugder(1,2,i-2)=-cos1
2642 Ugder(2,1,i-2)=-cos1
2643 Ugder(2,2,i-2)=-sin1
2646 obrot2_der(1,i-2)=-dwasin2
2647 obrot2_der(2,i-2)= dwacos2
2648 Ug2der(1,1,i-2)= dwasin2
2649 Ug2der(1,2,i-2)=-dwacos2
2650 Ug2der(2,1,i-2)=-dwacos2
2651 Ug2der(2,2,i-2)=-dwasin2
2653 obrot_der(1,i-2)=0.0d0
2654 obrot_der(2,i-2)=0.0d0
2655 Ugder(1,1,i-2)=0.0d0
2656 Ugder(1,2,i-2)=0.0d0
2657 Ugder(2,1,i-2)=0.0d0
2658 Ugder(2,2,i-2)=0.0d0
2659 obrot2_der(1,i-2)=0.0d0
2660 obrot2_der(2,i-2)=0.0d0
2661 Ug2der(1,1,i-2)=0.0d0
2662 Ug2der(1,2,i-2)=0.0d0
2663 Ug2der(2,1,i-2)=0.0d0
2664 Ug2der(2,2,i-2)=0.0d0
2666 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2667 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2668 iti = itortyp(itype(i-2))
2672 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2673 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2674 iti1 = itortyp(itype(i-1))
2678 cd write (iout,*) '*******i',i,' iti1',iti
2679 cd write (iout,*) 'b1',b1(:,iti)
2680 cd write (iout,*) 'b2',b2(:,iti)
2681 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2682 c if (i .gt. iatel_s+2) then
2683 if (i .gt. nnt+2) then
2684 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2685 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2686 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2688 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2689 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2690 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2691 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2692 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2703 DtUg2(l,k,i-2)=0.0d0
2707 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2708 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2710 muder(k,i-2)=Ub2der(k,i-2)
2712 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2713 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2714 iti1 = itortyp(itype(i-1))
2719 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2721 cd write (iout,*) 'mu ',mu(:,i-2)
2722 cd write (iout,*) 'mu1',mu1(:,i-2)
2723 cd write (iout,*) 'mu2',mu2(:,i-2)
2724 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2726 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2727 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2728 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2729 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2730 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2731 C Vectors and matrices dependent on a single virtual-bond dihedral.
2732 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2733 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2734 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2735 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2736 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2737 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2738 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2739 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2740 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2743 C Matrices dependent on two consecutive virtual-bond dihedrals.
2744 C The order of matrices is from left to right.
2745 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2747 c do i=max0(ivec_start,2),ivec_end
2749 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2750 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2751 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2752 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2753 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2754 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2755 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2756 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2759 #if defined(MPI) && defined(PARMAT)
2761 c if (fg_rank.eq.0) then
2762 write (iout,*) "Arrays UG and UGDER before GATHER"
2764 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2765 & ((ug(l,k,i),l=1,2),k=1,2),
2766 & ((ugder(l,k,i),l=1,2),k=1,2)
2768 write (iout,*) "Arrays UG2 and UG2DER"
2770 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2771 & ((ug2(l,k,i),l=1,2),k=1,2),
2772 & ((ug2der(l,k,i),l=1,2),k=1,2)
2774 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2776 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2777 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2778 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2780 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2782 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2783 & costab(i),sintab(i),costab2(i),sintab2(i)
2785 write (iout,*) "Array MUDER"
2787 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2791 if (nfgtasks.gt.1) then
2793 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2794 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2795 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2797 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2798 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2800 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2801 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2803 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2804 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2806 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2807 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2809 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2810 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2812 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2816 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2817 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2818 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2819 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2820 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2821 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2822 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2823 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2824 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2825 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2826 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2827 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2829 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2830 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2832 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2833 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2835 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2836 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2838 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2839 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2841 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2842 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2844 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2845 & ivec_count(fg_rank1),
2846 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2848 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2849 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2851 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2852 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2854 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2855 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2857 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2858 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2860 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2861 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2863 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2864 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2866 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2867 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2869 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2870 & ivec_count(fg_rank1),
2871 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2873 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2874 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2876 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2877 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2879 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2880 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2882 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2883 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2885 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2886 & ivec_count(fg_rank1),
2887 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2889 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2890 & ivec_count(fg_rank1),
2891 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2893 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2894 & ivec_count(fg_rank1),
2895 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2896 & MPI_MAT2,FG_COMM1,IERR)
2897 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2898 & ivec_count(fg_rank1),
2899 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2900 & MPI_MAT2,FG_COMM1,IERR)
2903 c Passes matrix info through the ring
2906 if (irecv.lt.0) irecv=nfgtasks1-1
2909 if (inext.ge.nfgtasks1) inext=0
2911 c write (iout,*) "isend",isend," irecv",irecv
2913 lensend=lentyp(isend)
2914 lenrecv=lentyp(irecv)
2915 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2916 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2917 c & MPI_ROTAT1(lensend),inext,2200+isend,
2918 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2919 c & iprev,2200+irecv,FG_COMM,status,IERR)
2920 c write (iout,*) "Gather ROTAT1"
2922 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2923 c & MPI_ROTAT2(lensend),inext,3300+isend,
2924 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2925 c & iprev,3300+irecv,FG_COMM,status,IERR)
2926 c write (iout,*) "Gather ROTAT2"
2928 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2929 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2930 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2931 & iprev,4400+irecv,FG_COMM,status,IERR)
2932 c write (iout,*) "Gather ROTAT_OLD"
2934 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2935 & MPI_PRECOMP11(lensend),inext,5500+isend,
2936 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2937 & iprev,5500+irecv,FG_COMM,status,IERR)
2938 c write (iout,*) "Gather PRECOMP11"
2940 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2941 & MPI_PRECOMP12(lensend),inext,6600+isend,
2942 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2943 & iprev,6600+irecv,FG_COMM,status,IERR)
2944 c write (iout,*) "Gather PRECOMP12"
2946 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2948 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2949 & MPI_ROTAT2(lensend),inext,7700+isend,
2950 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2951 & iprev,7700+irecv,FG_COMM,status,IERR)
2952 c write (iout,*) "Gather PRECOMP21"
2954 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2955 & MPI_PRECOMP22(lensend),inext,8800+isend,
2956 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2957 & iprev,8800+irecv,FG_COMM,status,IERR)
2958 c write (iout,*) "Gather PRECOMP22"
2960 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2961 & MPI_PRECOMP23(lensend),inext,9900+isend,
2962 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2963 & MPI_PRECOMP23(lenrecv),
2964 & iprev,9900+irecv,FG_COMM,status,IERR)
2965 c write (iout,*) "Gather PRECOMP23"
2970 if (irecv.lt.0) irecv=nfgtasks1-1
2973 time_gather=time_gather+MPI_Wtime()-time00
2976 c if (fg_rank.eq.0) then
2977 write (iout,*) "Arrays UG and UGDER"
2979 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2980 & ((ug(l,k,i),l=1,2),k=1,2),
2981 & ((ugder(l,k,i),l=1,2),k=1,2)
2983 write (iout,*) "Arrays UG2 and UG2DER"
2985 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2986 & ((ug2(l,k,i),l=1,2),k=1,2),
2987 & ((ug2der(l,k,i),l=1,2),k=1,2)
2989 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2991 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2992 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2993 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2995 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2997 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2998 & costab(i),sintab(i),costab2(i),sintab2(i)
3000 write (iout,*) "Array MUDER"
3002 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3008 cd iti = itortyp(itype(i))
3011 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3012 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3017 C--------------------------------------------------------------------------
3018 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3020 C This subroutine calculates the average interaction energy and its gradient
3021 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3022 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3023 C The potential depends both on the distance of peptide-group centers and on
3024 C the orientation of the CA-CA virtual bonds.
3026 implicit real*8 (a-h,o-z)
3030 include 'DIMENSIONS'
3031 include 'COMMON.CONTROL'
3032 include 'COMMON.SETUP'
3033 include 'COMMON.IOUNITS'
3034 include 'COMMON.GEO'
3035 include 'COMMON.VAR'
3036 include 'COMMON.LOCAL'
3037 include 'COMMON.CHAIN'
3038 include 'COMMON.DERIV'
3039 include 'COMMON.INTERACT'
3040 include 'COMMON.CONTACTS'
3041 include 'COMMON.TORSION'
3042 include 'COMMON.VECTORS'
3043 include 'COMMON.FFIELD'
3044 include 'COMMON.TIME1'
3045 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3046 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3047 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3048 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3049 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3050 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3052 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3054 double precision scal_el /1.0d0/
3056 double precision scal_el /0.5d0/
3059 C 13-go grudnia roku pamietnego...
3060 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3061 & 0.0d0,1.0d0,0.0d0,
3062 & 0.0d0,0.0d0,1.0d0/
3063 cd write(iout,*) 'In EELEC'
3065 cd write(iout,*) 'Type',i
3066 cd write(iout,*) 'B1',B1(:,i)
3067 cd write(iout,*) 'B2',B2(:,i)
3068 cd write(iout,*) 'CC',CC(:,:,i)
3069 cd write(iout,*) 'DD',DD(:,:,i)
3070 cd write(iout,*) 'EE',EE(:,:,i)
3072 cd call check_vecgrad
3074 if (icheckgrad.eq.1) then
3076 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3078 dc_norm(k,i)=dc(k,i)*fac
3080 c write (iout,*) 'i',i,' fac',fac
3083 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3084 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3085 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3086 c call vec_and_deriv
3092 time_mat=time_mat+MPI_Wtime()-time01
3096 cd write (iout,*) 'i=',i
3098 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3101 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3102 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3115 cd print '(a)','Enter EELEC'
3116 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3118 gel_loc_loc(i)=0.0d0
3123 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3125 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3127 do i=iturn3_start,iturn3_end
3131 dx_normi=dc_norm(1,i)
3132 dy_normi=dc_norm(2,i)
3133 dz_normi=dc_norm(3,i)
3134 xmedi=c(1,i)+0.5d0*dxi
3135 ymedi=c(2,i)+0.5d0*dyi
3136 zmedi=c(3,i)+0.5d0*dzi
3138 call eelecij(i,i+2,ees,evdw1,eel_loc)
3139 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3140 num_cont_hb(i)=num_conti
3142 do i=iturn4_start,iturn4_end
3146 dx_normi=dc_norm(1,i)
3147 dy_normi=dc_norm(2,i)
3148 dz_normi=dc_norm(3,i)
3149 xmedi=c(1,i)+0.5d0*dxi
3150 ymedi=c(2,i)+0.5d0*dyi
3151 zmedi=c(3,i)+0.5d0*dzi
3152 num_conti=num_cont_hb(i)
3153 call eelecij(i,i+3,ees,evdw1,eel_loc)
3154 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3155 num_cont_hb(i)=num_conti
3158 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3160 do i=iatel_s,iatel_e
3164 dx_normi=dc_norm(1,i)
3165 dy_normi=dc_norm(2,i)
3166 dz_normi=dc_norm(3,i)
3167 xmedi=c(1,i)+0.5d0*dxi
3168 ymedi=c(2,i)+0.5d0*dyi
3169 zmedi=c(3,i)+0.5d0*dzi
3170 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3171 num_conti=num_cont_hb(i)
3172 do j=ielstart(i),ielend(i)
3173 call eelecij(i,j,ees,evdw1,eel_loc)
3175 num_cont_hb(i)=num_conti
3177 c write (iout,*) "Number of loop steps in EELEC:",ind
3179 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3180 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3182 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3183 ccc eel_loc=eel_loc+eello_turn3
3184 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3187 C-------------------------------------------------------------------------------
3188 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3189 implicit real*8 (a-h,o-z)
3190 include 'DIMENSIONS'
3194 include 'COMMON.CONTROL'
3195 include 'COMMON.IOUNITS'
3196 include 'COMMON.GEO'
3197 include 'COMMON.VAR'
3198 include 'COMMON.LOCAL'
3199 include 'COMMON.CHAIN'
3200 include 'COMMON.DERIV'
3201 include 'COMMON.INTERACT'
3202 include 'COMMON.CONTACTS'
3203 include 'COMMON.TORSION'
3204 include 'COMMON.VECTORS'
3205 include 'COMMON.FFIELD'
3206 include 'COMMON.TIME1'
3207 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3208 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3209 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3210 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3211 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3212 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3214 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3216 double precision scal_el /1.0d0/
3218 double precision scal_el /0.5d0/
3221 C 13-go grudnia roku pamietnego...
3222 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3223 & 0.0d0,1.0d0,0.0d0,
3224 & 0.0d0,0.0d0,1.0d0/
3225 c time00=MPI_Wtime()
3226 cd write (iout,*) "eelecij",i,j
3230 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3231 aaa=app(iteli,itelj)
3232 bbb=bpp(iteli,itelj)
3233 ael6i=ael6(iteli,itelj)
3234 ael3i=ael3(iteli,itelj)
3238 dx_normj=dc_norm(1,j)
3239 dy_normj=dc_norm(2,j)
3240 dz_normj=dc_norm(3,j)
3241 xj=c(1,j)+0.5D0*dxj-xmedi
3242 yj=c(2,j)+0.5D0*dyj-ymedi
3243 zj=c(3,j)+0.5D0*dzj-zmedi
3244 rij=xj*xj+yj*yj+zj*zj
3250 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3251 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3252 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3253 fac=cosa-3.0D0*cosb*cosg
3255 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3256 if (j.eq.i+2) ev1=scal_el*ev1
3261 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3264 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3265 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3268 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3269 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3270 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3271 cd & xmedi,ymedi,zmedi,xj,yj,zj
3273 if (energy_dec) then
3274 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3275 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3279 C Calculate contributions to the Cartesian gradient.
3282 facvdw=-6*rrmij*(ev1+evdwij)
3283 facel=-3*rrmij*(el1+eesij)
3289 * Radial derivatives. First process both termini of the fragment (i,j)
3295 c ghalf=0.5D0*ggg(k)
3296 c gelc(k,i)=gelc(k,i)+ghalf
3297 c gelc(k,j)=gelc(k,j)+ghalf
3299 c 9/28/08 AL Gradient compotents will be summed only at the end
3301 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3302 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3305 * Loop over residues i+1 thru j-1.
3309 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3316 c ghalf=0.5D0*ggg(k)
3317 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3318 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3320 c 9/28/08 AL Gradient compotents will be summed only at the end
3322 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3323 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3326 * Loop over residues i+1 thru j-1.
3330 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3337 fac=-3*rrmij*(facvdw+facvdw+facel)
3342 * Radial derivatives. First process both termini of the fragment (i,j)
3348 c ghalf=0.5D0*ggg(k)
3349 c gelc(k,i)=gelc(k,i)+ghalf
3350 c gelc(k,j)=gelc(k,j)+ghalf
3352 c 9/28/08 AL Gradient compotents will be summed only at the end
3354 gelc_long(k,j)=gelc(k,j)+ggg(k)
3355 gelc_long(k,i)=gelc(k,i)-ggg(k)
3358 * Loop over residues i+1 thru j-1.
3362 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3365 c 9/28/08 AL Gradient compotents will be summed only at the end
3370 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3371 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3377 ecosa=2.0D0*fac3*fac1+fac4
3380 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3381 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3383 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3384 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3386 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3387 cd & (dcosg(k),k=1,3)
3389 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3392 c ghalf=0.5D0*ggg(k)
3393 c gelc(k,i)=gelc(k,i)+ghalf
3394 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3395 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3396 c gelc(k,j)=gelc(k,j)+ghalf
3397 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3398 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3402 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3407 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3408 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3410 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3411 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3412 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3413 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3415 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3416 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3417 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3419 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3420 C energy of a peptide unit is assumed in the form of a second-order
3421 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3422 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3423 C are computed for EVERY pair of non-contiguous peptide groups.
3425 if (j.lt.nres-1) then
3436 muij(kkk)=mu(k,i)*mu(l,j)
3439 cd write (iout,*) 'EELEC: i',i,' j',j
3440 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3441 cd write(iout,*) 'muij',muij
3442 ury=scalar(uy(1,i),erij)
3443 urz=scalar(uz(1,i),erij)
3444 vry=scalar(uy(1,j),erij)
3445 vrz=scalar(uz(1,j),erij)
3446 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3447 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3448 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3449 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3450 fac=dsqrt(-ael6i)*r3ij
3455 cd write (iout,'(4i5,4f10.5)')
3456 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3457 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3458 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3459 cd & uy(:,j),uz(:,j)
3460 cd write (iout,'(4f10.5)')
3461 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3462 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3463 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3464 cd write (iout,'(9f10.5/)')
3465 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3466 C Derivatives of the elements of A in virtual-bond vectors
3467 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3469 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3470 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3471 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3472 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3473 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3474 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3475 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3476 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3477 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3478 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3479 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3480 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3482 C Compute radial contributions to the gradient
3500 C Add the contributions coming from er
3503 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3504 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3505 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3506 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3509 C Derivatives in DC(i)
3510 cgrad ghalf1=0.5d0*agg(k,1)
3511 cgrad ghalf2=0.5d0*agg(k,2)
3512 cgrad ghalf3=0.5d0*agg(k,3)
3513 cgrad ghalf4=0.5d0*agg(k,4)
3514 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3515 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3516 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3517 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3518 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3519 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3520 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3521 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3522 C Derivatives in DC(i+1)
3523 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3524 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3525 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3526 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3527 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3528 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3529 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3530 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3531 C Derivatives in DC(j)
3532 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3533 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3534 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3535 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3536 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3537 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3538 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3539 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3540 C Derivatives in DC(j+1) or DC(nres-1)
3541 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3542 & -3.0d0*vryg(k,3)*ury)
3543 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3544 & -3.0d0*vrzg(k,3)*ury)
3545 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3546 & -3.0d0*vryg(k,3)*urz)
3547 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3548 & -3.0d0*vrzg(k,3)*urz)
3549 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3551 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3564 aggi(k,l)=-aggi(k,l)
3565 aggi1(k,l)=-aggi1(k,l)
3566 aggj(k,l)=-aggj(k,l)
3567 aggj1(k,l)=-aggj1(k,l)
3570 if (j.lt.nres-1) then
3576 aggi(k,l)=-aggi(k,l)
3577 aggi1(k,l)=-aggi1(k,l)
3578 aggj(k,l)=-aggj(k,l)
3579 aggj1(k,l)=-aggj1(k,l)
3590 aggi(k,l)=-aggi(k,l)
3591 aggi1(k,l)=-aggi1(k,l)
3592 aggj(k,l)=-aggj(k,l)
3593 aggj1(k,l)=-aggj1(k,l)
3598 IF (wel_loc.gt.0.0d0) THEN
3599 C Contribution to the local-electrostatic energy coming from the i-j pair
3600 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3602 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3604 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3605 & 'eelloc',i,j,eel_loc_ij
3607 eel_loc=eel_loc+eel_loc_ij
3608 C Partial derivatives in virtual-bond dihedral angles gamma
3610 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3611 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3612 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3613 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3614 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3615 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3616 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3618 ggg(l)=agg(l,1)*muij(1)+
3619 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3620 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3621 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3622 cgrad ghalf=0.5d0*ggg(l)
3623 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3624 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3628 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3631 C Remaining derivatives of eello
3633 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3634 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3635 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3636 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3637 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3638 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3639 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3640 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3643 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3644 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3645 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3646 & .and. num_conti.le.maxconts) then
3647 c write (iout,*) i,j," entered corr"
3649 C Calculate the contact function. The ith column of the array JCONT will
3650 C contain the numbers of atoms that make contacts with the atom I (of numbers
3651 C greater than I). The arrays FACONT and GACONT will contain the values of
3652 C the contact function and its derivative.
3653 c r0ij=1.02D0*rpp(iteli,itelj)
3654 c r0ij=1.11D0*rpp(iteli,itelj)
3655 r0ij=2.20D0*rpp(iteli,itelj)
3656 c r0ij=1.55D0*rpp(iteli,itelj)
3657 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3658 if (fcont.gt.0.0D0) then
3659 num_conti=num_conti+1
3660 if (num_conti.gt.maxconts) then
3661 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3662 & ' will skip next contacts for this conf.'
3664 jcont_hb(num_conti,i)=j
3665 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3666 cd & " jcont_hb",jcont_hb(num_conti,i)
3667 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3668 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3669 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3671 d_cont(num_conti,i)=rij
3672 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3673 C --- Electrostatic-interaction matrix ---
3674 a_chuj(1,1,num_conti,i)=a22
3675 a_chuj(1,2,num_conti,i)=a23
3676 a_chuj(2,1,num_conti,i)=a32
3677 a_chuj(2,2,num_conti,i)=a33
3678 C --- Gradient of rij
3680 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3687 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3688 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3689 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3690 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3691 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3696 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3697 C Calculate contact energies
3699 wij=cosa-3.0D0*cosb*cosg
3702 c fac3=dsqrt(-ael6i)/r0ij**3
3703 fac3=dsqrt(-ael6i)*r3ij
3704 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3705 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3706 if (ees0tmp.gt.0) then
3707 ees0pij=dsqrt(ees0tmp)
3711 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3712 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3713 if (ees0tmp.gt.0) then
3714 ees0mij=dsqrt(ees0tmp)
3719 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3720 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3721 C Diagnostics. Comment out or remove after debugging!
3722 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3723 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3724 c ees0m(num_conti,i)=0.0D0
3726 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3727 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3728 C Angular derivatives of the contact function
3729 ees0pij1=fac3/ees0pij
3730 ees0mij1=fac3/ees0mij
3731 fac3p=-3.0D0*fac3*rrmij
3732 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3733 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3735 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3736 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3737 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3738 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3739 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3740 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3741 ecosap=ecosa1+ecosa2
3742 ecosbp=ecosb1+ecosb2
3743 ecosgp=ecosg1+ecosg2
3744 ecosam=ecosa1-ecosa2
3745 ecosbm=ecosb1-ecosb2
3746 ecosgm=ecosg1-ecosg2
3755 facont_hb(num_conti,i)=fcont
3756 fprimcont=fprimcont/rij
3757 cd facont_hb(num_conti,i)=1.0D0
3758 C Following line is for diagnostics.
3761 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3762 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3765 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3766 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3768 gggp(1)=gggp(1)+ees0pijp*xj
3769 gggp(2)=gggp(2)+ees0pijp*yj
3770 gggp(3)=gggp(3)+ees0pijp*zj
3771 gggm(1)=gggm(1)+ees0mijp*xj
3772 gggm(2)=gggm(2)+ees0mijp*yj
3773 gggm(3)=gggm(3)+ees0mijp*zj
3774 C Derivatives due to the contact function
3775 gacont_hbr(1,num_conti,i)=fprimcont*xj
3776 gacont_hbr(2,num_conti,i)=fprimcont*yj
3777 gacont_hbr(3,num_conti,i)=fprimcont*zj
3780 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3781 c following the change of gradient-summation algorithm.
3783 cgrad ghalfp=0.5D0*gggp(k)
3784 cgrad ghalfm=0.5D0*gggm(k)
3785 gacontp_hb1(k,num_conti,i)=!ghalfp
3786 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3787 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3788 gacontp_hb2(k,num_conti,i)=!ghalfp
3789 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3790 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3791 gacontp_hb3(k,num_conti,i)=gggp(k)
3792 gacontm_hb1(k,num_conti,i)=!ghalfm
3793 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3794 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3795 gacontm_hb2(k,num_conti,i)=!ghalfm
3796 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3797 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3798 gacontm_hb3(k,num_conti,i)=gggm(k)
3800 C Diagnostics. Comment out or remove after debugging!
3802 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3803 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3804 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3805 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3806 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3807 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3810 endif ! num_conti.le.maxconts
3813 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3816 ghalf=0.5d0*agg(l,k)
3817 aggi(l,k)=aggi(l,k)+ghalf
3818 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3819 aggj(l,k)=aggj(l,k)+ghalf
3822 if (j.eq.nres-1 .and. i.lt.j-2) then
3825 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3830 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3833 C-----------------------------------------------------------------------------
3834 subroutine eturn3(i,eello_turn3)
3835 C Third- and fourth-order contributions from turns
3836 implicit real*8 (a-h,o-z)
3837 include 'DIMENSIONS'
3838 include 'COMMON.IOUNITS'
3839 include 'COMMON.GEO'
3840 include 'COMMON.VAR'
3841 include 'COMMON.LOCAL'
3842 include 'COMMON.CHAIN'
3843 include 'COMMON.DERIV'
3844 include 'COMMON.INTERACT'
3845 include 'COMMON.CONTACTS'
3846 include 'COMMON.TORSION'
3847 include 'COMMON.VECTORS'
3848 include 'COMMON.FFIELD'
3849 include 'COMMON.CONTROL'
3851 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3852 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3853 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3854 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3855 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3856 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3857 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3860 c write (iout,*) "eturn3",i,j,j1,j2
3865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3867 C Third-order contributions
3874 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3875 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3876 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3877 call transpose2(auxmat(1,1),auxmat1(1,1))
3878 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3879 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3880 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3881 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3882 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3883 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3884 cd & ' eello_turn3_num',4*eello_turn3_num
3885 C Derivatives in gamma(i)
3886 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3887 call transpose2(auxmat2(1,1),auxmat3(1,1))
3888 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3889 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3890 C Derivatives in gamma(i+1)
3891 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3892 call transpose2(auxmat2(1,1),auxmat3(1,1))
3893 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3894 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3895 & +0.5d0*(pizda(1,1)+pizda(2,2))
3896 C Cartesian derivatives
3898 c ghalf1=0.5d0*agg(l,1)
3899 c ghalf2=0.5d0*agg(l,2)
3900 c ghalf3=0.5d0*agg(l,3)
3901 c ghalf4=0.5d0*agg(l,4)
3902 a_temp(1,1)=aggi(l,1)!+ghalf1
3903 a_temp(1,2)=aggi(l,2)!+ghalf2
3904 a_temp(2,1)=aggi(l,3)!+ghalf3
3905 a_temp(2,2)=aggi(l,4)!+ghalf4
3906 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3907 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3908 & +0.5d0*(pizda(1,1)+pizda(2,2))
3909 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3910 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3911 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3912 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3913 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3914 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3915 & +0.5d0*(pizda(1,1)+pizda(2,2))
3916 a_temp(1,1)=aggj(l,1)!+ghalf1
3917 a_temp(1,2)=aggj(l,2)!+ghalf2
3918 a_temp(2,1)=aggj(l,3)!+ghalf3
3919 a_temp(2,2)=aggj(l,4)!+ghalf4
3920 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3921 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3922 & +0.5d0*(pizda(1,1)+pizda(2,2))
3923 a_temp(1,1)=aggj1(l,1)
3924 a_temp(1,2)=aggj1(l,2)
3925 a_temp(2,1)=aggj1(l,3)
3926 a_temp(2,2)=aggj1(l,4)
3927 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3928 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3929 & +0.5d0*(pizda(1,1)+pizda(2,2))
3933 C-------------------------------------------------------------------------------
3934 subroutine eturn4(i,eello_turn4)
3935 C Third- and fourth-order contributions from turns
3936 implicit real*8 (a-h,o-z)
3937 include 'DIMENSIONS'
3938 include 'COMMON.IOUNITS'
3939 include 'COMMON.GEO'
3940 include 'COMMON.VAR'
3941 include 'COMMON.LOCAL'
3942 include 'COMMON.CHAIN'
3943 include 'COMMON.DERIV'
3944 include 'COMMON.INTERACT'
3945 include 'COMMON.CONTACTS'
3946 include 'COMMON.TORSION'
3947 include 'COMMON.VECTORS'
3948 include 'COMMON.FFIELD'
3949 include 'COMMON.CONTROL'
3951 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3952 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3953 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3954 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3955 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3956 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3957 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3960 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3962 C Fourth-order contributions
3970 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3971 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3972 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3977 iti1=itortyp(itype(i+1))
3978 iti2=itortyp(itype(i+2))
3979 iti3=itortyp(itype(i+3))
3980 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3981 call transpose2(EUg(1,1,i+1),e1t(1,1))
3982 call transpose2(Eug(1,1,i+2),e2t(1,1))
3983 call transpose2(Eug(1,1,i+3),e3t(1,1))
3984 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3985 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3986 s1=scalar2(b1(1,iti2),auxvec(1))
3987 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3988 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3989 s2=scalar2(b1(1,iti1),auxvec(1))
3990 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3991 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3992 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3993 eello_turn4=eello_turn4-(s1+s2+s3)
3994 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3995 & 'eturn4',i,j,-(s1+s2+s3)
3996 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3997 cd & ' eello_turn4_num',8*eello_turn4_num
3998 C Derivatives in gamma(i)
3999 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4000 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4001 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4002 s1=scalar2(b1(1,iti2),auxvec(1))
4003 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4004 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4005 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4006 C Derivatives in gamma(i+1)
4007 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4008 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4009 s2=scalar2(b1(1,iti1),auxvec(1))
4010 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4011 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4012 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4013 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4014 C Derivatives in gamma(i+2)
4015 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4016 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4017 s1=scalar2(b1(1,iti2),auxvec(1))
4018 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4019 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4020 s2=scalar2(b1(1,iti1),auxvec(1))
4021 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4022 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4023 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4024 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4025 C Cartesian derivatives
4026 C Derivatives of this turn contributions in DC(i+2)
4027 if (j.lt.nres-1) then
4029 a_temp(1,1)=agg(l,1)
4030 a_temp(1,2)=agg(l,2)
4031 a_temp(2,1)=agg(l,3)
4032 a_temp(2,2)=agg(l,4)
4033 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4034 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4035 s1=scalar2(b1(1,iti2),auxvec(1))
4036 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4037 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4038 s2=scalar2(b1(1,iti1),auxvec(1))
4039 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4040 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4041 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4043 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4046 C Remaining derivatives of this turn contribution
4048 a_temp(1,1)=aggi(l,1)
4049 a_temp(1,2)=aggi(l,2)
4050 a_temp(2,1)=aggi(l,3)
4051 a_temp(2,2)=aggi(l,4)
4052 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4053 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4054 s1=scalar2(b1(1,iti2),auxvec(1))
4055 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4056 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4057 s2=scalar2(b1(1,iti1),auxvec(1))
4058 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4059 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4060 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4061 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4062 a_temp(1,1)=aggi1(l,1)
4063 a_temp(1,2)=aggi1(l,2)
4064 a_temp(2,1)=aggi1(l,3)
4065 a_temp(2,2)=aggi1(l,4)
4066 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4067 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4068 s1=scalar2(b1(1,iti2),auxvec(1))
4069 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4070 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4071 s2=scalar2(b1(1,iti1),auxvec(1))
4072 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4073 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4074 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4075 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4076 a_temp(1,1)=aggj(l,1)
4077 a_temp(1,2)=aggj(l,2)
4078 a_temp(2,1)=aggj(l,3)
4079 a_temp(2,2)=aggj(l,4)
4080 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4081 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4082 s1=scalar2(b1(1,iti2),auxvec(1))
4083 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4084 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4085 s2=scalar2(b1(1,iti1),auxvec(1))
4086 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4087 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4088 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4089 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4090 a_temp(1,1)=aggj1(l,1)
4091 a_temp(1,2)=aggj1(l,2)
4092 a_temp(2,1)=aggj1(l,3)
4093 a_temp(2,2)=aggj1(l,4)
4094 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4095 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4096 s1=scalar2(b1(1,iti2),auxvec(1))
4097 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4098 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4099 s2=scalar2(b1(1,iti1),auxvec(1))
4100 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4101 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4102 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4103 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4104 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4108 C-----------------------------------------------------------------------------
4109 subroutine vecpr(u,v,w)
4110 implicit real*8(a-h,o-z)
4111 dimension u(3),v(3),w(3)
4112 w(1)=u(2)*v(3)-u(3)*v(2)
4113 w(2)=-u(1)*v(3)+u(3)*v(1)
4114 w(3)=u(1)*v(2)-u(2)*v(1)
4117 C-----------------------------------------------------------------------------
4118 subroutine unormderiv(u,ugrad,unorm,ungrad)
4119 C This subroutine computes the derivatives of a normalized vector u, given
4120 C the derivatives computed without normalization conditions, ugrad. Returns
4123 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4124 double precision vec(3)
4125 double precision scalar
4127 c write (2,*) 'ugrad',ugrad
4130 vec(i)=scalar(ugrad(1,i),u(1))
4132 c write (2,*) 'vec',vec
4135 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4138 c write (2,*) 'ungrad',ungrad
4141 C-----------------------------------------------------------------------------
4142 subroutine escp_soft_sphere(evdw2,evdw2_14)
4144 C This subroutine calculates the excluded-volume interaction energy between
4145 C peptide-group centers and side chains and its gradient in virtual-bond and
4146 C side-chain vectors.
4148 implicit real*8 (a-h,o-z)
4149 include 'DIMENSIONS'
4150 include 'COMMON.GEO'
4151 include 'COMMON.VAR'
4152 include 'COMMON.LOCAL'
4153 include 'COMMON.CHAIN'
4154 include 'COMMON.DERIV'
4155 include 'COMMON.INTERACT'
4156 include 'COMMON.FFIELD'
4157 include 'COMMON.IOUNITS'
4158 include 'COMMON.CONTROL'
4163 cd print '(a)','Enter ESCP'
4164 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4165 do i=iatscp_s,iatscp_e
4167 xi=0.5D0*(c(1,i)+c(1,i+1))
4168 yi=0.5D0*(c(2,i)+c(2,i+1))
4169 zi=0.5D0*(c(3,i)+c(3,i+1))
4171 do iint=1,nscp_gr(i)
4173 do j=iscpstart(i,iint),iscpend(i,iint)
4175 C Uncomment following three lines for SC-p interactions
4179 C Uncomment following three lines for Ca-p interactions
4183 rij=xj*xj+yj*yj+zj*zj
4186 if (rij.lt.r0ijsq) then
4187 evdwij=0.25d0*(rij-r0ijsq)**2
4195 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4200 cgrad if (j.lt.i) then
4201 cd write (iout,*) 'j<i'
4202 C Uncomment following three lines for SC-p interactions
4204 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4207 cd write (iout,*) 'j>i'
4209 cgrad ggg(k)=-ggg(k)
4210 C Uncomment following line for SC-p interactions
4211 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4215 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4217 cgrad kstart=min0(i+1,j)
4218 cgrad kend=max0(i-1,j-1)
4219 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4220 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4221 cgrad do k=kstart,kend
4223 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4227 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4228 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4236 C-----------------------------------------------------------------------------
4237 subroutine escp(evdw2,evdw2_14)
4239 C This subroutine calculates the excluded-volume interaction energy between
4240 C peptide-group centers and side chains and its gradient in virtual-bond and
4241 C side-chain vectors.
4243 implicit real*8 (a-h,o-z)
4244 include 'DIMENSIONS'
4245 include 'COMMON.GEO'
4246 include 'COMMON.VAR'
4247 include 'COMMON.LOCAL'
4248 include 'COMMON.CHAIN'
4249 include 'COMMON.DERIV'
4250 include 'COMMON.INTERACT'
4251 include 'COMMON.FFIELD'
4252 include 'COMMON.IOUNITS'
4253 include 'COMMON.CONTROL'
4257 cd print '(a)','Enter ESCP'
4258 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4259 do i=iatscp_s,iatscp_e
4261 xi=0.5D0*(c(1,i)+c(1,i+1))
4262 yi=0.5D0*(c(2,i)+c(2,i+1))
4263 zi=0.5D0*(c(3,i)+c(3,i+1))
4265 do iint=1,nscp_gr(i)
4267 do j=iscpstart(i,iint),iscpend(i,iint)
4269 C Uncomment following three lines for SC-p interactions
4273 C Uncomment following three lines for Ca-p interactions
4277 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4279 e1=fac*fac*aad(itypj,iteli)
4280 e2=fac*bad(itypj,iteli)
4281 if (iabs(j-i) .le. 2) then
4284 evdw2_14=evdw2_14+e1+e2
4288 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4289 & 'evdw2',i,j,evdwij
4291 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4293 fac=-(evdwij+e1)*rrij
4297 cgrad if (j.lt.i) then
4298 cd write (iout,*) 'j<i'
4299 C Uncomment following three lines for SC-p interactions
4301 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4304 cd write (iout,*) 'j>i'
4306 cgrad ggg(k)=-ggg(k)
4307 C Uncomment following line for SC-p interactions
4308 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4309 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4313 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4315 cgrad kstart=min0(i+1,j)
4316 cgrad kend=max0(i-1,j-1)
4317 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4318 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4319 cgrad do k=kstart,kend
4321 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4325 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4326 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4334 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4335 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4336 gradx_scp(j,i)=expon*gradx_scp(j,i)
4339 C******************************************************************************
4343 C To save time the factor EXPON has been extracted from ALL components
4344 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4347 C******************************************************************************
4350 C--------------------------------------------------------------------------
4351 subroutine edis(ehpb)
4353 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4355 implicit real*8 (a-h,o-z)
4356 include 'DIMENSIONS'
4357 include 'COMMON.SBRIDGE'
4358 include 'COMMON.CHAIN'
4359 include 'COMMON.DERIV'
4360 include 'COMMON.VAR'
4361 include 'COMMON.INTERACT'
4362 include 'COMMON.IOUNITS'
4365 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4366 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4367 if (link_end.eq.0) return
4368 do i=link_start,link_end
4369 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4370 C CA-CA distance used in regularization of structure.
4373 C iii and jjj point to the residues for which the distance is assigned.
4374 if (ii.gt.nres) then
4381 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4382 c & dhpb(i),dhpb1(i),forcon(i)
4383 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4384 C distance and angle dependent SS bond potential.
4385 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4386 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4387 if (.not.dyn_ss .and. i.le.nss) then
4388 C 15/02/13 CC dynamic SSbond - additional check
4390 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4391 call ssbond_ene(iii,jjj,eij)
4394 cd write (iout,*) "eij",eij
4395 else if (ii.gt.nres .and. jj.gt.nres) then
4396 c Restraints from contact prediction
4398 if (dhpb1(i).gt.0.0d0) then
4399 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4400 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4401 c write (iout,*) "beta nmr",
4402 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4406 C Get the force constant corresponding to this distance.
4408 C Calculate the contribution to energy.
4409 ehpb=ehpb+waga*rdis*rdis
4410 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4412 C Evaluate gradient.
4417 ggg(j)=fac*(c(j,jj)-c(j,ii))
4420 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4421 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4424 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4425 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4428 C Calculate the distance between the two points and its difference from the
4431 if (dhpb1(i).gt.0.0d0) then
4432 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4433 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4434 c write (iout,*) "alph nmr",
4435 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4438 C Get the force constant corresponding to this distance.
4440 C Calculate the contribution to energy.
4441 ehpb=ehpb+waga*rdis*rdis
4442 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4444 C Evaluate gradient.
4448 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4449 cd & ' waga=',waga,' fac=',fac
4451 ggg(j)=fac*(c(j,jj)-c(j,ii))
4453 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4454 C If this is a SC-SC distance, we need to calculate the contributions to the
4455 C Cartesian gradient in the SC vectors (ghpbx).
4458 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4459 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4462 cgrad do j=iii,jjj-1
4464 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4468 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4469 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4476 C--------------------------------------------------------------------------
4477 subroutine ssbond_ene(i,j,eij)
4479 C Calculate the distance and angle dependent SS-bond potential energy
4480 C using a free-energy function derived based on RHF/6-31G** ab initio
4481 C calculations of diethyl disulfide.
4483 C A. Liwo and U. Kozlowska, 11/24/03
4485 implicit real*8 (a-h,o-z)
4486 include 'DIMENSIONS'
4487 include 'COMMON.SBRIDGE'
4488 include 'COMMON.CHAIN'
4489 include 'COMMON.DERIV'
4490 include 'COMMON.LOCAL'
4491 include 'COMMON.INTERACT'
4492 include 'COMMON.VAR'
4493 include 'COMMON.IOUNITS'
4494 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4499 dxi=dc_norm(1,nres+i)
4500 dyi=dc_norm(2,nres+i)
4501 dzi=dc_norm(3,nres+i)
4502 c dsci_inv=dsc_inv(itypi)
4503 dsci_inv=vbld_inv(nres+i)
4505 c dscj_inv=dsc_inv(itypj)
4506 dscj_inv=vbld_inv(nres+j)
4510 dxj=dc_norm(1,nres+j)
4511 dyj=dc_norm(2,nres+j)
4512 dzj=dc_norm(3,nres+j)
4513 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4518 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4519 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4520 om12=dxi*dxj+dyi*dyj+dzi*dzj
4522 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4523 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4529 deltat12=om2-om1+2.0d0
4531 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4532 & +akct*deltad*deltat12+ebr
4533 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4534 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4535 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4536 c & " deltat12",deltat12," eij",eij
4537 ed=2*akcm*deltad+akct*deltat12
4539 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4540 eom1=-2*akth*deltat1-pom1-om2*pom2
4541 eom2= 2*akth*deltat2+pom1-om1*pom2
4544 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4545 ghpbx(k,i)=ghpbx(k,i)-ggk
4546 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4547 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4548 ghpbx(k,j)=ghpbx(k,j)+ggk
4549 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4550 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4551 ghpbc(k,i)=ghpbc(k,i)-ggk
4552 ghpbc(k,j)=ghpbc(k,j)+ggk
4555 C Calculate the components of the gradient in DC and X
4559 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4564 C--------------------------------------------------------------------------
4565 subroutine ebond(estr)
4567 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4569 implicit real*8 (a-h,o-z)
4570 include 'DIMENSIONS'
4571 include 'COMMON.LOCAL'
4572 include 'COMMON.GEO'
4573 include 'COMMON.INTERACT'
4574 include 'COMMON.DERIV'
4575 include 'COMMON.VAR'
4576 include 'COMMON.CHAIN'
4577 include 'COMMON.IOUNITS'
4578 include 'COMMON.NAMES'
4579 include 'COMMON.FFIELD'
4580 include 'COMMON.CONTROL'
4581 include 'COMMON.SETUP'
4582 double precision u(3),ud(3)
4584 do i=ibondp_start,ibondp_end
4585 diff = vbld(i)-vbldp0
4586 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4587 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4588 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4591 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4593 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4597 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4599 do i=ibond_start,ibond_end
4604 diff=vbld(i+nres)-vbldsc0(1,iti)
4605 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4606 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4607 if (energy_dec) write (iout,*)
4608 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4609 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4610 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4612 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4616 diff=vbld(i+nres)-vbldsc0(j,iti)
4617 ud(j)=aksc(j,iti)*diff
4618 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4632 uprod2=uprod2*u(k)*u(k)
4636 usumsqder=usumsqder+ud(j)*uprod2
4638 estr=estr+uprod/usum
4640 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4648 C--------------------------------------------------------------------------
4649 subroutine ebend(etheta)
4651 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4652 C angles gamma and its derivatives in consecutive thetas and gammas.
4654 implicit real*8 (a-h,o-z)
4655 include 'DIMENSIONS'
4656 include 'COMMON.LOCAL'
4657 include 'COMMON.GEO'
4658 include 'COMMON.INTERACT'
4659 include 'COMMON.DERIV'
4660 include 'COMMON.VAR'
4661 include 'COMMON.CHAIN'
4662 include 'COMMON.IOUNITS'
4663 include 'COMMON.NAMES'
4664 include 'COMMON.FFIELD'
4665 include 'COMMON.CONTROL'
4666 common /calcthet/ term1,term2,termm,diffak,ratak,
4667 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4668 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4669 double precision y(2),z(2)
4671 c time11=dexp(-2*time)
4674 c write (*,'(a,i2)') 'EBEND ICG=',icg
4675 do i=ithet_start,ithet_end
4676 C Zero the energy function and its derivative at 0 or pi.
4677 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4682 if (phii.ne.phii) phii=150.0
4695 if (phii1.ne.phii1) phii1=150.0
4707 C Calculate the "mean" value of theta from the part of the distribution
4708 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4709 C In following comments this theta will be referred to as t_c.
4710 thet_pred_mean=0.0d0
4714 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4716 dthett=thet_pred_mean*ssd
4717 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4718 C Derivatives of the "mean" values in gamma1 and gamma2.
4719 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4720 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4721 if (theta(i).gt.pi-delta) then
4722 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4724 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4725 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4726 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4728 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4730 else if (theta(i).lt.delta) then
4731 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4732 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4733 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4735 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4736 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4739 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4742 etheta=etheta+ethetai
4743 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4745 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4746 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4747 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4749 C Ufff.... We've done all this!!!
4752 C---------------------------------------------------------------------------
4753 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4755 implicit real*8 (a-h,o-z)
4756 include 'DIMENSIONS'
4757 include 'COMMON.LOCAL'
4758 include 'COMMON.IOUNITS'
4759 common /calcthet/ term1,term2,termm,diffak,ratak,
4760 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4761 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4762 C Calculate the contributions to both Gaussian lobes.
4763 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4764 C The "polynomial part" of the "standard deviation" of this part of
4768 sig=sig*thet_pred_mean+polthet(j,it)
4770 C Derivative of the "interior part" of the "standard deviation of the"
4771 C gamma-dependent Gaussian lobe in t_c.
4772 sigtc=3*polthet(3,it)
4774 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4777 C Set the parameters of both Gaussian lobes of the distribution.
4778 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4779 fac=sig*sig+sigc0(it)
4782 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4783 sigsqtc=-4.0D0*sigcsq*sigtc
4784 c print *,i,sig,sigtc,sigsqtc
4785 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4786 sigtc=-sigtc/(fac*fac)
4787 C Following variable is sigma(t_c)**(-2)
4788 sigcsq=sigcsq*sigcsq
4790 sig0inv=1.0D0/sig0i**2
4791 delthec=thetai-thet_pred_mean
4792 delthe0=thetai-theta0i
4793 term1=-0.5D0*sigcsq*delthec*delthec
4794 term2=-0.5D0*sig0inv*delthe0*delthe0
4795 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4796 C NaNs in taking the logarithm. We extract the largest exponent which is added
4797 C to the energy (this being the log of the distribution) at the end of energy
4798 C term evaluation for this virtual-bond angle.
4799 if (term1.gt.term2) then
4801 term2=dexp(term2-termm)
4805 term1=dexp(term1-termm)
4808 C The ratio between the gamma-independent and gamma-dependent lobes of
4809 C the distribution is a Gaussian function of thet_pred_mean too.
4810 diffak=gthet(2,it)-thet_pred_mean
4811 ratak=diffak/gthet(3,it)**2
4812 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4813 C Let's differentiate it in thet_pred_mean NOW.
4815 C Now put together the distribution terms to make complete distribution.
4816 termexp=term1+ak*term2
4817 termpre=sigc+ak*sig0i
4818 C Contribution of the bending energy from this theta is just the -log of
4819 C the sum of the contributions from the two lobes and the pre-exponential
4820 C factor. Simple enough, isn't it?
4821 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4822 C NOW the derivatives!!!
4823 C 6/6/97 Take into account the deformation.
4824 E_theta=(delthec*sigcsq*term1
4825 & +ak*delthe0*sig0inv*term2)/termexp
4826 E_tc=((sigtc+aktc*sig0i)/termpre
4827 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4828 & aktc*term2)/termexp)
4831 c-----------------------------------------------------------------------------
4832 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4833 implicit real*8 (a-h,o-z)
4834 include 'DIMENSIONS'
4835 include 'COMMON.LOCAL'
4836 include 'COMMON.IOUNITS'
4837 common /calcthet/ term1,term2,termm,diffak,ratak,
4838 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4839 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4840 delthec=thetai-thet_pred_mean
4841 delthe0=thetai-theta0i
4842 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4843 t3 = thetai-thet_pred_mean
4847 t14 = t12+t6*sigsqtc
4849 t21 = thetai-theta0i
4855 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4856 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4857 & *(-t12*t9-ak*sig0inv*t27)
4861 C--------------------------------------------------------------------------
4862 subroutine ebend(etheta)
4864 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4865 C angles gamma and its derivatives in consecutive thetas and gammas.
4866 C ab initio-derived potentials from
4867 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4869 implicit real*8 (a-h,o-z)
4870 include 'DIMENSIONS'
4871 include 'COMMON.LOCAL'
4872 include 'COMMON.GEO'
4873 include 'COMMON.INTERACT'
4874 include 'COMMON.DERIV'
4875 include 'COMMON.VAR'
4876 include 'COMMON.CHAIN'
4877 include 'COMMON.IOUNITS'
4878 include 'COMMON.NAMES'
4879 include 'COMMON.FFIELD'
4880 include 'COMMON.CONTROL'
4881 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4882 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4883 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4884 & sinph1ph2(maxdouble,maxdouble)
4885 logical lprn /.false./, lprn1 /.false./
4887 c write (iout,*) "EBEND ithet_start",ithet_start,
4888 c & " ithet_end",ithet_end
4889 do i=ithet_start,ithet_end
4890 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4891 &(itype(i).eq.ntyp1)) cycle
4895 theti2=0.5d0*theta(i)
4896 ityp2=ithetyp(itype(i-1))
4898 coskt(k)=dcos(k*theti2)
4899 sinkt(k)=dsin(k*theti2)
4902 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4905 if (phii.ne.phii) phii=150.0
4909 ityp1=ithetyp(itype(i-2))
4911 cosph1(k)=dcos(k*phii)
4912 sinph1(k)=dsin(k*phii)
4916 ityp1=ithetyp(itype(i-2))
4922 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4925 if (phii1.ne.phii1) phii1=150.0
4930 ityp3=ithetyp(itype(i))
4932 cosph2(k)=dcos(k*phii1)
4933 sinph2(k)=dsin(k*phii1)
4937 ityp3=ithetyp(itype(i))
4943 ethetai=aa0thet(ityp1,ityp2,ityp3)
4946 ccl=cosph1(l)*cosph2(k-l)
4947 ssl=sinph1(l)*sinph2(k-l)
4948 scl=sinph1(l)*cosph2(k-l)
4949 csl=cosph1(l)*sinph2(k-l)
4950 cosph1ph2(l,k)=ccl-ssl
4951 cosph1ph2(k,l)=ccl+ssl
4952 sinph1ph2(l,k)=scl+csl
4953 sinph1ph2(k,l)=scl-csl
4957 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4958 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4959 write (iout,*) "coskt and sinkt"
4961 write (iout,*) k,coskt(k),sinkt(k)
4965 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4966 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4969 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4970 & " ethetai",ethetai
4973 write (iout,*) "cosph and sinph"
4975 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4977 write (iout,*) "cosph1ph2 and sinph2ph2"
4980 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4981 & sinph1ph2(l,k),sinph1ph2(k,l)
4984 write(iout,*) "ethetai",ethetai
4988 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4989 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4990 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4991 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4992 ethetai=ethetai+sinkt(m)*aux
4993 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4994 dephii=dephii+k*sinkt(m)*(
4995 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4996 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4997 dephii1=dephii1+k*sinkt(m)*(
4998 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4999 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5001 & write (iout,*) "m",m," k",k," bbthet",
5002 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5003 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5004 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5005 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5009 & write(iout,*) "ethetai",ethetai
5013 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5014 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5015 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5016 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5017 ethetai=ethetai+sinkt(m)*aux
5018 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5019 dephii=dephii+l*sinkt(m)*(
5020 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5021 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5022 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5023 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5024 dephii1=dephii1+(k-l)*sinkt(m)*(
5025 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5026 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5027 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5028 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5030 write (iout,*) "m",m," k",k," l",l," ffthet",
5031 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5032 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5033 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5034 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5035 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5036 & cosph1ph2(k,l)*sinkt(m),
5037 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5044 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5045 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5046 & phii1*rad2deg,ethetai
5048 etheta=etheta+ethetai
5049 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5051 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5052 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5053 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5059 c-----------------------------------------------------------------------------
5060 subroutine esc(escloc)
5061 C Calculate the local energy of a side chain and its derivatives in the
5062 C corresponding virtual-bond valence angles THETA and the spherical angles
5064 implicit real*8 (a-h,o-z)
5065 include 'DIMENSIONS'
5066 include 'COMMON.GEO'
5067 include 'COMMON.LOCAL'
5068 include 'COMMON.VAR'
5069 include 'COMMON.INTERACT'
5070 include 'COMMON.DERIV'
5071 include 'COMMON.CHAIN'
5072 include 'COMMON.IOUNITS'
5073 include 'COMMON.NAMES'
5074 include 'COMMON.FFIELD'
5075 include 'COMMON.CONTROL'
5076 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5077 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5078 common /sccalc/ time11,time12,time112,theti,it,nlobit
5081 c write (iout,'(a)') 'ESC'
5082 do i=loc_start,loc_end
5084 if (it.eq.10) goto 1
5086 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5087 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5088 theti=theta(i+1)-pipol
5093 if (x(2).gt.pi-delta) then
5097 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5099 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5100 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5102 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5103 & ddersc0(1),dersc(1))
5104 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5105 & ddersc0(3),dersc(3))
5107 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5109 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5110 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5111 & dersc0(2),esclocbi,dersc02)
5112 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5114 call splinthet(x(2),0.5d0*delta,ss,ssd)
5119 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5121 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5122 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5124 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5126 c write (iout,*) escloci
5127 else if (x(2).lt.delta) then
5131 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5133 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5134 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5136 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5137 & ddersc0(1),dersc(1))
5138 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5139 & ddersc0(3),dersc(3))
5141 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5143 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5144 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5145 & dersc0(2),esclocbi,dersc02)
5146 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5151 call splinthet(x(2),0.5d0*delta,ss,ssd)
5153 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5155 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5156 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5158 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5159 c write (iout,*) escloci
5161 call enesc(x,escloci,dersc,ddummy,.false.)
5164 escloc=escloc+escloci
5165 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5166 & 'escloc',i,escloci
5167 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5169 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5171 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5172 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5177 C---------------------------------------------------------------------------
5178 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5179 implicit real*8 (a-h,o-z)
5180 include 'DIMENSIONS'
5181 include 'COMMON.GEO'
5182 include 'COMMON.LOCAL'
5183 include 'COMMON.IOUNITS'
5184 common /sccalc/ time11,time12,time112,theti,it,nlobit
5185 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5186 double precision contr(maxlob,-1:1)
5188 c write (iout,*) 'it=',it,' nlobit=',nlobit
5192 if (mixed) ddersc(j)=0.0d0
5196 C Because of periodicity of the dependence of the SC energy in omega we have
5197 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5198 C To avoid underflows, first compute & store the exponents.
5206 z(k)=x(k)-censc(k,j,it)
5211 Axk=Axk+gaussc(l,k,j,it)*z(l)
5217 expfac=expfac+Ax(k,j,iii)*z(k)
5225 C As in the case of ebend, we want to avoid underflows in exponentiation and
5226 C subsequent NaNs and INFs in energy calculation.
5227 C Find the largest exponent
5231 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5235 cd print *,'it=',it,' emin=',emin
5237 C Compute the contribution to SC energy and derivatives
5242 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5243 if(adexp.ne.adexp) adexp=1.0
5246 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5248 cd print *,'j=',j,' expfac=',expfac
5249 escloc_i=escloc_i+expfac
5251 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5255 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5256 & +gaussc(k,2,j,it))*expfac
5263 dersc(1)=dersc(1)/cos(theti)**2
5264 ddersc(1)=ddersc(1)/cos(theti)**2
5267 escloci=-(dlog(escloc_i)-emin)
5269 dersc(j)=dersc(j)/escloc_i
5273 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5278 C------------------------------------------------------------------------------
5279 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5280 implicit real*8 (a-h,o-z)
5281 include 'DIMENSIONS'
5282 include 'COMMON.GEO'
5283 include 'COMMON.LOCAL'
5284 include 'COMMON.IOUNITS'
5285 common /sccalc/ time11,time12,time112,theti,it,nlobit
5286 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5287 double precision contr(maxlob)
5298 z(k)=x(k)-censc(k,j,it)
5304 Axk=Axk+gaussc(l,k,j,it)*z(l)
5310 expfac=expfac+Ax(k,j)*z(k)
5315 C As in the case of ebend, we want to avoid underflows in exponentiation and
5316 C subsequent NaNs and INFs in energy calculation.
5317 C Find the largest exponent
5320 if (emin.gt.contr(j)) emin=contr(j)
5324 C Compute the contribution to SC energy and derivatives
5328 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5329 escloc_i=escloc_i+expfac
5331 dersc(k)=dersc(k)+Ax(k,j)*expfac
5333 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5334 & +gaussc(1,2,j,it))*expfac
5338 dersc(1)=dersc(1)/cos(theti)**2
5339 dersc12=dersc12/cos(theti)**2
5340 escloci=-(dlog(escloc_i)-emin)
5342 dersc(j)=dersc(j)/escloc_i
5344 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5348 c----------------------------------------------------------------------------------
5349 subroutine esc(escloc)
5350 C Calculate the local energy of a side chain and its derivatives in the
5351 C corresponding virtual-bond valence angles THETA and the spherical angles
5352 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5353 C added by Urszula Kozlowska. 07/11/2007
5355 implicit real*8 (a-h,o-z)
5356 include 'DIMENSIONS'
5357 include 'COMMON.GEO'
5358 include 'COMMON.LOCAL'
5359 include 'COMMON.VAR'
5360 include 'COMMON.SCROT'
5361 include 'COMMON.INTERACT'
5362 include 'COMMON.DERIV'
5363 include 'COMMON.CHAIN'
5364 include 'COMMON.IOUNITS'
5365 include 'COMMON.NAMES'
5366 include 'COMMON.FFIELD'
5367 include 'COMMON.CONTROL'
5368 include 'COMMON.VECTORS'
5369 double precision x_prime(3),y_prime(3),z_prime(3)
5370 & , sumene,dsc_i,dp2_i,x(65),
5371 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5372 & de_dxx,de_dyy,de_dzz,de_dt
5373 double precision s1_t,s1_6_t,s2_t,s2_6_t
5375 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5376 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5377 & dt_dCi(3),dt_dCi1(3)
5378 common /sccalc/ time11,time12,time112,theti,it,nlobit
5381 c write(iout,*) "ESC: loc_start",loc_start," loc_end",loc_end
5382 do i=loc_start,loc_end
5383 costtab(i+1) =dcos(theta(i+1))
5384 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5385 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5386 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5387 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5388 cosfac=dsqrt(cosfac2)
5389 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5390 sinfac=dsqrt(sinfac2)
5392 if (it.eq.10) goto 1
5394 C Compute the axes of tghe local cartesian coordinates system; store in
5395 c x_prime, y_prime and z_prime
5402 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5403 C & dc_norm(3,i+nres)
5405 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5406 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5409 z_prime(j) = -uz(j,i-1)
5412 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5413 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5414 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5415 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5416 c & " xy",scalar(x_prime(1),y_prime(1)),
5417 c & " xz",scalar(x_prime(1),z_prime(1)),
5418 c & " yy",scalar(y_prime(1),y_prime(1)),
5419 c & " yz",scalar(y_prime(1),z_prime(1)),
5420 c & " zz",scalar(z_prime(1),z_prime(1))
5422 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5423 C to local coordinate system. Store in xx, yy, zz.
5429 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5430 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5431 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5438 C Compute the energy of the ith side cbain
5440 c write (2,*) "xx",xx," yy",yy," zz",zz
5443 x(j) = sc_parmin(j,it)
5446 Cc diagnostics - remove later
5448 yy1 = dsin(alph(2))*dcos(omeg(2))
5449 zz1 = -dsin(alph(2))*dsin(omeg(2))
5450 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5451 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5453 C," --- ", xx_w,yy_w,zz_w
5456 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5457 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5459 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5460 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5462 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5463 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5464 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5465 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5466 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5468 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5469 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5470 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5471 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5472 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5474 dsc_i = 0.743d0+x(61)
5476 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5477 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5478 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5479 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5480 s1=(1+x(63))/(0.1d0 + dscp1)
5481 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5482 s2=(1+x(65))/(0.1d0 + dscp2)
5483 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5484 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5485 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5486 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5488 c & dscp1,dscp2,sumene
5489 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5490 escloc = escloc + sumene
5491 c write (2,*) "i",i," escloc",sumene,escloc
5494 C This section to check the numerical derivatives of the energy of ith side
5495 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5496 C #define DEBUG in the code to turn it on.
5498 write (2,*) "sumene =",sumene
5502 write (2,*) xx,yy,zz
5503 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5504 de_dxx_num=(sumenep-sumene)/aincr
5506 write (2,*) "xx+ sumene from enesc=",sumenep
5509 write (2,*) xx,yy,zz
5510 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5511 de_dyy_num=(sumenep-sumene)/aincr
5513 write (2,*) "yy+ sumene from enesc=",sumenep
5516 write (2,*) xx,yy,zz
5517 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5518 de_dzz_num=(sumenep-sumene)/aincr
5520 write (2,*) "zz+ sumene from enesc=",sumenep
5521 costsave=cost2tab(i+1)
5522 sintsave=sint2tab(i+1)
5523 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5524 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5525 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5526 de_dt_num=(sumenep-sumene)/aincr
5527 write (2,*) " t+ sumene from enesc=",sumenep
5528 cost2tab(i+1)=costsave
5529 sint2tab(i+1)=sintsave
5530 C End of diagnostics section.
5533 C Compute the gradient of esc
5535 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5536 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5537 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5538 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5539 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5540 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5541 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5542 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5543 pom1=(sumene3*sint2tab(i+1)+sumene1)
5544 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5545 pom2=(sumene4*cost2tab(i+1)+sumene2)
5546 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5547 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5548 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5549 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5551 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5552 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5553 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5555 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5556 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5557 & +(pom1+pom2)*pom_dx
5559 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5562 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5563 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5564 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5566 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5567 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5568 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5569 & +x(59)*zz**2 +x(60)*xx*zz
5570 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5571 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5572 & +(pom1-pom2)*pom_dy
5574 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5577 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5578 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5579 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5580 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5581 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5582 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5583 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5584 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5586 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5589 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5590 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5591 & +pom1*pom_dt1+pom2*pom_dt2
5593 write(2,*), "de_dt = ", de_dt,de_dt_num
5597 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5598 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5599 cosfac2xx=cosfac2*xx
5600 sinfac2yy=sinfac2*yy
5602 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5604 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5606 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5607 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5608 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5609 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5610 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5611 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5612 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5613 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5614 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5615 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5619 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5620 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5623 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5624 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5625 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5627 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5628 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5632 dXX_Ctab(k,i)=dXX_Ci(k)
5633 dXX_C1tab(k,i)=dXX_Ci1(k)
5634 dYY_Ctab(k,i)=dYY_Ci(k)
5635 dYY_C1tab(k,i)=dYY_Ci1(k)
5636 dZZ_Ctab(k,i)=dZZ_Ci(k)
5637 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5638 dXX_XYZtab(k,i)=dXX_XYZ(k)
5639 dYY_XYZtab(k,i)=dYY_XYZ(k)
5640 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5644 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5645 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5646 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5647 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5648 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5650 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5651 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5652 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5653 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5654 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5655 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5656 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5657 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5659 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5660 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5662 C to check gradient call subroutine check_grad
5668 c------------------------------------------------------------------------------
5669 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5671 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5672 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5673 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5674 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5676 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5677 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5679 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5680 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5681 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5682 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5683 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5685 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5686 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5687 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5688 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5689 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5691 dsc_i = 0.743d0+x(61)
5693 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5694 & *(xx*cost2+yy*sint2))
5695 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5696 & *(xx*cost2-yy*sint2))
5697 s1=(1+x(63))/(0.1d0 + dscp1)
5698 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5699 s2=(1+x(65))/(0.1d0 + dscp2)
5700 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5701 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5702 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5707 c------------------------------------------------------------------------------
5708 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5710 C This procedure calculates two-body contact function g(rij) and its derivative:
5713 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5716 C where x=(rij-r0ij)/delta
5718 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5721 double precision rij,r0ij,eps0ij,fcont,fprimcont
5722 double precision x,x2,x4,delta
5726 if (x.lt.-1.0D0) then
5729 else if (x.le.1.0D0) then
5732 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5733 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5740 c------------------------------------------------------------------------------
5741 subroutine splinthet(theti,delta,ss,ssder)
5742 implicit real*8 (a-h,o-z)
5743 include 'DIMENSIONS'
5744 include 'COMMON.VAR'
5745 include 'COMMON.GEO'
5748 if (theti.gt.pipol) then
5749 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5751 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5756 c------------------------------------------------------------------------------
5757 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5759 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5760 double precision ksi,ksi2,ksi3,a1,a2,a3
5761 a1=fprim0*delta/(f1-f0)
5767 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5768 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5771 c------------------------------------------------------------------------------
5772 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5774 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5775 double precision ksi,ksi2,ksi3,a1,a2,a3
5780 a2=3*(f1x-f0x)-2*fprim0x*delta
5781 a3=fprim0x*delta-2*(f1x-f0x)
5782 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5785 C-----------------------------------------------------------------------------
5787 C-----------------------------------------------------------------------------
5788 subroutine etor(etors,edihcnstr)
5789 implicit real*8 (a-h,o-z)
5790 include 'DIMENSIONS'
5791 include 'COMMON.VAR'
5792 include 'COMMON.GEO'
5793 include 'COMMON.LOCAL'
5794 include 'COMMON.TORSION'
5795 include 'COMMON.INTERACT'
5796 include 'COMMON.DERIV'
5797 include 'COMMON.CHAIN'
5798 include 'COMMON.NAMES'
5799 include 'COMMON.IOUNITS'
5800 include 'COMMON.FFIELD'
5801 include 'COMMON.TORCNSTR'
5802 include 'COMMON.CONTROL'
5804 C Set lprn=.true. for debugging
5808 do i=iphi_start,iphi_end
5810 itori=itortyp(itype(i-2))
5811 itori1=itortyp(itype(i-1))
5814 C Proline-Proline pair is a special case...
5815 if (itori.eq.3 .and. itori1.eq.3) then
5816 if (phii.gt.-dwapi3) then
5818 fac=1.0D0/(1.0D0-cosphi)
5819 etorsi=v1(1,3,3)*fac
5820 etorsi=etorsi+etorsi
5821 etors=etors+etorsi-v1(1,3,3)
5822 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5823 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5826 v1ij=v1(j+1,itori,itori1)
5827 v2ij=v2(j+1,itori,itori1)
5830 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5831 if (energy_dec) etors_ii=etors_ii+
5832 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5833 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5837 v1ij=v1(j,itori,itori1)
5838 v2ij=v2(j,itori,itori1)
5841 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5842 if (energy_dec) etors_ii=etors_ii+
5843 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5844 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5847 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5850 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5851 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5852 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5853 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5854 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5856 ! 6/20/98 - dihedral angle constraints
5859 itori=idih_constr(i)
5862 if (difi.gt.drange(i)) then
5864 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5865 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5866 else if (difi.lt.-drange(i)) then
5868 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5869 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5871 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5872 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5874 ! write (iout,*) 'edihcnstr',edihcnstr
5877 c------------------------------------------------------------------------------
5878 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5879 subroutine e_modeller(ehomology_constr)
5880 ehomology_constr=0.0d0
5881 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5884 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5886 c------------------------------------------------------------------------------
5887 subroutine etor_d(etors_d)
5891 c----------------------------------------------------------------------------
5893 subroutine etor(etors,edihcnstr)
5894 implicit real*8 (a-h,o-z)
5895 include 'DIMENSIONS'
5896 include 'COMMON.VAR'
5897 include 'COMMON.GEO'
5898 include 'COMMON.LOCAL'
5899 include 'COMMON.TORSION'
5900 include 'COMMON.INTERACT'
5901 include 'COMMON.DERIV'
5902 include 'COMMON.CHAIN'
5903 include 'COMMON.NAMES'
5904 include 'COMMON.IOUNITS'
5905 include 'COMMON.FFIELD'
5906 include 'COMMON.TORCNSTR'
5907 include 'COMMON.CONTROL'
5909 C Set lprn=.true. for debugging
5913 do i=iphi_start,iphi_end
5915 itori=itortyp(itype(i-2))
5916 itori1=itortyp(itype(i-1))
5919 C Regular cosine and sine terms
5920 do j=1,nterm(itori,itori1)
5921 v1ij=v1(j,itori,itori1)
5922 v2ij=v2(j,itori,itori1)
5925 etors=etors+v1ij*cosphi+v2ij*sinphi
5926 if (energy_dec) etors_ii=etors_ii+
5927 & v1ij*cosphi+v2ij*sinphi
5928 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5932 C E = SUM ----------------------------------- - v1
5933 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5935 cosphi=dcos(0.5d0*phii)
5936 sinphi=dsin(0.5d0*phii)
5937 do j=1,nlor(itori,itori1)
5938 vl1ij=vlor1(j,itori,itori1)
5939 vl2ij=vlor2(j,itori,itori1)
5940 vl3ij=vlor3(j,itori,itori1)
5941 pom=vl2ij*cosphi+vl3ij*sinphi
5942 pom1=1.0d0/(pom*pom+1.0d0)
5943 etors=etors+vl1ij*pom1
5944 if (energy_dec) etors_ii=etors_ii+
5947 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5949 C Subtract the constant term
5950 etors=etors-v0(itori,itori1)
5951 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5952 & 'etor',i,etors_ii-v0(itori,itori1)
5954 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5955 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5956 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5957 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5958 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5960 ! 6/20/98 - dihedral angle constraints
5962 c do i=1,ndih_constr
5963 do i=idihconstr_start,idihconstr_end
5964 itori=idih_constr(i)
5966 difi=pinorm(phii-phi0(i))
5967 if (difi.gt.drange(i)) then
5969 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5970 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5971 else if (difi.lt.-drange(i)) then
5973 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5974 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5978 c write (iout,*) "gloci", gloc(i-3,icg)
5979 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5980 cd & rad2deg*phi0(i), rad2deg*drange(i),
5981 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5983 cd write (iout,*) 'edihcnstr',edihcnstr
5986 c----------------------------------------------------------------------------
5987 c MODELLER restraint function
5988 subroutine e_modeller(ehomology_constr)
5989 implicit real*8 (a-h,o-z)
5990 include 'DIMENSIONS'
5992 integer nnn, i, j, k, ki, irec, l
5993 integer katy, odleglosci, test7
5994 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
5996 real*8 distance(max_template),distancek(max_template),
5997 & min_odl,godl(max_template),dih_diff(max_template)
6000 c FP - 30/10/2014 Temporary specifications for homology restraints
6002 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6004 double precision, dimension (maxres) :: guscdiff,usc_diff
6005 double precision, dimension (max_template) ::
6006 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6010 include 'COMMON.SBRIDGE'
6011 include 'COMMON.CHAIN'
6012 include 'COMMON.GEO'
6013 include 'COMMON.DERIV'
6014 include 'COMMON.LOCAL'
6015 include 'COMMON.INTERACT'
6016 include 'COMMON.VAR'
6017 include 'COMMON.IOUNITS'
6019 include 'COMMON.CONTROL'
6021 c From subroutine Econstr_back
6023 include 'COMMON.NAMES'
6024 include 'COMMON.TIME1'
6029 distancek(i)=9999999.9
6035 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6037 C AL 5/2/14 - Introduce list of restraints
6038 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6040 write(iout,*) "------- dist restrs start -------"
6042 do ii = link_start_homo,link_end_homo
6046 c write (iout,*) "dij(",i,j,") =",dij
6047 do k=1,constr_homology
6048 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6049 if(.not.l_homo(k,ii)) cycle
6050 distance(k)=odl(k,ii)-dij
6051 c write (iout,*) "distance(",k,") =",distance(k)
6053 c For Gaussian-type Urestr
6055 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6056 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6057 c write (iout,*) "distancek(",k,") =",distancek(k)
6058 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6060 c For Lorentzian-type Urestr
6062 if (waga_dist.lt.0.0d0) then
6063 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6064 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6065 & (distance(k)**2+sigma_odlir(k,ii)**2))
6069 min_odl=minval(distancek)
6070 c write (iout,* )"min_odl",min_odl
6072 write (iout,*) "ij dij",i,j,dij
6073 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6074 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6075 write (iout,* )"min_odl",min_odl
6078 do k=1,constr_homology
6079 c Nie wiem po co to liczycie jeszcze raz!
6080 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6081 c & (2*(sigma_odl(i,j,k))**2))
6082 if(.not.l_homo(k,ii)) cycle
6083 if (waga_dist.ge.0.0d0) then
6085 c For Gaussian-type Urestr
6087 godl(k)=dexp(-distancek(k)+min_odl)
6088 odleg2=odleg2+godl(k)
6090 c For Lorentzian-type Urestr
6093 odleg2=odleg2+distancek(k)
6096 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6097 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6098 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6099 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6102 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6103 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6105 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6106 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6108 if (waga_dist.ge.0.0d0) then
6110 c For Gaussian-type Urestr
6112 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6114 c For Lorentzian-type Urestr
6117 odleg=odleg+odleg2/constr_homology
6120 c write (iout,*) "odleg",odleg ! sum of -ln-s
6123 c For Gaussian-type Urestr
6125 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6127 do k=1,constr_homology
6128 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6129 c & *waga_dist)+min_odl
6130 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6132 if(.not.l_homo(k,ii)) cycle
6133 if (waga_dist.ge.0.0d0) then
6134 c For Gaussian-type Urestr
6136 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6138 c For Lorentzian-type Urestr
6141 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6142 & sigma_odlir(k,ii)**2)**2)
6144 sum_sgodl=sum_sgodl+sgodl
6146 c sgodl2=sgodl2+sgodl
6147 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6148 c write(iout,*) "constr_homology=",constr_homology
6149 c write(iout,*) i, j, k, "TEST K"
6151 if (waga_dist.ge.0.0d0) then
6153 c For Gaussian-type Urestr
6155 grad_odl3=waga_homology(iset)*waga_dist
6156 & *sum_sgodl/(sum_godl*dij)
6158 c For Lorentzian-type Urestr
6161 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6162 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6163 grad_odl3=-waga_homology(iset)*waga_dist*
6164 & sum_sgodl/(constr_homology*dij)
6167 c grad_odl3=sum_sgodl/(sum_godl*dij)
6170 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6171 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6172 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6174 ccc write(iout,*) godl, sgodl, grad_odl3
6176 c grad_odl=grad_odl+grad_odl3
6179 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6180 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6181 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6182 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6183 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6184 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6185 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6186 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6187 c if (i.eq.25.and.j.eq.27) then
6188 c write(iout,*) "jik",jik,"i",i,"j",j
6189 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
6190 c write(iout,*) "grad_odl3",grad_odl3
6191 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
6192 c write(iout,*) "ggodl",ggodl
6193 c write(iout,*) "ghpbc(",jik,i,")",
6194 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
6198 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6199 ccc & dLOG(odleg2),"-odleg=", -odleg
6201 enddo ! ii-loop for dist
6203 write(iout,*) "------- dist restrs end -------"
6204 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
6205 c & waga_d.eq.1.0d0) call sum_gradient
6207 c Pseudo-energy and gradient from dihedral-angle restraints from
6208 c homology templates
6209 c write (iout,*) "End of distance loop"
6212 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6214 write(iout,*) "------- dih restrs start -------"
6215 do i=idihconstr_start_homo,idihconstr_end_homo
6216 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
6219 do i=idihconstr_start_homo,idihconstr_end_homo
6221 c betai=beta(i,i+1,i+2,i+3)
6223 c write (iout,*) "betai =",betai
6224 do k=1,constr_homology
6225 dih_diff(k)=pinorm(dih(k,i)-betai)
6226 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
6227 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6228 c & -(6.28318-dih_diff(i,k))
6229 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6230 c & 6.28318+dih_diff(i,k)
6232 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6233 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
6236 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6239 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
6240 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
6242 write (iout,*) "i",i," betai",betai," kat2",kat2
6243 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6245 if (kat2.le.1.0d-14) cycle
6246 kat=kat-dLOG(kat2/constr_homology)
6247 c write (iout,*) "kat",kat ! sum of -ln-s
6249 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6250 ccc & dLOG(kat2), "-kat=", -kat
6252 c ----------------------------------------------------------------------
6254 c ----------------------------------------------------------------------
6258 do k=1,constr_homology
6259 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
6260 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
6261 sum_sgdih=sum_sgdih+sgdih
6263 c grad_dih3=sum_sgdih/sum_gdih
6264 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
6266 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6267 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6268 ccc & gloc(nphi+i-3,icg)
6269 gloc(i,icg)=gloc(i,icg)+grad_dih3
6271 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
6273 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6274 ccc & gloc(nphi+i-3,icg)
6276 enddo ! i-loop for dih
6278 write(iout,*) "------- dih restrs end -------"
6281 c Pseudo-energy and gradient for theta angle restraints from
6282 c homology templates
6283 c FP 01/15 - inserted from econstr_local_test.F, loop structure
6287 c For constr_homology reference structures (FP)
6289 c Uconst_back_tot=0.0d0
6292 c Econstr_back legacy
6294 c do i=ithet_start,ithet_end
6297 c do i=loc_start,loc_end
6300 duscdiffx(j,i)=0.0d0
6305 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
6306 c write (iout,*) "waga_theta",waga_theta
6307 if (waga_theta.gt.0.0d0) then
6309 write (iout,*) "usampl",usampl
6310 write(iout,*) "------- theta restrs start -------"
6311 c do i=ithet_start,ithet_end
6312 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
6315 c write (iout,*) "maxres",maxres,"nres",nres
6317 do i=ithet_start,ithet_end
6320 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
6322 c Deviation of theta angles wrt constr_homology ref structures
6324 utheta_i=0.0d0 ! argument of Gaussian for single k
6325 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6326 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
6327 c over residues in a fragment
6328 c write (iout,*) "theta(",i,")=",theta(i)
6329 do k=1,constr_homology
6331 c dtheta_i=theta(j)-thetaref(j,iref)
6332 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
6333 theta_diff(k)=thetatpl(k,i)-theta(i)
6335 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
6336 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
6337 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
6338 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
6339 c Gradient for single Gaussian restraint in subr Econstr_back
6340 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
6343 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
6344 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
6347 c Gradient for multiple Gaussian restraint
6348 sum_gtheta=gutheta_i
6350 do k=1,constr_homology
6351 c New generalized expr for multiple Gaussian from Econstr_back
6352 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
6354 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
6355 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
6357 c Final value of gradient using same var as in Econstr_back
6358 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
6359 & +sum_sgtheta/sum_gtheta*waga_theta
6360 & *waga_homology(iset)
6361 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
6362 c & *waga_homology(iset)
6363 c dutheta(i)=sum_sgtheta/sum_gtheta
6365 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
6366 Eval=Eval-dLOG(gutheta_i/constr_homology)
6367 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
6368 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
6369 c Uconst_back=Uconst_back+utheta(i)
6370 enddo ! (i-loop for theta)
6372 write(iout,*) "------- theta restrs end -------"
6376 c Deviation of local SC geometry
6378 c Separation of two i-loops (instructed by AL - 11/3/2014)
6380 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
6381 c write (iout,*) "waga_d",waga_d
6384 write(iout,*) "------- SC restrs start -------"
6385 write (iout,*) "Initial duscdiff,duscdiffx"
6386 do i=loc_start,loc_end
6387 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
6388 & (duscdiffx(jik,i),jik=1,3)
6391 do i=loc_start,loc_end
6392 usc_diff_i=0.0d0 ! argument of Gaussian for single k
6393 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6394 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
6395 c write(iout,*) "xxtab, yytab, zztab"
6396 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
6397 do k=1,constr_homology
6399 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6400 c Original sign inverted for calc of gradients (s. Econstr_back)
6401 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6402 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6403 c write(iout,*) "dxx, dyy, dzz"
6404 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6406 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
6407 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
6408 c uscdiffk(k)=usc_diff(i)
6409 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
6410 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
6411 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
6412 c & xxref(j),yyref(j),zzref(j)
6417 c Generalized expression for multiple Gaussian acc to that for a single
6418 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
6420 c Original implementation
6421 c sum_guscdiff=guscdiff(i)
6423 c sum_sguscdiff=0.0d0
6424 c do k=1,constr_homology
6425 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
6426 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
6427 c sum_sguscdiff=sum_sguscdiff+sguscdiff
6430 c Implementation of new expressions for gradient (Jan. 2015)
6432 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
6433 do k=1,constr_homology
6435 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
6436 c before. Now the drivatives should be correct
6438 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6439 c Original sign inverted for calc of gradients (s. Econstr_back)
6440 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6441 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6443 c New implementation
6445 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
6446 & sigma_d(k,i) ! for the grad wrt r'
6447 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
6450 c New implementation
6451 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
6453 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
6454 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
6455 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
6456 duscdiff(jik,i)=duscdiff(jik,i)+
6457 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
6458 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
6459 duscdiffx(jik,i)=duscdiffx(jik,i)+
6460 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
6461 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
6464 write(iout,*) "jik",jik,"i",i
6465 write(iout,*) "dxx, dyy, dzz"
6466 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6467 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
6468 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
6469 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
6470 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
6471 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
6472 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
6473 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
6474 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
6475 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
6476 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
6477 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
6478 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
6479 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
6480 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
6486 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
6487 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
6489 c write (iout,*) i," uscdiff",uscdiff(i)
6491 c Put together deviations from local geometry
6493 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
6494 c & wfrag_back(3,i,iset)*uscdiff(i)
6495 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
6496 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
6497 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
6498 c Uconst_back=Uconst_back+usc_diff(i)
6500 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
6502 c New implment: multiplied by sum_sguscdiff
6505 enddo ! (i-loop for dscdiff)
6510 write(iout,*) "------- SC restrs end -------"
6511 write (iout,*) "------ After SC loop in e_modeller ------"
6512 do i=loc_start,loc_end
6513 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
6514 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
6516 if (waga_theta.eq.1.0d0) then
6517 write (iout,*) "in e_modeller after SC restr end: dutheta"
6518 do i=ithet_start,ithet_end
6519 write (iout,*) i,dutheta(i)
6522 if (waga_d.eq.1.0d0) then
6523 write (iout,*) "e_modeller after SC loop: duscdiff/x"
6525 write (iout,*) i,(duscdiff(j,i),j=1,3)
6526 write (iout,*) i,(duscdiffx(j,i),j=1,3)
6531 c Total energy from homology restraints
6533 write (iout,*) "odleg",odleg," kat",kat
6536 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
6538 c ehomology_constr=odleg+kat
6540 c For Lorentzian-type Urestr
6543 if (waga_dist.ge.0.0d0) then
6545 c For Gaussian-type Urestr
6547 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
6548 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6549 c write (iout,*) "ehomology_constr=",ehomology_constr
6552 c For Lorentzian-type Urestr
6554 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
6555 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6556 c write (iout,*) "ehomology_constr=",ehomology_constr
6559 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
6560 & "Eval",waga_theta,eval,
6561 & "Erot",waga_d,Erot
6562 write (iout,*) "ehomology_constr",ehomology_constr
6568 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6569 747 format(a12,i4,i4,i4,f8.3,f8.3)
6570 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6571 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6572 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6573 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6576 c------------------------------------------------------------------------------
6577 subroutine etor_d(etors_d)
6578 C 6/23/01 Compute double torsional energy
6579 implicit real*8 (a-h,o-z)
6580 include 'DIMENSIONS'
6581 include 'COMMON.VAR'
6582 include 'COMMON.GEO'
6583 include 'COMMON.LOCAL'
6584 include 'COMMON.TORSION'
6585 include 'COMMON.INTERACT'
6586 include 'COMMON.DERIV'
6587 include 'COMMON.CHAIN'
6588 include 'COMMON.NAMES'
6589 include 'COMMON.IOUNITS'
6590 include 'COMMON.FFIELD'
6591 include 'COMMON.TORCNSTR'
6592 include 'COMMON.CONTROL'
6594 C Set lprn=.true. for debugging
6598 do i=iphid_start,iphid_end
6600 itori=itortyp(itype(i-2))
6601 itori1=itortyp(itype(i-1))
6602 itori2=itortyp(itype(i))
6607 do j=1,ntermd_1(itori,itori1,itori2)
6608 v1cij=v1c(1,j,itori,itori1,itori2)
6609 v1sij=v1s(1,j,itori,itori1,itori2)
6610 v2cij=v1c(2,j,itori,itori1,itori2)
6611 v2sij=v1s(2,j,itori,itori1,itori2)
6612 cosphi1=dcos(j*phii)
6613 sinphi1=dsin(j*phii)
6614 cosphi2=dcos(j*phii1)
6615 sinphi2=dsin(j*phii1)
6616 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6617 & v2cij*cosphi2+v2sij*sinphi2
6618 if (energy_dec) etors_d_ii=etors_d_ii+
6619 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6620 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6621 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6623 do k=2,ntermd_2(itori,itori1,itori2)
6625 v1cdij = v2c(k,l,itori,itori1,itori2)
6626 v2cdij = v2c(l,k,itori,itori1,itori2)
6627 v1sdij = v2s(k,l,itori,itori1,itori2)
6628 v2sdij = v2s(l,k,itori,itori1,itori2)
6629 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6630 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6631 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6632 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6633 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6634 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6635 if (energy_dec) etors_d_ii=etors_d_ii+
6636 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6637 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6638 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6639 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6640 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6641 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6644 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6645 & 'etor_d',i,etors_d_ii
6646 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6647 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6648 c write (iout,*) "gloci", gloc(i-3,icg)
6653 c------------------------------------------------------------------------------
6654 subroutine eback_sc_corr(esccor)
6655 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6656 c conformational states; temporarily implemented as differences
6657 c between UNRES torsional potentials (dependent on three types of
6658 c residues) and the torsional potentials dependent on all 20 types
6659 c of residues computed from AM1 energy surfaces of terminally-blocked
6660 c amino-acid residues.
6661 implicit real*8 (a-h,o-z)
6662 include 'DIMENSIONS'
6663 include 'COMMON.VAR'
6664 include 'COMMON.GEO'
6665 include 'COMMON.LOCAL'
6666 include 'COMMON.TORSION'
6667 include 'COMMON.SCCOR'
6668 include 'COMMON.INTERACT'
6669 include 'COMMON.DERIV'
6670 include 'COMMON.CHAIN'
6671 include 'COMMON.NAMES'
6672 include 'COMMON.IOUNITS'
6673 include 'COMMON.FFIELD'
6674 include 'COMMON.CONTROL'
6676 C Set lprn=.true. for debugging
6679 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6681 do i=itau_start,itau_end
6683 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6684 isccori=isccortyp(itype(i-2))
6685 isccori1=isccortyp(itype(i-1))
6687 cccc Added 9 May 2012
6688 cc Tauangle is torsional engle depending on the value of first digit
6689 c(see comment below)
6690 cc Omicron is flat angle depending on the value of first digit
6691 c(see comment below)
6694 do intertyp=1,3 !intertyp
6695 cc Added 09 May 2012 (Adasko)
6696 cc Intertyp means interaction type of backbone mainchain correlation:
6697 c 1 = SC...Ca...Ca...Ca
6698 c 2 = Ca...Ca...Ca...SC
6699 c 3 = SC...Ca...Ca...SCi
6701 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6702 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6703 & (itype(i-1).eq.21)))
6704 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6705 & .or.(itype(i-2).eq.21)))
6706 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6707 & (itype(i-1).eq.21)))) cycle
6708 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6709 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6711 do j=1,nterm_sccor(isccori,isccori1)
6712 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6713 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6714 cosphi=dcos(j*tauangle(intertyp,i))
6715 sinphi=dsin(j*tauangle(intertyp,i))
6716 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6717 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6719 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6720 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6721 c &gloc_sc(intertyp,i-3,icg)
6723 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6724 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6725 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6726 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6727 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6731 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6735 c----------------------------------------------------------------------------
6736 subroutine multibody(ecorr)
6737 C This subroutine calculates multi-body contributions to energy following
6738 C the idea of Skolnick et al. If side chains I and J make a contact and
6739 C at the same time side chains I+1 and J+1 make a contact, an extra
6740 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6741 implicit real*8 (a-h,o-z)
6742 include 'DIMENSIONS'
6743 include 'COMMON.IOUNITS'
6744 include 'COMMON.DERIV'
6745 include 'COMMON.INTERACT'
6746 include 'COMMON.CONTACTS'
6747 double precision gx(3),gx1(3)
6750 C Set lprn=.true. for debugging
6754 write (iout,'(a)') 'Contact function values:'
6756 write (iout,'(i2,20(1x,i2,f10.5))')
6757 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6772 num_conti=num_cont(i)
6773 num_conti1=num_cont(i1)
6778 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6779 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6780 cd & ' ishift=',ishift
6781 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6782 C The system gains extra energy.
6783 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6784 endif ! j1==j+-ishift
6793 c------------------------------------------------------------------------------
6794 double precision function esccorr(i,j,k,l,jj,kk)
6795 implicit real*8 (a-h,o-z)
6796 include 'DIMENSIONS'
6797 include 'COMMON.IOUNITS'
6798 include 'COMMON.DERIV'
6799 include 'COMMON.INTERACT'
6800 include 'COMMON.CONTACTS'
6801 double precision gx(3),gx1(3)
6806 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6807 C Calculate the multi-body contribution to energy.
6808 C Calculate multi-body contributions to the gradient.
6809 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6810 cd & k,l,(gacont(m,kk,k),m=1,3)
6812 gx(m) =ekl*gacont(m,jj,i)
6813 gx1(m)=eij*gacont(m,kk,k)
6814 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6815 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6816 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6817 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6821 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6826 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6832 c------------------------------------------------------------------------------
6833 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6834 C This subroutine calculates multi-body contributions to hydrogen-bonding
6835 implicit real*8 (a-h,o-z)
6836 include 'DIMENSIONS'
6837 include 'COMMON.IOUNITS'
6840 parameter (max_cont=maxconts)
6841 parameter (max_dim=26)
6842 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6843 double precision zapas(max_dim,maxconts,max_fg_procs),
6844 & zapas_recv(max_dim,maxconts,max_fg_procs)
6845 common /przechowalnia/ zapas
6846 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6847 & status_array(MPI_STATUS_SIZE,maxconts*2)
6849 include 'COMMON.SETUP'
6850 include 'COMMON.FFIELD'
6851 include 'COMMON.DERIV'
6852 include 'COMMON.INTERACT'
6853 include 'COMMON.CONTACTS'
6854 include 'COMMON.CONTROL'
6855 include 'COMMON.LOCAL'
6856 double precision gx(3),gx1(3),time00
6859 C Set lprn=.true. for debugging
6864 if (nfgtasks.le.1) goto 30
6866 write (iout,'(a)') 'Contact function values before RECEIVE:'
6868 write (iout,'(2i3,50(1x,i2,f5.2))')
6869 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6870 & j=1,num_cont_hb(i))
6874 do i=1,ntask_cont_from
6877 do i=1,ntask_cont_to
6880 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6882 C Make the list of contacts to send to send to other procesors
6883 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6885 do i=iturn3_start,iturn3_end
6886 c write (iout,*) "make contact list turn3",i," num_cont",
6888 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6890 do i=iturn4_start,iturn4_end
6891 c write (iout,*) "make contact list turn4",i," num_cont",
6893 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6897 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6899 do j=1,num_cont_hb(i)
6902 iproc=iint_sent_local(k,jjc,ii)
6903 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6904 if (iproc.gt.0) then
6905 ncont_sent(iproc)=ncont_sent(iproc)+1
6906 nn=ncont_sent(iproc)
6908 zapas(2,nn,iproc)=jjc
6909 zapas(3,nn,iproc)=facont_hb(j,i)
6910 zapas(4,nn,iproc)=ees0p(j,i)
6911 zapas(5,nn,iproc)=ees0m(j,i)
6912 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6913 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6914 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6915 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6916 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6917 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6918 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6919 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6920 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6921 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6922 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6923 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6924 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6925 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6926 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6927 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6928 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6929 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6930 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6931 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6932 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6939 & "Numbers of contacts to be sent to other processors",
6940 & (ncont_sent(i),i=1,ntask_cont_to)
6941 write (iout,*) "Contacts sent"
6942 do ii=1,ntask_cont_to
6944 iproc=itask_cont_to(ii)
6945 write (iout,*) nn," contacts to processor",iproc,
6946 & " of CONT_TO_COMM group"
6948 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6956 CorrelID1=nfgtasks+fg_rank+1
6958 C Receive the numbers of needed contacts from other processors
6959 do ii=1,ntask_cont_from
6960 iproc=itask_cont_from(ii)
6962 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6963 & FG_COMM,req(ireq),IERR)
6965 c write (iout,*) "IRECV ended"
6967 C Send the number of contacts needed by other processors
6968 do ii=1,ntask_cont_to
6969 iproc=itask_cont_to(ii)
6971 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6972 & FG_COMM,req(ireq),IERR)
6974 c write (iout,*) "ISEND ended"
6975 c write (iout,*) "number of requests (nn)",ireq
6978 & call MPI_Waitall(ireq,req,status_array,ierr)
6980 c & "Numbers of contacts to be received from other processors",
6981 c & (ncont_recv(i),i=1,ntask_cont_from)
6985 do ii=1,ntask_cont_from
6986 iproc=itask_cont_from(ii)
6988 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6989 c & " of CONT_TO_COMM group"
6993 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6994 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6995 c write (iout,*) "ireq,req",ireq,req(ireq)
6998 C Send the contacts to processors that need them
6999 do ii=1,ntask_cont_to
7000 iproc=itask_cont_to(ii)
7002 c write (iout,*) nn," contacts to processor",iproc,
7003 c & " of CONT_TO_COMM group"
7006 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7007 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7008 c write (iout,*) "ireq,req",ireq,req(ireq)
7010 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7014 c write (iout,*) "number of requests (contacts)",ireq
7015 c write (iout,*) "req",(req(i),i=1,4)
7018 & call MPI_Waitall(ireq,req,status_array,ierr)
7019 do iii=1,ntask_cont_from
7020 iproc=itask_cont_from(iii)
7023 write (iout,*) "Received",nn," contacts from processor",iproc,
7024 & " of CONT_FROM_COMM group"
7027 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7032 ii=zapas_recv(1,i,iii)
7033 c Flag the received contacts to prevent double-counting
7034 jj=-zapas_recv(2,i,iii)
7035 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7037 nnn=num_cont_hb(ii)+1
7040 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7041 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7042 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7043 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7044 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7045 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7046 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7047 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7048 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7049 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7050 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7051 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7052 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7053 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7054 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7055 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7056 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7057 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7058 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7059 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7060 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7061 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7062 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7063 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7068 write (iout,'(a)') 'Contact function values after receive:'
7070 write (iout,'(2i3,50(1x,i3,f5.2))')
7071 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7072 & j=1,num_cont_hb(i))
7079 write (iout,'(a)') 'Contact function values:'
7081 write (iout,'(2i3,50(1x,i3,f5.2))')
7082 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7083 & j=1,num_cont_hb(i))
7087 C Remove the loop below after debugging !!!
7094 C Calculate the local-electrostatic correlation terms
7095 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7097 num_conti=num_cont_hb(i)
7098 num_conti1=num_cont_hb(i+1)
7105 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7106 c & ' jj=',jj,' kk=',kk
7107 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7108 & .or. j.lt.0 .and. j1.gt.0) .and.
7109 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7110 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7111 C The system gains extra energy.
7112 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7113 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7114 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7116 else if (j1.eq.j) then
7117 C Contacts I-J and I-(J+1) occur simultaneously.
7118 C The system loses extra energy.
7119 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7124 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7125 c & ' jj=',jj,' kk=',kk
7127 C Contacts I-J and (I+1)-J occur simultaneously.
7128 C The system loses extra energy.
7129 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7136 c------------------------------------------------------------------------------
7137 subroutine add_hb_contact(ii,jj,itask)
7138 implicit real*8 (a-h,o-z)
7139 include "DIMENSIONS"
7140 include "COMMON.IOUNITS"
7143 parameter (max_cont=maxconts)
7144 parameter (max_dim=26)
7145 include "COMMON.CONTACTS"
7146 double precision zapas(max_dim,maxconts,max_fg_procs),
7147 & zapas_recv(max_dim,maxconts,max_fg_procs)
7148 common /przechowalnia/ zapas
7149 integer i,j,ii,jj,iproc,itask(4),nn
7150 c write (iout,*) "itask",itask
7153 if (iproc.gt.0) then
7154 do j=1,num_cont_hb(ii)
7156 c write (iout,*) "i",ii," j",jj," jjc",jjc
7158 ncont_sent(iproc)=ncont_sent(iproc)+1
7159 nn=ncont_sent(iproc)
7160 zapas(1,nn,iproc)=ii
7161 zapas(2,nn,iproc)=jjc
7162 zapas(3,nn,iproc)=facont_hb(j,ii)
7163 zapas(4,nn,iproc)=ees0p(j,ii)
7164 zapas(5,nn,iproc)=ees0m(j,ii)
7165 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7166 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7167 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7168 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7169 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7170 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7171 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7172 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7173 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7174 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7175 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7176 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7177 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7178 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7179 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7180 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7181 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7182 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7183 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7184 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7185 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7193 c------------------------------------------------------------------------------
7194 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7196 C This subroutine calculates multi-body contributions to hydrogen-bonding
7197 implicit real*8 (a-h,o-z)
7198 include 'DIMENSIONS'
7199 include 'COMMON.IOUNITS'
7202 parameter (max_cont=maxconts)
7203 parameter (max_dim=70)
7204 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7205 double precision zapas(max_dim,maxconts,max_fg_procs),
7206 & zapas_recv(max_dim,maxconts,max_fg_procs)
7207 common /przechowalnia/ zapas
7208 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7209 & status_array(MPI_STATUS_SIZE,maxconts*2)
7211 include 'COMMON.SETUP'
7212 include 'COMMON.FFIELD'
7213 include 'COMMON.DERIV'
7214 include 'COMMON.LOCAL'
7215 include 'COMMON.INTERACT'
7216 include 'COMMON.CONTACTS'
7217 include 'COMMON.CHAIN'
7218 include 'COMMON.CONTROL'
7219 double precision gx(3),gx1(3)
7220 integer num_cont_hb_old(maxres)
7222 double precision eello4,eello5,eelo6,eello_turn6
7223 external eello4,eello5,eello6,eello_turn6
7224 C Set lprn=.true. for debugging
7229 num_cont_hb_old(i)=num_cont_hb(i)
7233 if (nfgtasks.le.1) goto 30
7235 write (iout,'(a)') 'Contact function values before RECEIVE:'
7237 write (iout,'(2i3,50(1x,i2,f5.2))')
7238 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7239 & j=1,num_cont_hb(i))
7243 do i=1,ntask_cont_from
7246 do i=1,ntask_cont_to
7249 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7251 C Make the list of contacts to send to send to other procesors
7252 do i=iturn3_start,iturn3_end
7253 c write (iout,*) "make contact list turn3",i," num_cont",
7255 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7257 do i=iturn4_start,iturn4_end
7258 c write (iout,*) "make contact list turn4",i," num_cont",
7260 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7264 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7266 do j=1,num_cont_hb(i)
7269 iproc=iint_sent_local(k,jjc,ii)
7270 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7271 if (iproc.ne.0) then
7272 ncont_sent(iproc)=ncont_sent(iproc)+1
7273 nn=ncont_sent(iproc)
7275 zapas(2,nn,iproc)=jjc
7276 zapas(3,nn,iproc)=d_cont(j,i)
7280 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7285 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7293 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7304 & "Numbers of contacts to be sent to other processors",
7305 & (ncont_sent(i),i=1,ntask_cont_to)
7306 write (iout,*) "Contacts sent"
7307 do ii=1,ntask_cont_to
7309 iproc=itask_cont_to(ii)
7310 write (iout,*) nn," contacts to processor",iproc,
7311 & " of CONT_TO_COMM group"
7313 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7321 CorrelID1=nfgtasks+fg_rank+1
7323 C Receive the numbers of needed contacts from other processors
7324 do ii=1,ntask_cont_from
7325 iproc=itask_cont_from(ii)
7327 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7328 & FG_COMM,req(ireq),IERR)
7330 c write (iout,*) "IRECV ended"
7332 C Send the number of contacts needed by other processors
7333 do ii=1,ntask_cont_to
7334 iproc=itask_cont_to(ii)
7336 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7337 & FG_COMM,req(ireq),IERR)
7339 c write (iout,*) "ISEND ended"
7340 c write (iout,*) "number of requests (nn)",ireq
7343 & call MPI_Waitall(ireq,req,status_array,ierr)
7345 c & "Numbers of contacts to be received from other processors",
7346 c & (ncont_recv(i),i=1,ntask_cont_from)
7350 do ii=1,ntask_cont_from
7351 iproc=itask_cont_from(ii)
7353 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7354 c & " of CONT_TO_COMM group"
7358 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7359 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7360 c write (iout,*) "ireq,req",ireq,req(ireq)
7363 C Send the contacts to processors that need them
7364 do ii=1,ntask_cont_to
7365 iproc=itask_cont_to(ii)
7367 c write (iout,*) nn," contacts to processor",iproc,
7368 c & " of CONT_TO_COMM group"
7371 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7372 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7373 c write (iout,*) "ireq,req",ireq,req(ireq)
7375 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7379 c write (iout,*) "number of requests (contacts)",ireq
7380 c write (iout,*) "req",(req(i),i=1,4)
7383 & call MPI_Waitall(ireq,req,status_array,ierr)
7384 do iii=1,ntask_cont_from
7385 iproc=itask_cont_from(iii)
7388 write (iout,*) "Received",nn," contacts from processor",iproc,
7389 & " of CONT_FROM_COMM group"
7392 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7397 ii=zapas_recv(1,i,iii)
7398 c Flag the received contacts to prevent double-counting
7399 jj=-zapas_recv(2,i,iii)
7400 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7402 nnn=num_cont_hb(ii)+1
7405 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7409 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7414 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7422 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7431 write (iout,'(a)') 'Contact function values after receive:'
7433 write (iout,'(2i3,50(1x,i3,5f6.3))')
7434 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7435 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7442 write (iout,'(a)') 'Contact function values:'
7444 write (iout,'(2i3,50(1x,i2,5f6.3))')
7445 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7446 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7452 C Remove the loop below after debugging !!!
7459 C Calculate the dipole-dipole interaction energies
7460 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7461 do i=iatel_s,iatel_e+1
7462 num_conti=num_cont_hb(i)
7471 C Calculate the local-electrostatic correlation terms
7472 c write (iout,*) "gradcorr5 in eello5 before loop"
7474 c write (iout,'(i5,3f10.5)')
7475 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7477 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7478 c write (iout,*) "corr loop i",i
7480 num_conti=num_cont_hb(i)
7481 num_conti1=num_cont_hb(i+1)
7488 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7489 c & ' jj=',jj,' kk=',kk
7490 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7491 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7492 & .or. j.lt.0 .and. j1.gt.0) .and.
7493 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7494 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7495 C The system gains extra energy.
7497 sqd1=dsqrt(d_cont(jj,i))
7498 sqd2=dsqrt(d_cont(kk,i1))
7499 sred_geom = sqd1*sqd2
7500 IF (sred_geom.lt.cutoff_corr) THEN
7501 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7503 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7504 cd & ' jj=',jj,' kk=',kk
7505 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7506 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7508 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7509 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7512 cd write (iout,*) 'sred_geom=',sred_geom,
7513 cd & ' ekont=',ekont,' fprim=',fprimcont,
7514 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7515 cd write (iout,*) "g_contij",g_contij
7516 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7517 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7518 call calc_eello(i,jp,i+1,jp1,jj,kk)
7519 if (wcorr4.gt.0.0d0)
7520 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7521 if (energy_dec.and.wcorr4.gt.0.0d0)
7522 1 write (iout,'(a6,4i5,0pf7.3)')
7523 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7524 c write (iout,*) "gradcorr5 before eello5"
7526 c write (iout,'(i5,3f10.5)')
7527 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7529 if (wcorr5.gt.0.0d0)
7530 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7531 c write (iout,*) "gradcorr5 after eello5"
7533 c write (iout,'(i5,3f10.5)')
7534 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7536 if (energy_dec.and.wcorr5.gt.0.0d0)
7537 1 write (iout,'(a6,4i5,0pf7.3)')
7538 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7539 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7540 cd write(2,*)'ijkl',i,jp,i+1,jp1
7541 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7542 & .or. wturn6.eq.0.0d0))then
7543 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7544 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7545 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7546 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7547 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7548 cd & 'ecorr6=',ecorr6
7549 cd write (iout,'(4e15.5)') sred_geom,
7550 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7551 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7552 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7553 else if (wturn6.gt.0.0d0
7554 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7555 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7556 eturn6=eturn6+eello_turn6(i,jj,kk)
7557 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7558 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7559 cd write (2,*) 'multibody_eello:eturn6',eturn6
7568 num_cont_hb(i)=num_cont_hb_old(i)
7570 c write (iout,*) "gradcorr5 in eello5"
7572 c write (iout,'(i5,3f10.5)')
7573 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7577 c------------------------------------------------------------------------------
7578 subroutine add_hb_contact_eello(ii,jj,itask)
7579 implicit real*8 (a-h,o-z)
7580 include "DIMENSIONS"
7581 include "COMMON.IOUNITS"
7584 parameter (max_cont=maxconts)
7585 parameter (max_dim=70)
7586 include "COMMON.CONTACTS"
7587 double precision zapas(max_dim,maxconts,max_fg_procs),
7588 & zapas_recv(max_dim,maxconts,max_fg_procs)
7589 common /przechowalnia/ zapas
7590 integer i,j,ii,jj,iproc,itask(4),nn
7591 c write (iout,*) "itask",itask
7594 if (iproc.gt.0) then
7595 do j=1,num_cont_hb(ii)
7597 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7599 ncont_sent(iproc)=ncont_sent(iproc)+1
7600 nn=ncont_sent(iproc)
7601 zapas(1,nn,iproc)=ii
7602 zapas(2,nn,iproc)=jjc
7603 zapas(3,nn,iproc)=d_cont(j,ii)
7607 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7612 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7620 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7632 c------------------------------------------------------------------------------
7633 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7634 implicit real*8 (a-h,o-z)
7635 include 'DIMENSIONS'
7636 include 'COMMON.IOUNITS'
7637 include 'COMMON.DERIV'
7638 include 'COMMON.INTERACT'
7639 include 'COMMON.CONTACTS'
7640 double precision gx(3),gx1(3)
7650 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7651 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7652 C Following 4 lines for diagnostics.
7657 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7658 c & 'Contacts ',i,j,
7659 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7660 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7662 C Calculate the multi-body contribution to energy.
7663 c ecorr=ecorr+ekont*ees
7664 C Calculate multi-body contributions to the gradient.
7665 coeffpees0pij=coeffp*ees0pij
7666 coeffmees0mij=coeffm*ees0mij
7667 coeffpees0pkl=coeffp*ees0pkl
7668 coeffmees0mkl=coeffm*ees0mkl
7670 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7671 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7672 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7673 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7674 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7675 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7676 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7677 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7678 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7679 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7680 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7681 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7682 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7683 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7684 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7685 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7686 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7687 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7688 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7689 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7690 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7691 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7692 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7693 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7694 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7699 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7700 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7701 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7702 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7707 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7708 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7709 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7710 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7713 c write (iout,*) "ehbcorr",ekont*ees
7718 C---------------------------------------------------------------------------
7719 subroutine dipole(i,j,jj)
7720 implicit real*8 (a-h,o-z)
7721 include 'DIMENSIONS'
7722 include 'COMMON.IOUNITS'
7723 include 'COMMON.CHAIN'
7724 include 'COMMON.FFIELD'
7725 include 'COMMON.DERIV'
7726 include 'COMMON.INTERACT'
7727 include 'COMMON.CONTACTS'
7728 include 'COMMON.TORSION'
7729 include 'COMMON.VAR'
7730 include 'COMMON.GEO'
7731 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7733 iti1 = itortyp(itype(i+1))
7734 if (j.lt.nres-1) then
7735 itj1 = itortyp(itype(j+1))
7740 dipi(iii,1)=Ub2(iii,i)
7741 dipderi(iii)=Ub2der(iii,i)
7742 dipi(iii,2)=b1(iii,iti1)
7743 dipj(iii,1)=Ub2(iii,j)
7744 dipderj(iii)=Ub2der(iii,j)
7745 dipj(iii,2)=b1(iii,itj1)
7749 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7752 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7759 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7763 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7768 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7769 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7771 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7773 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7775 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7780 C---------------------------------------------------------------------------
7781 subroutine calc_eello(i,j,k,l,jj,kk)
7783 C This subroutine computes matrices and vectors needed to calculate
7784 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7786 implicit real*8 (a-h,o-z)
7787 include 'DIMENSIONS'
7788 include 'COMMON.IOUNITS'
7789 include 'COMMON.CHAIN'
7790 include 'COMMON.DERIV'
7791 include 'COMMON.INTERACT'
7792 include 'COMMON.CONTACTS'
7793 include 'COMMON.TORSION'
7794 include 'COMMON.VAR'
7795 include 'COMMON.GEO'
7796 include 'COMMON.FFIELD'
7797 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7798 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7801 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7802 cd & ' jj=',jj,' kk=',kk
7803 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7804 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7805 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7808 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7809 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7812 call transpose2(aa1(1,1),aa1t(1,1))
7813 call transpose2(aa2(1,1),aa2t(1,1))
7816 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7817 & aa1tder(1,1,lll,kkk))
7818 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7819 & aa2tder(1,1,lll,kkk))
7823 C parallel orientation of the two CA-CA-CA frames.
7825 iti=itortyp(itype(i))
7829 itk1=itortyp(itype(k+1))
7830 itj=itortyp(itype(j))
7831 if (l.lt.nres-1) then
7832 itl1=itortyp(itype(l+1))
7836 C A1 kernel(j+1) A2T
7838 cd write (iout,'(3f10.5,5x,3f10.5)')
7839 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7841 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7842 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7843 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7844 C Following matrices are needed only for 6-th order cumulants
7845 IF (wcorr6.gt.0.0d0) THEN
7846 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7847 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7848 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7849 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7850 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7851 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7852 & ADtEAderx(1,1,1,1,1,1))
7854 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7855 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7856 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7857 & ADtEA1derx(1,1,1,1,1,1))
7859 C End 6-th order cumulants
7862 cd write (2,*) 'In calc_eello6'
7864 cd write (2,*) 'iii=',iii
7866 cd write (2,*) 'kkk=',kkk
7868 cd write (2,'(3(2f10.5),5x)')
7869 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7874 call transpose2(EUgder(1,1,k),auxmat(1,1))
7875 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7876 call transpose2(EUg(1,1,k),auxmat(1,1))
7877 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7878 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7882 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7883 & EAEAderx(1,1,lll,kkk,iii,1))
7887 C A1T kernel(i+1) A2
7888 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7889 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7890 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7891 C Following matrices are needed only for 6-th order cumulants
7892 IF (wcorr6.gt.0.0d0) THEN
7893 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7894 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7895 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7896 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7897 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7898 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7899 & ADtEAderx(1,1,1,1,1,2))
7900 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7901 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7902 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7903 & ADtEA1derx(1,1,1,1,1,2))
7905 C End 6-th order cumulants
7906 call transpose2(EUgder(1,1,l),auxmat(1,1))
7907 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7908 call transpose2(EUg(1,1,l),auxmat(1,1))
7909 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7910 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7914 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7915 & EAEAderx(1,1,lll,kkk,iii,2))
7920 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7921 C They are needed only when the fifth- or the sixth-order cumulants are
7923 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7924 call transpose2(AEA(1,1,1),auxmat(1,1))
7925 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7926 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7927 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7928 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7929 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7930 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7931 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7932 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7933 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7934 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7935 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7936 call transpose2(AEA(1,1,2),auxmat(1,1))
7937 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7938 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7939 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7940 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7941 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7942 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7943 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7944 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7945 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7946 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7947 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7948 C Calculate the Cartesian derivatives of the vectors.
7952 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7953 call matvec2(auxmat(1,1),b1(1,iti),
7954 & AEAb1derx(1,lll,kkk,iii,1,1))
7955 call matvec2(auxmat(1,1),Ub2(1,i),
7956 & AEAb2derx(1,lll,kkk,iii,1,1))
7957 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7958 & AEAb1derx(1,lll,kkk,iii,2,1))
7959 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7960 & AEAb2derx(1,lll,kkk,iii,2,1))
7961 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7962 call matvec2(auxmat(1,1),b1(1,itj),
7963 & AEAb1derx(1,lll,kkk,iii,1,2))
7964 call matvec2(auxmat(1,1),Ub2(1,j),
7965 & AEAb2derx(1,lll,kkk,iii,1,2))
7966 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7967 & AEAb1derx(1,lll,kkk,iii,2,2))
7968 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7969 & AEAb2derx(1,lll,kkk,iii,2,2))
7976 C Antiparallel orientation of the two CA-CA-CA frames.
7978 iti=itortyp(itype(i))
7982 itk1=itortyp(itype(k+1))
7983 itl=itortyp(itype(l))
7984 itj=itortyp(itype(j))
7985 if (j.lt.nres-1) then
7986 itj1=itortyp(itype(j+1))
7990 C A2 kernel(j-1)T A1T
7991 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7992 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7993 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7994 C Following matrices are needed only for 6-th order cumulants
7995 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7996 & j.eq.i+4 .and. l.eq.i+3)) THEN
7997 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7998 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7999 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8000 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8001 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8002 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8003 & ADtEAderx(1,1,1,1,1,1))
8004 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8005 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8006 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8007 & ADtEA1derx(1,1,1,1,1,1))
8009 C End 6-th order cumulants
8010 call transpose2(EUgder(1,1,k),auxmat(1,1))
8011 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8012 call transpose2(EUg(1,1,k),auxmat(1,1))
8013 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8014 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8018 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8019 & EAEAderx(1,1,lll,kkk,iii,1))
8023 C A2T kernel(i+1)T A1
8024 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8025 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8026 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8027 C Following matrices are needed only for 6-th order cumulants
8028 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8029 & j.eq.i+4 .and. l.eq.i+3)) THEN
8030 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8031 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8032 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8033 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8034 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8035 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8036 & ADtEAderx(1,1,1,1,1,2))
8037 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8038 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8039 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8040 & ADtEA1derx(1,1,1,1,1,2))
8042 C End 6-th order cumulants
8043 call transpose2(EUgder(1,1,j),auxmat(1,1))
8044 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8045 call transpose2(EUg(1,1,j),auxmat(1,1))
8046 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8047 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8051 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8052 & EAEAderx(1,1,lll,kkk,iii,2))
8057 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8058 C They are needed only when the fifth- or the sixth-order cumulants are
8060 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8061 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8062 call transpose2(AEA(1,1,1),auxmat(1,1))
8063 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8064 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8065 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8066 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8067 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8068 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8069 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8070 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8071 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8072 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8073 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8074 call transpose2(AEA(1,1,2),auxmat(1,1))
8075 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8076 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8077 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8078 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8079 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8080 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8081 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8082 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8083 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8084 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8085 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8086 C Calculate the Cartesian derivatives of the vectors.
8090 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8091 call matvec2(auxmat(1,1),b1(1,iti),
8092 & AEAb1derx(1,lll,kkk,iii,1,1))
8093 call matvec2(auxmat(1,1),Ub2(1,i),
8094 & AEAb2derx(1,lll,kkk,iii,1,1))
8095 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8096 & AEAb1derx(1,lll,kkk,iii,2,1))
8097 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8098 & AEAb2derx(1,lll,kkk,iii,2,1))
8099 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8100 call matvec2(auxmat(1,1),b1(1,itl),
8101 & AEAb1derx(1,lll,kkk,iii,1,2))
8102 call matvec2(auxmat(1,1),Ub2(1,l),
8103 & AEAb2derx(1,lll,kkk,iii,1,2))
8104 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8105 & AEAb1derx(1,lll,kkk,iii,2,2))
8106 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8107 & AEAb2derx(1,lll,kkk,iii,2,2))
8116 C---------------------------------------------------------------------------
8117 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8118 & KK,KKderg,AKA,AKAderg,AKAderx)
8122 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8123 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8124 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8129 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8131 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8134 cd if (lprn) write (2,*) 'In kernel'
8136 cd if (lprn) write (2,*) 'kkk=',kkk
8138 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8139 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8141 cd write (2,*) 'lll=',lll
8142 cd write (2,*) 'iii=1'
8144 cd write (2,'(3(2f10.5),5x)')
8145 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8148 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8149 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8151 cd write (2,*) 'lll=',lll
8152 cd write (2,*) 'iii=2'
8154 cd write (2,'(3(2f10.5),5x)')
8155 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8162 C---------------------------------------------------------------------------
8163 double precision function eello4(i,j,k,l,jj,kk)
8164 implicit real*8 (a-h,o-z)
8165 include 'DIMENSIONS'
8166 include 'COMMON.IOUNITS'
8167 include 'COMMON.CHAIN'
8168 include 'COMMON.DERIV'
8169 include 'COMMON.INTERACT'
8170 include 'COMMON.CONTACTS'
8171 include 'COMMON.TORSION'
8172 include 'COMMON.VAR'
8173 include 'COMMON.GEO'
8174 double precision pizda(2,2),ggg1(3),ggg2(3)
8175 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8179 cd print *,'eello4:',i,j,k,l,jj,kk
8180 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8181 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8182 cold eij=facont_hb(jj,i)
8183 cold ekl=facont_hb(kk,k)
8185 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8186 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8187 gcorr_loc(k-1)=gcorr_loc(k-1)
8188 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8190 gcorr_loc(l-1)=gcorr_loc(l-1)
8191 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8193 gcorr_loc(j-1)=gcorr_loc(j-1)
8194 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8199 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8200 & -EAEAderx(2,2,lll,kkk,iii,1)
8201 cd derx(lll,kkk,iii)=0.0d0
8205 cd gcorr_loc(l-1)=0.0d0
8206 cd gcorr_loc(j-1)=0.0d0
8207 cd gcorr_loc(k-1)=0.0d0
8209 cd write (iout,*)'Contacts have occurred for peptide groups',
8210 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8211 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8212 if (j.lt.nres-1) then
8219 if (l.lt.nres-1) then
8227 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8228 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8229 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8230 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8231 cgrad ghalf=0.5d0*ggg1(ll)
8232 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8233 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8234 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8235 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8236 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8237 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8238 cgrad ghalf=0.5d0*ggg2(ll)
8239 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8240 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8241 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8242 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8243 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8244 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8248 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8253 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8258 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8263 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8267 cd write (2,*) iii,gcorr_loc(iii)
8270 cd write (2,*) 'ekont',ekont
8271 cd write (iout,*) 'eello4',ekont*eel4
8274 C---------------------------------------------------------------------------
8275 double precision function eello5(i,j,k,l,jj,kk)
8276 implicit real*8 (a-h,o-z)
8277 include 'DIMENSIONS'
8278 include 'COMMON.IOUNITS'
8279 include 'COMMON.CHAIN'
8280 include 'COMMON.DERIV'
8281 include 'COMMON.INTERACT'
8282 include 'COMMON.CONTACTS'
8283 include 'COMMON.TORSION'
8284 include 'COMMON.VAR'
8285 include 'COMMON.GEO'
8286 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8287 double precision ggg1(3),ggg2(3)
8288 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8293 C /l\ / \ \ / \ / \ / C
8294 C / \ / \ \ / \ / \ / C
8295 C j| o |l1 | o | o| o | | o |o C
8296 C \ |/k\| |/ \| / |/ \| |/ \| C
8297 C \i/ \ / \ / / \ / \ C
8299 C (I) (II) (III) (IV) C
8301 C eello5_1 eello5_2 eello5_3 eello5_4 C
8303 C Antiparallel chains C
8306 C /j\ / \ \ / \ / \ / C
8307 C / \ / \ \ / \ / \ / C
8308 C j1| o |l | o | o| o | | o |o C
8309 C \ |/k\| |/ \| / |/ \| |/ \| C
8310 C \i/ \ / \ / / \ / \ C
8312 C (I) (II) (III) (IV) C
8314 C eello5_1 eello5_2 eello5_3 eello5_4 C
8316 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8318 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8319 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8324 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8326 itk=itortyp(itype(k))
8327 itl=itortyp(itype(l))
8328 itj=itortyp(itype(j))
8333 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8334 cd & eel5_3_num,eel5_4_num)
8338 derx(lll,kkk,iii)=0.0d0
8342 cd eij=facont_hb(jj,i)
8343 cd ekl=facont_hb(kk,k)
8345 cd write (iout,*)'Contacts have occurred for peptide groups',
8346 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8348 C Contribution from the graph I.
8349 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8350 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8351 call transpose2(EUg(1,1,k),auxmat(1,1))
8352 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8353 vv(1)=pizda(1,1)-pizda(2,2)
8354 vv(2)=pizda(1,2)+pizda(2,1)
8355 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8356 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8357 C Explicit gradient in virtual-dihedral angles.
8358 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8359 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8360 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8361 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8362 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8363 vv(1)=pizda(1,1)-pizda(2,2)
8364 vv(2)=pizda(1,2)+pizda(2,1)
8365 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8366 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8367 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8368 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8369 vv(1)=pizda(1,1)-pizda(2,2)
8370 vv(2)=pizda(1,2)+pizda(2,1)
8372 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8373 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8374 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8376 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8377 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8378 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8380 C Cartesian gradient
8384 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8386 vv(1)=pizda(1,1)-pizda(2,2)
8387 vv(2)=pizda(1,2)+pizda(2,1)
8388 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8389 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8390 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8396 C Contribution from graph II
8397 call transpose2(EE(1,1,itk),auxmat(1,1))
8398 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8399 vv(1)=pizda(1,1)+pizda(2,2)
8400 vv(2)=pizda(2,1)-pizda(1,2)
8401 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8402 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8403 C Explicit gradient in virtual-dihedral angles.
8404 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8405 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8406 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8407 vv(1)=pizda(1,1)+pizda(2,2)
8408 vv(2)=pizda(2,1)-pizda(1,2)
8410 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8411 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8412 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8414 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8415 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8416 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8418 C Cartesian gradient
8422 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8424 vv(1)=pizda(1,1)+pizda(2,2)
8425 vv(2)=pizda(2,1)-pizda(1,2)
8426 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8427 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8428 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8436 C Parallel orientation
8437 C Contribution from graph III
8438 call transpose2(EUg(1,1,l),auxmat(1,1))
8439 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8440 vv(1)=pizda(1,1)-pizda(2,2)
8441 vv(2)=pizda(1,2)+pizda(2,1)
8442 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8443 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8444 C Explicit gradient in virtual-dihedral angles.
8445 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8446 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8447 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8448 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8449 vv(1)=pizda(1,1)-pizda(2,2)
8450 vv(2)=pizda(1,2)+pizda(2,1)
8451 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8452 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8453 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8454 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8455 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8456 vv(1)=pizda(1,1)-pizda(2,2)
8457 vv(2)=pizda(1,2)+pizda(2,1)
8458 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8459 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8460 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8461 C Cartesian gradient
8465 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8467 vv(1)=pizda(1,1)-pizda(2,2)
8468 vv(2)=pizda(1,2)+pizda(2,1)
8469 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8470 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8471 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8476 C Contribution from graph IV
8478 call transpose2(EE(1,1,itl),auxmat(1,1))
8479 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8480 vv(1)=pizda(1,1)+pizda(2,2)
8481 vv(2)=pizda(2,1)-pizda(1,2)
8482 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8483 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8484 C Explicit gradient in virtual-dihedral angles.
8485 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8486 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8487 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8488 vv(1)=pizda(1,1)+pizda(2,2)
8489 vv(2)=pizda(2,1)-pizda(1,2)
8490 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8491 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8492 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8493 C Cartesian gradient
8497 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8499 vv(1)=pizda(1,1)+pizda(2,2)
8500 vv(2)=pizda(2,1)-pizda(1,2)
8501 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8502 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8503 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8508 C Antiparallel orientation
8509 C Contribution from graph III
8511 call transpose2(EUg(1,1,j),auxmat(1,1))
8512 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8513 vv(1)=pizda(1,1)-pizda(2,2)
8514 vv(2)=pizda(1,2)+pizda(2,1)
8515 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8516 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8517 C Explicit gradient in virtual-dihedral angles.
8518 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8519 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8520 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8521 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8522 vv(1)=pizda(1,1)-pizda(2,2)
8523 vv(2)=pizda(1,2)+pizda(2,1)
8524 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8525 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8526 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8527 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8528 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8529 vv(1)=pizda(1,1)-pizda(2,2)
8530 vv(2)=pizda(1,2)+pizda(2,1)
8531 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8532 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8533 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8534 C Cartesian gradient
8538 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8540 vv(1)=pizda(1,1)-pizda(2,2)
8541 vv(2)=pizda(1,2)+pizda(2,1)
8542 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8543 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8544 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8549 C Contribution from graph IV
8551 call transpose2(EE(1,1,itj),auxmat(1,1))
8552 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8553 vv(1)=pizda(1,1)+pizda(2,2)
8554 vv(2)=pizda(2,1)-pizda(1,2)
8555 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8556 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8557 C Explicit gradient in virtual-dihedral angles.
8558 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8559 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8560 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8561 vv(1)=pizda(1,1)+pizda(2,2)
8562 vv(2)=pizda(2,1)-pizda(1,2)
8563 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8564 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8565 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8566 C Cartesian gradient
8570 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8572 vv(1)=pizda(1,1)+pizda(2,2)
8573 vv(2)=pizda(2,1)-pizda(1,2)
8574 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8575 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8576 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8582 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8583 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8584 cd write (2,*) 'ijkl',i,j,k,l
8585 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8586 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8588 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8589 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8590 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8591 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8592 if (j.lt.nres-1) then
8599 if (l.lt.nres-1) then
8609 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8610 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8611 C summed up outside the subrouine as for the other subroutines
8612 C handling long-range interactions. The old code is commented out
8613 C with "cgrad" to keep track of changes.
8615 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8616 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8617 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8618 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8619 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8620 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8621 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8622 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8623 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8624 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8626 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8627 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8628 cgrad ghalf=0.5d0*ggg1(ll)
8630 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8631 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8632 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8633 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8634 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8635 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8636 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8637 cgrad ghalf=0.5d0*ggg2(ll)
8639 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8640 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8641 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8642 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8643 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8644 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8649 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8650 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8655 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8656 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8662 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8667 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8671 cd write (2,*) iii,g_corr5_loc(iii)
8674 cd write (2,*) 'ekont',ekont
8675 cd write (iout,*) 'eello5',ekont*eel5
8678 c--------------------------------------------------------------------------
8679 double precision function eello6(i,j,k,l,jj,kk)
8680 implicit real*8 (a-h,o-z)
8681 include 'DIMENSIONS'
8682 include 'COMMON.IOUNITS'
8683 include 'COMMON.CHAIN'
8684 include 'COMMON.DERIV'
8685 include 'COMMON.INTERACT'
8686 include 'COMMON.CONTACTS'
8687 include 'COMMON.TORSION'
8688 include 'COMMON.VAR'
8689 include 'COMMON.GEO'
8690 include 'COMMON.FFIELD'
8691 double precision ggg1(3),ggg2(3)
8692 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8697 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8705 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8706 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8710 derx(lll,kkk,iii)=0.0d0
8714 cd eij=facont_hb(jj,i)
8715 cd ekl=facont_hb(kk,k)
8721 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8722 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8723 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8724 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8725 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8726 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8728 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8729 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8730 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8731 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8732 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8733 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8737 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8739 C If turn contributions are considered, they will be handled separately.
8740 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8741 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8742 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8743 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8744 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8745 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8746 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8748 if (j.lt.nres-1) then
8755 if (l.lt.nres-1) then
8763 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8764 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8765 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8766 cgrad ghalf=0.5d0*ggg1(ll)
8768 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8769 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8770 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8771 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8772 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8773 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8774 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8775 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8776 cgrad ghalf=0.5d0*ggg2(ll)
8777 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8779 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8780 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8781 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8782 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8783 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8784 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8789 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8790 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8795 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8796 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8802 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8807 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8811 cd write (2,*) iii,g_corr6_loc(iii)
8814 cd write (2,*) 'ekont',ekont
8815 cd write (iout,*) 'eello6',ekont*eel6
8818 c--------------------------------------------------------------------------
8819 double precision function eello6_graph1(i,j,k,l,imat,swap)
8820 implicit real*8 (a-h,o-z)
8821 include 'DIMENSIONS'
8822 include 'COMMON.IOUNITS'
8823 include 'COMMON.CHAIN'
8824 include 'COMMON.DERIV'
8825 include 'COMMON.INTERACT'
8826 include 'COMMON.CONTACTS'
8827 include 'COMMON.TORSION'
8828 include 'COMMON.VAR'
8829 include 'COMMON.GEO'
8830 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8834 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8836 C Parallel Antiparallel
8842 C \ j|/k\| / \ |/k\|l /
8847 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8848 itk=itortyp(itype(k))
8849 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8850 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8851 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8852 call transpose2(EUgC(1,1,k),auxmat(1,1))
8853 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8854 vv1(1)=pizda1(1,1)-pizda1(2,2)
8855 vv1(2)=pizda1(1,2)+pizda1(2,1)
8856 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8857 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8858 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8859 s5=scalar2(vv(1),Dtobr2(1,i))
8860 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8861 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8862 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8863 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8864 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8865 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8866 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8867 & +scalar2(vv(1),Dtobr2der(1,i)))
8868 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8869 vv1(1)=pizda1(1,1)-pizda1(2,2)
8870 vv1(2)=pizda1(1,2)+pizda1(2,1)
8871 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8872 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8874 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8875 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8876 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8877 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8878 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8880 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8881 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8882 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8883 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8884 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8886 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8887 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8888 vv1(1)=pizda1(1,1)-pizda1(2,2)
8889 vv1(2)=pizda1(1,2)+pizda1(2,1)
8890 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8891 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8892 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8893 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8902 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8903 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8904 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8905 call transpose2(EUgC(1,1,k),auxmat(1,1))
8906 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8908 vv1(1)=pizda1(1,1)-pizda1(2,2)
8909 vv1(2)=pizda1(1,2)+pizda1(2,1)
8910 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8911 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8912 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8913 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8914 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8915 s5=scalar2(vv(1),Dtobr2(1,i))
8916 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8922 c----------------------------------------------------------------------------
8923 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8924 implicit real*8 (a-h,o-z)
8925 include 'DIMENSIONS'
8926 include 'COMMON.IOUNITS'
8927 include 'COMMON.CHAIN'
8928 include 'COMMON.DERIV'
8929 include 'COMMON.INTERACT'
8930 include 'COMMON.CONTACTS'
8931 include 'COMMON.TORSION'
8932 include 'COMMON.VAR'
8933 include 'COMMON.GEO'
8935 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8936 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8939 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8941 C Parallel Antiparallel C
8947 C \ j|/k\| \ |/k\|l C
8952 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8953 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8954 C AL 7/4/01 s1 would occur in the sixth-order moment,
8955 C but not in a cluster cumulant
8957 s1=dip(1,jj,i)*dip(1,kk,k)
8959 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8960 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8961 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8962 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8963 call transpose2(EUg(1,1,k),auxmat(1,1))
8964 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8965 vv(1)=pizda(1,1)-pizda(2,2)
8966 vv(2)=pizda(1,2)+pizda(2,1)
8967 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8968 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8970 eello6_graph2=-(s1+s2+s3+s4)
8972 eello6_graph2=-(s2+s3+s4)
8975 C Derivatives in gamma(i-1)
8978 s1=dipderg(1,jj,i)*dip(1,kk,k)
8980 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8981 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8982 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8983 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8985 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8987 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8989 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8991 C Derivatives in gamma(k-1)
8993 s1=dip(1,jj,i)*dipderg(1,kk,k)
8995 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8996 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8997 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8998 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8999 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9000 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9001 vv(1)=pizda(1,1)-pizda(2,2)
9002 vv(2)=pizda(1,2)+pizda(2,1)
9003 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9005 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9007 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9009 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9010 C Derivatives in gamma(j-1) or gamma(l-1)
9013 s1=dipderg(3,jj,i)*dip(1,kk,k)
9015 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9016 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9017 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9018 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9019 vv(1)=pizda(1,1)-pizda(2,2)
9020 vv(2)=pizda(1,2)+pizda(2,1)
9021 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9024 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9026 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9029 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9030 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9032 C Derivatives in gamma(l-1) or gamma(j-1)
9035 s1=dip(1,jj,i)*dipderg(3,kk,k)
9037 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9038 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9039 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9040 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9041 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9042 vv(1)=pizda(1,1)-pizda(2,2)
9043 vv(2)=pizda(1,2)+pizda(2,1)
9044 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9047 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9049 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9052 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9053 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9055 C Cartesian derivatives.
9057 write (2,*) 'In eello6_graph2'
9059 write (2,*) 'iii=',iii
9061 write (2,*) 'kkk=',kkk
9063 write (2,'(3(2f10.5),5x)')
9064 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9074 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9076 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9079 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9081 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9082 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9084 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9085 call transpose2(EUg(1,1,k),auxmat(1,1))
9086 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9088 vv(1)=pizda(1,1)-pizda(2,2)
9089 vv(2)=pizda(1,2)+pizda(2,1)
9090 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9091 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9093 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9095 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9098 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9100 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9107 c----------------------------------------------------------------------------
9108 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9109 implicit real*8 (a-h,o-z)
9110 include 'DIMENSIONS'
9111 include 'COMMON.IOUNITS'
9112 include 'COMMON.CHAIN'
9113 include 'COMMON.DERIV'
9114 include 'COMMON.INTERACT'
9115 include 'COMMON.CONTACTS'
9116 include 'COMMON.TORSION'
9117 include 'COMMON.VAR'
9118 include 'COMMON.GEO'
9119 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9121 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9123 C Parallel Antiparallel C
9129 C j|/k\| / |/k\|l / C
9134 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9136 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9137 C energy moment and not to the cluster cumulant.
9138 iti=itortyp(itype(i))
9139 if (j.lt.nres-1) then
9140 itj1=itortyp(itype(j+1))
9144 itk=itortyp(itype(k))
9145 itk1=itortyp(itype(k+1))
9146 if (l.lt.nres-1) then
9147 itl1=itortyp(itype(l+1))
9152 s1=dip(4,jj,i)*dip(4,kk,k)
9154 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9155 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9156 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9157 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9158 call transpose2(EE(1,1,itk),auxmat(1,1))
9159 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9160 vv(1)=pizda(1,1)+pizda(2,2)
9161 vv(2)=pizda(2,1)-pizda(1,2)
9162 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9163 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9164 cd & "sum",-(s2+s3+s4)
9166 eello6_graph3=-(s1+s2+s3+s4)
9168 eello6_graph3=-(s2+s3+s4)
9171 C Derivatives in gamma(k-1)
9172 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9173 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9174 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9175 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9176 C Derivatives in gamma(l-1)
9177 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9178 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9179 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9180 vv(1)=pizda(1,1)+pizda(2,2)
9181 vv(2)=pizda(2,1)-pizda(1,2)
9182 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9183 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9184 C Cartesian derivatives.
9190 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9192 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9195 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9197 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9198 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9200 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9201 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,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))
9207 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9209 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9212 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9214 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9216 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9222 c----------------------------------------------------------------------------
9223 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9224 implicit real*8 (a-h,o-z)
9225 include 'DIMENSIONS'
9226 include 'COMMON.IOUNITS'
9227 include 'COMMON.CHAIN'
9228 include 'COMMON.DERIV'
9229 include 'COMMON.INTERACT'
9230 include 'COMMON.CONTACTS'
9231 include 'COMMON.TORSION'
9232 include 'COMMON.VAR'
9233 include 'COMMON.GEO'
9234 include 'COMMON.FFIELD'
9235 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9236 & auxvec1(2),auxmat1(2,2)
9238 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9240 C Parallel Antiparallel C
9246 C \ j|/k\| \ |/k\|l C
9251 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9253 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9254 C energy moment and not to the cluster cumulant.
9255 cd write (2,*) 'eello_graph4: wturn6',wturn6
9256 iti=itortyp(itype(i))
9257 itj=itortyp(itype(j))
9258 if (j.lt.nres-1) then
9259 itj1=itortyp(itype(j+1))
9263 itk=itortyp(itype(k))
9264 if (k.lt.nres-1) then
9265 itk1=itortyp(itype(k+1))
9269 itl=itortyp(itype(l))
9270 if (l.lt.nres-1) then
9271 itl1=itortyp(itype(l+1))
9275 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9276 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9277 cd & ' itl',itl,' itl1',itl1
9280 s1=dip(3,jj,i)*dip(3,kk,k)
9282 s1=dip(2,jj,j)*dip(2,kk,l)
9285 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9286 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9288 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9289 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9291 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9292 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9294 call transpose2(EUg(1,1,k),auxmat(1,1))
9295 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9296 vv(1)=pizda(1,1)-pizda(2,2)
9297 vv(2)=pizda(2,1)+pizda(1,2)
9298 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9299 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9301 eello6_graph4=-(s1+s2+s3+s4)
9303 eello6_graph4=-(s2+s3+s4)
9305 C Derivatives in gamma(i-1)
9309 s1=dipderg(2,jj,i)*dip(3,kk,k)
9311 s1=dipderg(4,jj,j)*dip(2,kk,l)
9314 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9316 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9317 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9319 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9320 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9322 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9323 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9324 cd write (2,*) 'turn6 derivatives'
9326 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9328 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9332 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9334 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9338 C Derivatives in gamma(k-1)
9341 s1=dip(3,jj,i)*dipderg(2,kk,k)
9343 s1=dip(2,jj,j)*dipderg(4,kk,l)
9346 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9347 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9349 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9350 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9352 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9353 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9355 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9356 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9357 vv(1)=pizda(1,1)-pizda(2,2)
9358 vv(2)=pizda(2,1)+pizda(1,2)
9359 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9360 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9362 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9364 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9368 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9370 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9373 C Derivatives in gamma(j-1) or gamma(l-1)
9374 if (l.eq.j+1 .and. l.gt.1) then
9375 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9376 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9377 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9378 vv(1)=pizda(1,1)-pizda(2,2)
9379 vv(2)=pizda(2,1)+pizda(1,2)
9380 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9381 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9382 else if (j.gt.1) then
9383 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9384 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9385 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9386 vv(1)=pizda(1,1)-pizda(2,2)
9387 vv(2)=pizda(2,1)+pizda(1,2)
9388 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9389 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9390 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9392 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9395 C Cartesian derivatives.
9402 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9404 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9408 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9410 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9414 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9416 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9418 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9419 & b1(1,itj1),auxvec(1))
9420 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9422 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9423 & b1(1,itl1),auxvec(1))
9424 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9426 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9428 vv(1)=pizda(1,1)-pizda(2,2)
9429 vv(2)=pizda(2,1)+pizda(1,2)
9430 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
9434 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9437 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9440 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9443 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9445 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9447 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9451 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9453 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9456 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9458 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9466 c----------------------------------------------------------------------------
9467 double precision function eello_turn6(i,jj,kk)
9468 implicit real*8 (a-h,o-z)
9469 include 'DIMENSIONS'
9470 include 'COMMON.IOUNITS'
9471 include 'COMMON.CHAIN'
9472 include 'COMMON.DERIV'
9473 include 'COMMON.INTERACT'
9474 include 'COMMON.CONTACTS'
9475 include 'COMMON.TORSION'
9476 include 'COMMON.VAR'
9477 include 'COMMON.GEO'
9478 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9479 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9481 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9482 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9483 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9484 C the respective energy moment and not to the cluster cumulant.
9493 iti=itortyp(itype(i))
9494 itk=itortyp(itype(k))
9495 itk1=itortyp(itype(k+1))
9496 itl=itortyp(itype(l))
9497 itj=itortyp(itype(j))
9498 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9499 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9500 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9505 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9507 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9511 derx_turn(lll,kkk,iii)=0.0d0
9518 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9520 cd write (2,*) 'eello6_5',eello6_5
9522 call transpose2(AEA(1,1,1),auxmat(1,1))
9523 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9524 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9525 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9527 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9528 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9529 s2 = scalar2(b1(1,itk),vtemp1(1))
9531 call transpose2(AEA(1,1,2),atemp(1,1))
9532 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9533 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9534 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9536 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9537 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9538 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9540 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9541 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9542 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9543 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9544 ss13 = scalar2(b1(1,itk),vtemp4(1))
9545 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9547 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9553 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9554 C Derivatives in gamma(i+2)
9558 call transpose2(AEA(1,1,1),auxmatd(1,1))
9559 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9560 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9561 call transpose2(AEAderg(1,1,2),atempd(1,1))
9562 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9563 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9565 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9566 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9567 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9573 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9574 C Derivatives in gamma(i+3)
9576 call transpose2(AEA(1,1,1),auxmatd(1,1))
9577 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9578 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9579 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9581 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9582 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9583 s2d = scalar2(b1(1,itk),vtemp1d(1))
9585 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9586 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9588 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9590 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9591 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9592 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9600 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9601 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9603 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9604 & -0.5d0*ekont*(s2d+s12d)
9606 C Derivatives in gamma(i+4)
9607 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9608 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9609 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9611 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9612 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9613 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9621 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9623 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9625 C Derivatives in gamma(i+5)
9627 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9628 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9629 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9631 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9632 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9633 s2d = scalar2(b1(1,itk),vtemp1d(1))
9635 call transpose2(AEA(1,1,2),atempd(1,1))
9636 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9637 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9639 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9640 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9642 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9643 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9644 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9652 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9653 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9655 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9656 & -0.5d0*ekont*(s2d+s12d)
9658 C Cartesian derivatives
9663 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9664 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9665 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9667 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9668 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9670 s2d = scalar2(b1(1,itk),vtemp1d(1))
9672 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9673 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9674 s8d = -(atempd(1,1)+atempd(2,2))*
9675 & scalar2(cc(1,1,itl),vtemp2(1))
9677 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9679 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9680 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9687 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9690 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9694 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9695 & - 0.5d0*(s8d+s12d)
9697 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9706 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9708 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9709 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9710 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9711 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9712 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9714 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9715 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9716 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9720 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9721 cd & 16*eel_turn6_num
9723 if (j.lt.nres-1) then
9730 if (l.lt.nres-1) then
9738 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9739 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9740 cgrad ghalf=0.5d0*ggg1(ll)
9742 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9743 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9744 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9745 & +ekont*derx_turn(ll,2,1)
9746 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9747 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9748 & +ekont*derx_turn(ll,4,1)
9749 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9750 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9751 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9752 cgrad ghalf=0.5d0*ggg2(ll)
9754 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9755 & +ekont*derx_turn(ll,2,2)
9756 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9757 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9758 & +ekont*derx_turn(ll,4,2)
9759 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9760 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9761 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9766 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9771 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9777 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9782 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9786 cd write (2,*) iii,g_corr6_loc(iii)
9788 eello_turn6=ekont*eel_turn6
9789 cd write (2,*) 'ekont',ekont
9790 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9794 C-----------------------------------------------------------------------------
9795 double precision function scalar(u,v)
9796 !DIR$ INLINEALWAYS scalar
9798 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9801 double precision u(3),v(3)
9802 cd double precision sc
9810 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9813 crc-------------------------------------------------
9814 SUBROUTINE MATVEC2(A1,V1,V2)
9815 !DIR$ INLINEALWAYS MATVEC2
9817 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9819 implicit real*8 (a-h,o-z)
9820 include 'DIMENSIONS'
9821 DIMENSION A1(2,2),V1(2),V2(2)
9825 c 3 VI=VI+A1(I,K)*V1(K)
9829 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9830 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9835 C---------------------------------------
9836 SUBROUTINE MATMAT2(A1,A2,A3)
9838 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9840 implicit real*8 (a-h,o-z)
9841 include 'DIMENSIONS'
9842 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9843 c DIMENSION AI3(2,2)
9847 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9853 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9854 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9855 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9856 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9864 c-------------------------------------------------------------------------
9865 double precision function scalar2(u,v)
9866 !DIR$ INLINEALWAYS scalar2
9868 double precision u(2),v(2)
9871 scalar2=u(1)*v(1)+u(2)*v(2)
9875 C-----------------------------------------------------------------------------
9877 subroutine transpose2(a,at)
9878 !DIR$ INLINEALWAYS transpose2
9880 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9883 double precision a(2,2),at(2,2)
9890 c--------------------------------------------------------------------------
9891 subroutine transpose(n,a,at)
9894 double precision a(n,n),at(n,n)
9902 C---------------------------------------------------------------------------
9903 subroutine prodmat3(a1,a2,kk,transp,prod)
9904 !DIR$ INLINEALWAYS prodmat3
9906 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9910 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9912 crc double precision auxmat(2,2),prod_(2,2)
9915 crc call transpose2(kk(1,1),auxmat(1,1))
9916 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9917 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9919 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9920 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9921 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9922 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9923 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9924 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9925 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9926 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9929 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9930 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9932 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9933 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9934 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9935 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9936 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9937 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9938 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9939 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9942 c call transpose2(a2(1,1),a2t(1,1))
9945 crc print *,((prod_(i,j),i=1,2),j=1,2)
9946 crc print *,((prod(i,j),i=1,2),j=1,2)