1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
37 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
38 if (fg_rank.eq.0) then
39 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
40 c print *,"Processor",myrank," BROADCAST iorder"
41 C FG master sets up the WEIGHTS_ array which will be broadcast to the
42 C FG slaves as WEIGHTS array.
63 C FG Master broadcasts the WEIGHTS_ array
64 call MPI_Bcast(weights_(1),n_ene,
65 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
67 C FG slaves receive the WEIGHTS array
68 call MPI_Bcast(weights(1),n_ene,
69 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
91 time_Bcast=time_Bcast+MPI_Wtime()-time00
92 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
93 c call chainbuild_cart
95 c write(iout,*) 'Processor',myrank,' calling etotal ipot=',ipot
96 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
98 c if (modecalc.eq.12.or.modecalc.eq.14) then
99 c call int_from_cart1(.false.)
116 C Compute the side-chain and electrostatic interaction energy
118 goto (101,102,103,104,105,106) ipot
119 C Lennard-Jones potential.
120 101 call elj(evdw,evdw_p,evdw_m)
121 cd print '(a)','Exit ELJ'
123 C Lennard-Jones-Kihara potential (shifted).
124 102 call eljk(evdw,evdw_p,evdw_m)
126 C Berne-Pechukas potential (dilated LJ, angular dependence).
127 103 call ebp(evdw,evdw_p,evdw_m)
129 C Gay-Berne potential (shifted LJ, angular dependence).
130 104 call egb(evdw,evdw_p,evdw_m)
132 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
133 105 call egbv(evdw,evdw_p,evdw_m)
135 C Soft-sphere potential
136 106 call e_softsphere(evdw)
138 C Calculate electrostatic (H-bonding) energy of the main chain.
142 C BARTEK for dfa test!
143 if (wdfa_dist.gt.0) then
148 c print*, 'edfad is finished!', edfadis
149 if (wdfa_tor.gt.0) then
154 c print*, 'edfat is finished!', edfator
155 if (wdfa_nei.gt.0) then
160 c print*, 'edfan is finished!', edfanei
161 if (wdfa_beta.gt.0) then
167 c print*, 'edfab is finished!', edfabet
169 cmc Sep-06: egb takes care of dynamic ss bonds too
171 c if (dyn_ss) call dyn_set_nss
173 c print *,"Processor",myrank," computed USCSC"
184 time_vec=time_vec+MPI_Wtime()-time01
186 time_vec=time_vec+tcpu()-time01
189 c print *,"Processor",myrank," left VEC_AND_DERIV"
192 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
193 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
194 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
195 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
197 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
198 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
199 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
200 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
202 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
211 c write (iout,*) "Soft-spheer ELEC potential"
212 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
215 c print *,"Processor",myrank," computed UELEC"
217 C Calculate excluded-volume interaction energy between peptide groups
222 call escp(evdw2,evdw2_14)
228 c write (iout,*) "Soft-sphere SCP potential"
229 call escp_soft_sphere(evdw2,evdw2_14)
232 c Calculate the bond-stretching energy
236 C Calculate the disulfide-bridge and other energy and the contributions
237 C from other distance constraints.
238 cd print *,'Calling EHPB'
240 cd print *,'EHPB exitted succesfully.'
242 C Calculate the virtual-bond-angle energy.
244 if (wang.gt.0d0) then
249 c print *,"Processor",myrank," computed UB"
251 C Calculate the SC local energy.
254 c print *,"Processor",myrank," computed USC"
256 C Calculate the virtual-bond torsional energy.
258 cd print *,'nterm=',nterm
260 call etor(etors,edihcnstr)
266 if (constr_homology.ge.1.and.waga_homology(iset).ne.0d0) then
267 call e_modeller(ehomology_constr)
268 c print *,'iset=',iset,'me=',me,ehomology_constr,
269 c & 'Processor',fg_rank,' CG group',kolor,
270 c & ' absolute rank',MyRank
272 ehomology_constr=0.0d0
276 c write(iout,*) ehomology_constr
277 c print *,"Processor",myrank," computed Utor"
279 C 6/23/01 Calculate double-torsional energy
281 if (wtor_d.gt.0) then
286 c print *,"Processor",myrank," computed Utord"
288 C 21/5/07 Calculate local sicdechain correlation energy
290 if (wsccor.gt.0.0d0) then
291 call eback_sc_corr(esccor)
295 c print *,"Processor",myrank," computed Usccorr"
297 C 12/1/95 Multi-body terms
301 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
302 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
303 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
304 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
305 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
312 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
313 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
314 cd write (iout,*) "multibody_hb ecorr",ecorr
316 c print *,"Processor",myrank," computed Ucorr"
318 C If performing constraint dynamics, call the constraint energy
319 C after the equilibration time
320 if(usampl.and.totT.gt.eq_time) then
321 c write (iout,*) "CALL TO ECONSTR_BACK"
330 time_enecalc=time_enecalc+MPI_Wtime()-time00
332 time_enecalc=time_enecalc+tcpu()-time00
335 c print *,"Processor",myrank," computed Uconstr"
348 energia(2)=evdw2-evdw2_14
365 energia(8)=eello_turn3
366 energia(9)=eello_turn4
373 energia(19)=edihcnstr
375 energia(20)=Uconst+Uconst_back
379 energia(24)=ehomology_constr
384 c print *," Processor",myrank," calls SUM_ENERGY"
385 call sum_energy(energia,.true.)
386 if (dyn_ss) call dyn_set_nss
387 c print *," Processor",myrank," left SUM_ENERGY"
390 time_sumene=time_sumene+MPI_Wtime()-time00
392 time_sumene=time_sumene+tcpu()-time00
397 c-------------------------------------------------------------------------------
398 subroutine sum_energy(energia,reduce)
399 implicit real*8 (a-h,o-z)
404 cMS$ATTRIBUTES C :: proc_proc
410 include 'COMMON.SETUP'
411 include 'COMMON.IOUNITS'
412 double precision energia(0:n_ene),enebuff(0:n_ene+1)
413 include 'COMMON.FFIELD'
414 include 'COMMON.DERIV'
415 include 'COMMON.INTERACT'
416 include 'COMMON.SBRIDGE'
417 include 'COMMON.CHAIN'
419 include 'COMMON.CONTROL'
420 include 'COMMON.TIME1'
423 if (nfgtasks.gt.1 .and. reduce) then
425 write (iout,*) "energies before REDUCE"
426 call enerprint(energia)
430 enebuff(i)=energia(i)
433 call MPI_Barrier(FG_COMM,IERR)
434 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
436 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
437 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
439 write (iout,*) "energies after REDUCE"
440 call enerprint(energia)
443 time_Reduce=time_Reduce+MPI_Wtime()-time00
445 if (fg_rank.eq.0) then
448 evdw=energia(22)+wsct*energia(23)
453 evdw2=energia(2)+energia(18)
469 eello_turn3=energia(8)
470 eello_turn4=energia(9)
477 edihcnstr=energia(19)
481 ehomology_constr=energia(24)
487 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
488 & +wang*ebe+wtor*etors+wscloc*escloc
489 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
490 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
491 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
492 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
493 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
496 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
497 & +wang*ebe+wtor*etors+wscloc*escloc
498 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
499 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
500 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
501 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
502 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
509 if (isnan(etot).ne.0) energia(0)=1.0d+99
511 if (isnan(etot)) energia(0)=1.0d+99
516 idumm=proc_proc(etot,i)
518 call proc_proc(etot,i)
520 if(i.eq.1)energia(0)=1.0d+99
527 c-------------------------------------------------------------------------------
528 subroutine sum_gradient
529 implicit real*8 (a-h,o-z)
534 cMS$ATTRIBUTES C :: proc_proc
540 double precision gradbufc(3,maxres),gradbufx(3,maxres),
541 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
542 include 'COMMON.SETUP'
543 include 'COMMON.IOUNITS'
544 include 'COMMON.FFIELD'
545 include 'COMMON.DERIV'
546 include 'COMMON.INTERACT'
547 include 'COMMON.SBRIDGE'
548 include 'COMMON.CHAIN'
550 include 'COMMON.CONTROL'
551 include 'COMMON.TIME1'
552 include 'COMMON.MAXGRAD'
553 include 'COMMON.SCCOR'
563 write (iout,*) "sum_gradient gvdwc, gvdwx"
565 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
566 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
567 & (gvdwcT(j,i),j=1,3)
572 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
573 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
574 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
577 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
578 C in virtual-bond-vector coordinates
581 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
583 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
584 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
586 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
588 c write (iout,'(i5,3f10.5,2x,f10.5)')
589 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
591 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
593 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
594 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
603 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
604 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
605 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
606 & wel_loc*gel_loc_long(j,i)+
607 & wcorr*gradcorr_long(j,i)+
608 & wcorr5*gradcorr5_long(j,i)+
609 & wcorr6*gradcorr6_long(j,i)+
610 & wturn6*gcorr6_turn_long(j,i)+
611 & wstrain*ghpbc(j,i)+
612 & wdfa_dist*gdfad(j,i)+
613 & wdfa_tor*gdfat(j,i)+
614 & wdfa_nei*gdfan(j,i)+
615 & wdfa_beta*gdfab(j,i)
621 gradbufc(j,i)=wsc*gvdwc(j,i)+
622 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
623 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
624 & wel_loc*gel_loc_long(j,i)+
625 & wcorr*gradcorr_long(j,i)+
626 & wcorr5*gradcorr5_long(j,i)+
627 & wcorr6*gradcorr6_long(j,i)+
628 & wturn6*gcorr6_turn_long(j,i)+
629 & wstrain*ghpbc(j,i)+
630 & wdfa_dist*gdfad(j,i)+
631 & wdfa_tor*gdfat(j,i)+
632 & wdfa_nei*gdfan(j,i)+
633 & wdfa_beta*gdfab(j,i)
640 gradbufc(j,i)=wsc*gvdwc(j,i)+
641 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
642 & welec*gelc_long(j,i)+
644 & wel_loc*gel_loc_long(j,i)+
645 & wcorr*gradcorr_long(j,i)+
646 & wcorr5*gradcorr5_long(j,i)+
647 & wcorr6*gradcorr6_long(j,i)+
648 & wturn6*gcorr6_turn_long(j,i)+
649 & wstrain*ghpbc(j,i)+
650 & wdfa_dist*gdfad(j,i)+
651 & wdfa_tor*gdfat(j,i)+
652 & wdfa_nei*gdfan(j,i)+
653 & wdfa_beta*gdfab(j,i)
658 if (nfgtasks.gt.1) then
661 write (iout,*) "gradbufc before allreduce"
663 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
669 gradbufc_sum(j,i)=gradbufc(j,i)
672 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
673 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
674 c time_reduce=time_reduce+MPI_Wtime()-time00
676 c write (iout,*) "gradbufc_sum after allreduce"
678 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
683 c time_allreduce=time_allreduce+MPI_Wtime()-time00
691 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
692 write (iout,*) (i," jgrad_start",jgrad_start(i),
693 & " jgrad_end ",jgrad_end(i),
694 & i=igrad_start,igrad_end)
697 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
698 c do not parallelize this part.
700 c do i=igrad_start,igrad_end
701 c do j=jgrad_start(i),jgrad_end(i)
703 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
708 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
712 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
716 write (iout,*) "gradbufc after summing"
718 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
725 write (iout,*) "gradbufc"
727 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
733 gradbufc_sum(j,i)=gradbufc(j,i)
738 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
742 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
747 c gradbufc(k,i)=0.0d0
751 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
756 write (iout,*) "gradbufc after summing"
758 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
766 gradbufc(k,nres)=0.0d0
771 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
772 & wel_loc*gel_loc(j,i)+
773 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
774 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
775 & wel_loc*gel_loc_long(j,i)+
776 & wcorr*gradcorr_long(j,i)+
777 & wcorr5*gradcorr5_long(j,i)+
778 & wcorr6*gradcorr6_long(j,i)+
779 & wturn6*gcorr6_turn_long(j,i))+
781 & wcorr*gradcorr(j,i)+
782 & wturn3*gcorr3_turn(j,i)+
783 & wturn4*gcorr4_turn(j,i)+
784 & wcorr5*gradcorr5(j,i)+
785 & wcorr6*gradcorr6(j,i)+
786 & wturn6*gcorr6_turn(j,i)+
787 & wsccor*gsccorc(j,i)
788 & +wscloc*gscloc(j,i)
790 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
791 & wel_loc*gel_loc(j,i)+
792 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
793 & welec*gelc_long(j,i)+
794 & wel_loc*gel_loc_long(j,i)+
795 & wcorr*gcorr_long(j,i)+
796 & wcorr5*gradcorr5_long(j,i)+
797 & wcorr6*gradcorr6_long(j,i)+
798 & wturn6*gcorr6_turn_long(j,i))+
800 & wcorr*gradcorr(j,i)+
801 & wturn3*gcorr3_turn(j,i)+
802 & wturn4*gcorr4_turn(j,i)+
803 & wcorr5*gradcorr5(j,i)+
804 & wcorr6*gradcorr6(j,i)+
805 & wturn6*gcorr6_turn(j,i)+
806 & wsccor*gsccorc(j,i)
807 & +wscloc*gscloc(j,i)
810 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
811 & wscp*gradx_scp(j,i)+
813 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
814 & wsccor*gsccorx(j,i)
815 & +wscloc*gsclocx(j,i)
817 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
819 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
820 & wsccor*gsccorx(j,i)
821 & +wscloc*gsclocx(j,i)
825 if (constr_homology.gt.0.and.waga_homology(iset).ne.0d0) then
828 gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
829 gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
834 write (iout,*) "gloc before adding corr"
836 write (iout,*) i,gloc(i,icg)
840 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
841 & +wcorr5*g_corr5_loc(i)
842 & +wcorr6*g_corr6_loc(i)
843 & +wturn4*gel_loc_turn4(i)
844 & +wturn3*gel_loc_turn3(i)
845 & +wturn6*gel_loc_turn6(i)
846 & +wel_loc*gel_loc_loc(i)
849 write (iout,*) "gloc after adding corr"
851 write (iout,*) i,gloc(i,icg)
855 if (nfgtasks.gt.1) then
858 gradbufc(j,i)=gradc(j,i,icg)
859 gradbufx(j,i)=gradx(j,i,icg)
863 glocbuf(i)=gloc(i,icg)
866 write (iout,*) "gloc_sc before reduce"
869 write (iout,*) i,j,gloc_sc(j,i,icg)
875 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
879 call MPI_Barrier(FG_COMM,IERR)
880 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
882 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
883 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
884 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
885 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
886 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
887 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
888 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
889 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
890 time_reduce=time_reduce+MPI_Wtime()-time00
892 write (iout,*) "gloc_sc after reduce"
895 write (iout,*) i,j,gloc_sc(j,i,icg)
900 write (iout,*) "gloc after reduce"
902 write (iout,*) i,gloc(i,icg)
907 if (gnorm_check) then
909 c Compute the maximum elements of the gradient
919 gcorr3_turn_max=0.0d0
920 gcorr4_turn_max=0.0d0
923 gcorr6_turn_max=0.0d0
933 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
934 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
936 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
937 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
939 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
940 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
941 & gvdwc_scp_max=gvdwc_scp_norm
942 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
943 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
944 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
945 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
946 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
947 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
948 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
949 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
950 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
951 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
952 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
953 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
954 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
956 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
957 & gcorr3_turn_max=gcorr3_turn_norm
958 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
960 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
961 & gcorr4_turn_max=gcorr4_turn_norm
962 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
963 if (gradcorr5_norm.gt.gradcorr5_max)
964 & gradcorr5_max=gradcorr5_norm
965 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
966 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
967 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
969 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
970 & gcorr6_turn_max=gcorr6_turn_norm
971 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
972 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
973 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
974 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
975 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
976 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
978 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
979 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
981 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
982 if (gradx_scp_norm.gt.gradx_scp_max)
983 & gradx_scp_max=gradx_scp_norm
984 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
985 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
986 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
987 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
988 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
989 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
990 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
991 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
995 open(istat,file=statname,position="append")
997 open(istat,file=statname,access="append")
999 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
1000 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
1001 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
1002 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
1003 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
1004 & gsccorx_max,gsclocx_max
1006 if (gvdwc_max.gt.1.0d4) then
1007 write (iout,*) "gvdwc gvdwx gradb gradbx"
1009 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
1010 & gradb(j,i),gradbx(j,i),j=1,3)
1012 call pdbout(0.0d0,'cipiszcze',iout)
1018 write (iout,*) "gradc gradx gloc"
1020 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1021 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1026 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1028 time_sumgradient=time_sumgradient+tcpu()-time01
1033 c-------------------------------------------------------------------------------
1034 subroutine rescale_weights(t_bath)
1035 implicit real*8 (a-h,o-z)
1036 include 'DIMENSIONS'
1037 include 'COMMON.IOUNITS'
1038 include 'COMMON.FFIELD'
1039 include 'COMMON.SBRIDGE'
1040 double precision kfac /2.4d0/
1041 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1043 c facT=2*temp0/(t_bath+temp0)
1044 if (rescale_mode.eq.0) then
1050 else if (rescale_mode.eq.1) then
1051 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1052 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1053 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1054 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1055 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1056 else if (rescale_mode.eq.2) then
1062 facT=licznik/dlog(dexp(x)+dexp(-x))
1063 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1064 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1065 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1066 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1068 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1069 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1071 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1075 welec=weights(3)*fact
1076 wcorr=weights(4)*fact3
1077 wcorr5=weights(5)*fact4
1078 wcorr6=weights(6)*fact5
1079 wel_loc=weights(7)*fact2
1080 wturn3=weights(8)*fact2
1081 wturn4=weights(9)*fact3
1082 wturn6=weights(10)*fact5
1083 wtor=weights(13)*fact
1084 wtor_d=weights(14)*fact2
1085 wsccor=weights(21)*fact
1088 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1092 C------------------------------------------------------------------------
1093 subroutine enerprint(energia)
1094 implicit real*8 (a-h,o-z)
1095 include 'DIMENSIONS'
1096 include 'COMMON.IOUNITS'
1097 include 'COMMON.FFIELD'
1098 include 'COMMON.SBRIDGE'
1100 double precision energia(0:n_ene)
1103 evdw=energia(22)+wsct*energia(23)
1109 evdw2=energia(2)+energia(18)
1121 eello_turn3=energia(8)
1122 eello_turn4=energia(9)
1123 eello_turn6=energia(10)
1129 edihcnstr=energia(19)
1133 ehomology_constr=energia(24)
1135 edfadis = energia(25)
1136 edfator = energia(26)
1137 edfanei = energia(27)
1138 edfabet = energia(28)
1141 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1142 & estr,wbond,ebe,wang,
1143 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1145 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1146 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1147 & edihcnstr,ehomology_constr, ebr*nss,
1148 & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
1149 & edfabet,wdfa_beta,etot
1150 10 format (/'Virtual-chain energies:'//
1151 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1152 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1153 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1154 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1155 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1156 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1157 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1158 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1159 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1160 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1161 & ' (SS bridges & dist. cnstr.)'/
1162 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1163 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1164 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1165 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1166 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1167 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1168 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1169 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1170 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1171 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1172 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1173 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1174 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
1175 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
1176 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
1177 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
1178 & 'ETOT= ',1pE16.6,' (total)')
1180 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1181 & estr,wbond,ebe,wang,
1182 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1184 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1185 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1186 & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator,
1187 & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta,
1189 10 format (/'Virtual-chain energies:'//
1190 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1191 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1192 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1193 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1194 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1195 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1196 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1197 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1198 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1199 & ' (SS bridges & dist. cnstr.)'/
1200 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1201 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1202 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1203 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1204 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1205 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1206 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1207 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1208 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1209 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1210 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1211 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1212 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
1213 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
1214 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
1215 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
1216 & 'ETOT= ',1pE16.6,' (total)')
1220 C-----------------------------------------------------------------------
1221 subroutine elj(evdw,evdw_p,evdw_m)
1223 C This subroutine calculates the interaction energy of nonbonded side chains
1224 C assuming the LJ potential of interaction.
1226 implicit real*8 (a-h,o-z)
1227 include 'DIMENSIONS'
1228 parameter (accur=1.0d-10)
1229 include 'COMMON.GEO'
1230 include 'COMMON.VAR'
1231 include 'COMMON.LOCAL'
1232 include 'COMMON.CHAIN'
1233 include 'COMMON.DERIV'
1234 include 'COMMON.INTERACT'
1235 include 'COMMON.TORSION'
1236 include 'COMMON.SBRIDGE'
1237 include 'COMMON.NAMES'
1238 include 'COMMON.IOUNITS'
1239 include 'COMMON.CONTACTS'
1241 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1243 do i=iatsc_s,iatsc_e
1252 C Calculate SC interaction energy.
1254 do iint=1,nint_gr(i)
1255 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1256 cd & 'iend=',iend(i,iint)
1257 do j=istart(i,iint),iend(i,iint)
1262 C Change 12/1/95 to calculate four-body interactions
1263 rij=xj*xj+yj*yj+zj*zj
1265 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1266 eps0ij=eps(itypi,itypj)
1268 e1=fac*fac*aa(itypi,itypj)
1269 e2=fac*bb(itypi,itypj)
1271 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1272 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1273 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1274 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1275 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1276 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1278 if (bb(itypi,itypj).gt.0) then
1279 evdw_p=evdw_p+evdwij
1281 evdw_m=evdw_m+evdwij
1287 C Calculate the components of the gradient in DC and X
1289 fac=-rrij*(e1+evdwij)
1294 if (bb(itypi,itypj).gt.0.0d0) then
1296 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1297 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1298 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1299 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1303 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1304 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1305 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1306 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1311 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1312 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1313 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1314 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1319 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1323 C 12/1/95, revised on 5/20/97
1325 C Calculate the contact function. The ith column of the array JCONT will
1326 C contain the numbers of atoms that make contacts with the atom I (of numbers
1327 C greater than I). The arrays FACONT and GACONT will contain the values of
1328 C the contact function and its derivative.
1330 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1331 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1332 C Uncomment next line, if the correlation interactions are contact function only
1333 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1335 sigij=sigma(itypi,itypj)
1336 r0ij=rs0(itypi,itypj)
1338 C Check whether the SC's are not too far to make a contact.
1341 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1342 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1344 if (fcont.gt.0.0D0) then
1345 C If the SC-SC distance if close to sigma, apply spline.
1346 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1347 cAdam & fcont1,fprimcont1)
1348 cAdam fcont1=1.0d0-fcont1
1349 cAdam if (fcont1.gt.0.0d0) then
1350 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1351 cAdam fcont=fcont*fcont1
1353 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1354 cga eps0ij=1.0d0/dsqrt(eps0ij)
1356 cga gg(k)=gg(k)*eps0ij
1358 cga eps0ij=-evdwij*eps0ij
1359 C Uncomment for AL's type of SC correlation interactions.
1360 cadam eps0ij=-evdwij
1361 num_conti=num_conti+1
1362 jcont(num_conti,i)=j
1363 facont(num_conti,i)=fcont*eps0ij
1364 fprimcont=eps0ij*fprimcont/rij
1366 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1367 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1368 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1369 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1370 gacont(1,num_conti,i)=-fprimcont*xj
1371 gacont(2,num_conti,i)=-fprimcont*yj
1372 gacont(3,num_conti,i)=-fprimcont*zj
1373 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1374 cd write (iout,'(2i3,3f10.5)')
1375 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1381 num_cont(i)=num_conti
1385 gvdwc(j,i)=expon*gvdwc(j,i)
1386 gvdwx(j,i)=expon*gvdwx(j,i)
1389 C******************************************************************************
1393 C To save time, the factor of EXPON has been extracted from ALL components
1394 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1397 C******************************************************************************
1400 C-----------------------------------------------------------------------------
1401 subroutine eljk(evdw,evdw_p,evdw_m)
1403 C This subroutine calculates the interaction energy of nonbonded side chains
1404 C assuming the LJK potential of interaction.
1406 implicit real*8 (a-h,o-z)
1407 include 'DIMENSIONS'
1408 include 'COMMON.GEO'
1409 include 'COMMON.VAR'
1410 include 'COMMON.LOCAL'
1411 include 'COMMON.CHAIN'
1412 include 'COMMON.DERIV'
1413 include 'COMMON.INTERACT'
1414 include 'COMMON.IOUNITS'
1415 include 'COMMON.NAMES'
1418 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1420 do i=iatsc_s,iatsc_e
1427 C Calculate SC interaction energy.
1429 do iint=1,nint_gr(i)
1430 do j=istart(i,iint),iend(i,iint)
1435 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1436 fac_augm=rrij**expon
1437 e_augm=augm(itypi,itypj)*fac_augm
1438 r_inv_ij=dsqrt(rrij)
1440 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1441 fac=r_shift_inv**expon
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1445 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1446 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1447 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1448 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1449 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1450 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1451 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1453 if (bb(itypi,itypj).gt.0) then
1454 evdw_p=evdw_p+evdwij
1456 evdw_m=evdw_m+evdwij
1462 C Calculate the components of the gradient in DC and X
1464 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1469 if (bb(itypi,itypj).gt.0.0d0) then
1471 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1472 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1473 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1474 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1478 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1479 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1480 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1481 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1486 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1487 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1488 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1489 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1494 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1502 gvdwc(j,i)=expon*gvdwc(j,i)
1503 gvdwx(j,i)=expon*gvdwx(j,i)
1508 C-----------------------------------------------------------------------------
1509 subroutine ebp(evdw,evdw_p,evdw_m)
1511 C This subroutine calculates the interaction energy of nonbonded side chains
1512 C assuming the Berne-Pechukas potential of interaction.
1514 implicit real*8 (a-h,o-z)
1515 include 'DIMENSIONS'
1516 include 'COMMON.GEO'
1517 include 'COMMON.VAR'
1518 include 'COMMON.LOCAL'
1519 include 'COMMON.CHAIN'
1520 include 'COMMON.DERIV'
1521 include 'COMMON.NAMES'
1522 include 'COMMON.INTERACT'
1523 include 'COMMON.IOUNITS'
1524 include 'COMMON.CALC'
1525 common /srutu/ icall
1526 c double precision rrsave(maxdim)
1529 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1531 c if (icall.eq.0) then
1537 do i=iatsc_s,iatsc_e
1543 dxi=dc_norm(1,nres+i)
1544 dyi=dc_norm(2,nres+i)
1545 dzi=dc_norm(3,nres+i)
1546 c dsci_inv=dsc_inv(itypi)
1547 dsci_inv=vbld_inv(i+nres)
1549 C Calculate SC interaction energy.
1551 do iint=1,nint_gr(i)
1552 do j=istart(i,iint),iend(i,iint)
1555 c dscj_inv=dsc_inv(itypj)
1556 dscj_inv=vbld_inv(j+nres)
1557 chi1=chi(itypi,itypj)
1558 chi2=chi(itypj,itypi)
1565 alf12=0.5D0*(alf1+alf2)
1566 C For diagnostics only!!!
1579 dxj=dc_norm(1,nres+j)
1580 dyj=dc_norm(2,nres+j)
1581 dzj=dc_norm(3,nres+j)
1582 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1583 cd if (icall.eq.0) then
1589 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1591 C Calculate whole angle-dependent part of epsilon and contributions
1592 C to its derivatives
1593 fac=(rrij*sigsq)**expon2
1594 e1=fac*fac*aa(itypi,itypj)
1595 e2=fac*bb(itypi,itypj)
1596 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1597 eps2der=evdwij*eps3rt
1598 eps3der=evdwij*eps2rt
1599 evdwij=evdwij*eps2rt*eps3rt
1601 if (bb(itypi,itypj).gt.0) then
1602 evdw_p=evdw_p+evdwij
1604 evdw_m=evdw_m+evdwij
1610 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1611 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1612 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1613 cd & restyp(itypi),i,restyp(itypj),j,
1614 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1615 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1616 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1619 C Calculate gradient components.
1620 e1=e1*eps1*eps2rt**2*eps3rt**2
1621 fac=-expon*(e1+evdwij)
1624 C Calculate radial part of the gradient
1628 C Calculate the angular part of the gradient and sum add the contributions
1629 C to the appropriate components of the Cartesian gradient.
1631 if (bb(itypi,itypj).gt.0) then
1645 C-----------------------------------------------------------------------------
1646 subroutine egb(evdw,evdw_p,evdw_m)
1648 C This subroutine calculates the interaction energy of nonbonded side chains
1649 C assuming the Gay-Berne potential of interaction.
1651 implicit real*8 (a-h,o-z)
1652 include 'DIMENSIONS'
1653 include 'COMMON.GEO'
1654 include 'COMMON.VAR'
1655 include 'COMMON.LOCAL'
1656 include 'COMMON.CHAIN'
1657 include 'COMMON.DERIV'
1658 include 'COMMON.NAMES'
1659 include 'COMMON.INTERACT'
1660 include 'COMMON.IOUNITS'
1661 include 'COMMON.CALC'
1662 include 'COMMON.CONTROL'
1663 include 'COMMON.SBRIDGE'
1666 ccccc energy_dec=.false.
1667 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1672 c if (icall.eq.0) lprn=.false.
1674 do i=iatsc_s,iatsc_e
1680 dxi=dc_norm(1,nres+i)
1681 dyi=dc_norm(2,nres+i)
1682 dzi=dc_norm(3,nres+i)
1683 c dsci_inv=dsc_inv(itypi)
1684 dsci_inv=vbld_inv(i+nres)
1685 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1686 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1688 C Calculate SC interaction energy.
1690 do iint=1,nint_gr(i)
1691 do j=istart(i,iint),iend(i,iint)
1692 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1693 call dyn_ssbond_ene(i,j,evdwij)
1695 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1696 & 'evdw',i,j,evdwij,' ss'
1700 c dscj_inv=dsc_inv(itypj)
1701 dscj_inv=vbld_inv(j+nres)
1702 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1703 c & 1.0d0/vbld(j+nres)
1704 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1705 sig0ij=sigma(itypi,itypj)
1706 chi1=chi(itypi,itypj)
1707 chi2=chi(itypj,itypi)
1714 alf12=0.5D0*(alf1+alf2)
1715 C For diagnostics only!!!
1728 dxj=dc_norm(1,nres+j)
1729 dyj=dc_norm(2,nres+j)
1730 dzj=dc_norm(3,nres+j)
1731 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1732 c write (iout,*) "j",j," dc_norm",
1733 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1734 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1736 C Calculate angle-dependent terms of energy and contributions to their
1740 sig=sig0ij*dsqrt(sigsq)
1741 rij_shift=1.0D0/rij-sig+sig0ij
1742 c for diagnostics; uncomment
1743 c rij_shift=1.2*sig0ij
1744 C I hate to put IF's in the loops, but here don't have another choice!!!!
1745 if (rij_shift.le.0.0D0) then
1747 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1748 cd & restyp(itypi),i,restyp(itypj),j,
1749 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1753 c---------------------------------------------------------------
1754 rij_shift=1.0D0/rij_shift
1755 fac=rij_shift**expon
1756 e1=fac*fac*aa(itypi,itypj)
1757 e2=fac*bb(itypi,itypj)
1758 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1759 eps2der=evdwij*eps3rt
1760 eps3der=evdwij*eps2rt
1761 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1762 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1763 evdwij=evdwij*eps2rt*eps3rt
1765 if (bb(itypi,itypj).gt.0) then
1766 evdw_p=evdw_p+evdwij
1768 evdw_m=evdw_m+evdwij
1774 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1775 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1776 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1777 & restyp(itypi),i,restyp(itypj),j,
1778 & epsi,sigm,chi1,chi2,chip1,chip2,
1779 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1780 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1784 if (energy_dec) then
1785 write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
1788 C Calculate gradient components.
1789 e1=e1*eps1*eps2rt**2*eps3rt**2
1790 fac=-expon*(e1+evdwij)*rij_shift
1794 C Calculate the radial part of the gradient
1798 C Calculate angular part of the gradient.
1800 if (bb(itypi,itypj).gt.0) then
1812 c write (iout,*) "Number of loop steps in EGB:",ind
1813 cccc energy_dec=.false.
1816 C-----------------------------------------------------------------------------
1817 subroutine egbv(evdw,evdw_p,evdw_m)
1819 C This subroutine calculates the interaction energy of nonbonded side chains
1820 C assuming the Gay-Berne-Vorobjev potential of interaction.
1822 implicit real*8 (a-h,o-z)
1823 include 'DIMENSIONS'
1824 include 'COMMON.GEO'
1825 include 'COMMON.VAR'
1826 include 'COMMON.LOCAL'
1827 include 'COMMON.CHAIN'
1828 include 'COMMON.DERIV'
1829 include 'COMMON.NAMES'
1830 include 'COMMON.INTERACT'
1831 include 'COMMON.IOUNITS'
1832 include 'COMMON.CALC'
1833 common /srutu/ icall
1836 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1839 c if (icall.eq.0) lprn=.true.
1841 do i=iatsc_s,iatsc_e
1847 dxi=dc_norm(1,nres+i)
1848 dyi=dc_norm(2,nres+i)
1849 dzi=dc_norm(3,nres+i)
1850 c dsci_inv=dsc_inv(itypi)
1851 dsci_inv=vbld_inv(i+nres)
1853 C Calculate SC interaction energy.
1855 do iint=1,nint_gr(i)
1856 do j=istart(i,iint),iend(i,iint)
1859 c dscj_inv=dsc_inv(itypj)
1860 dscj_inv=vbld_inv(j+nres)
1861 sig0ij=sigma(itypi,itypj)
1862 r0ij=r0(itypi,itypj)
1863 chi1=chi(itypi,itypj)
1864 chi2=chi(itypj,itypi)
1871 alf12=0.5D0*(alf1+alf2)
1872 C For diagnostics only!!!
1885 dxj=dc_norm(1,nres+j)
1886 dyj=dc_norm(2,nres+j)
1887 dzj=dc_norm(3,nres+j)
1888 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1890 C Calculate angle-dependent terms of energy and contributions to their
1894 sig=sig0ij*dsqrt(sigsq)
1895 rij_shift=1.0D0/rij-sig+r0ij
1896 C I hate to put IF's in the loops, but here don't have another choice!!!!
1897 if (rij_shift.le.0.0D0) then
1902 c---------------------------------------------------------------
1903 rij_shift=1.0D0/rij_shift
1904 fac=rij_shift**expon
1905 e1=fac*fac*aa(itypi,itypj)
1906 e2=fac*bb(itypi,itypj)
1907 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1908 eps2der=evdwij*eps3rt
1909 eps3der=evdwij*eps2rt
1910 fac_augm=rrij**expon
1911 e_augm=augm(itypi,itypj)*fac_augm
1912 evdwij=evdwij*eps2rt*eps3rt
1914 if (bb(itypi,itypj).gt.0) then
1915 evdw_p=evdw_p+evdwij+e_augm
1917 evdw_m=evdw_m+evdwij+e_augm
1920 evdw=evdw+evdwij+e_augm
1923 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1924 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1925 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1926 & restyp(itypi),i,restyp(itypj),j,
1927 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1928 & chi1,chi2,chip1,chip2,
1929 & eps1,eps2rt**2,eps3rt**2,
1930 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1933 C Calculate gradient components.
1934 e1=e1*eps1*eps2rt**2*eps3rt**2
1935 fac=-expon*(e1+evdwij)*rij_shift
1937 fac=rij*fac-2*expon*rrij*e_augm
1938 C Calculate the radial part of the gradient
1942 C Calculate angular part of the gradient.
1944 if (bb(itypi,itypj).gt.0) then
1956 C-----------------------------------------------------------------------------
1957 subroutine sc_angular
1958 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1959 C om12. Called by ebp, egb, and egbv.
1961 include 'COMMON.CALC'
1962 include 'COMMON.IOUNITS'
1966 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1967 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1968 om12=dxi*dxj+dyi*dyj+dzi*dzj
1970 C Calculate eps1(om12) and its derivative in om12
1971 faceps1=1.0D0-om12*chiom12
1972 faceps1_inv=1.0D0/faceps1
1973 eps1=dsqrt(faceps1_inv)
1974 C Following variable is eps1*deps1/dom12
1975 eps1_om12=faceps1_inv*chiom12
1980 c write (iout,*) "om12",om12," eps1",eps1
1981 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1986 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1987 sigsq=1.0D0-facsig*faceps1_inv
1988 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1989 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1990 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1996 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1997 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1999 C Calculate eps2 and its derivatives in om1, om2, and om12.
2002 chipom12=chip12*om12
2003 facp=1.0D0-om12*chipom12
2005 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2006 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2007 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2008 C Following variable is the square root of eps2
2009 eps2rt=1.0D0-facp1*facp_inv
2010 C Following three variables are the derivatives of the square root of eps
2011 C in om1, om2, and om12.
2012 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2013 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2014 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2015 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2016 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2017 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2018 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2019 c & " eps2rt_om12",eps2rt_om12
2020 C Calculate whole angle-dependent part of epsilon and contributions
2021 C to its derivatives
2025 C----------------------------------------------------------------------------
2026 subroutine sc_grad_T
2027 implicit real*8 (a-h,o-z)
2028 include 'DIMENSIONS'
2029 include 'COMMON.CHAIN'
2030 include 'COMMON.DERIV'
2031 include 'COMMON.CALC'
2032 include 'COMMON.IOUNITS'
2033 double precision dcosom1(3),dcosom2(3)
2034 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2035 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2036 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2037 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2041 c eom12=evdwij*eps1_om12
2043 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2044 c & " sigder",sigder
2045 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2046 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2048 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2049 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2052 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2054 c write (iout,*) "gg",(gg(k),k=1,3)
2056 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2057 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2058 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2059 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2060 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2061 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2062 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2063 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2064 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2065 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2068 C Calculate the components of the gradient in DC and X
2072 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2076 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2077 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2082 C----------------------------------------------------------------------------
2084 implicit real*8 (a-h,o-z)
2085 include 'DIMENSIONS'
2086 include 'COMMON.CHAIN'
2087 include 'COMMON.DERIV'
2088 include 'COMMON.CALC'
2089 include 'COMMON.IOUNITS'
2090 double precision dcosom1(3),dcosom2(3)
2091 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2092 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2093 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2094 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2098 c eom12=evdwij*eps1_om12
2100 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2101 c & " sigder",sigder
2102 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2103 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2105 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2106 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2109 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2111 c write (iout,*) "gg",(gg(k),k=1,3)
2113 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2114 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2115 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2116 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2117 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2118 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2119 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2120 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2121 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2122 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2125 C Calculate the components of the gradient in DC and X
2129 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2133 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2134 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2138 C-----------------------------------------------------------------------
2139 subroutine e_softsphere(evdw)
2141 C This subroutine calculates the interaction energy of nonbonded side chains
2142 C assuming the LJ potential of interaction.
2144 implicit real*8 (a-h,o-z)
2145 include 'DIMENSIONS'
2146 parameter (accur=1.0d-10)
2147 include 'COMMON.GEO'
2148 include 'COMMON.VAR'
2149 include 'COMMON.LOCAL'
2150 include 'COMMON.CHAIN'
2151 include 'COMMON.DERIV'
2152 include 'COMMON.INTERACT'
2153 include 'COMMON.TORSION'
2154 include 'COMMON.SBRIDGE'
2155 include 'COMMON.NAMES'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.CONTACTS'
2159 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2161 do i=iatsc_s,iatsc_e
2168 C Calculate SC interaction energy.
2170 do iint=1,nint_gr(i)
2171 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2172 cd & 'iend=',iend(i,iint)
2173 do j=istart(i,iint),iend(i,iint)
2178 rij=xj*xj+yj*yj+zj*zj
2179 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2180 r0ij=r0(itypi,itypj)
2182 c print *,i,j,r0ij,dsqrt(rij)
2183 if (rij.lt.r0ijsq) then
2184 evdwij=0.25d0*(rij-r0ijsq)**2
2192 C Calculate the components of the gradient in DC and X
2198 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2199 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2200 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2201 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2205 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2213 C--------------------------------------------------------------------------
2214 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2217 C Soft-sphere potential of p-p interaction
2219 implicit real*8 (a-h,o-z)
2220 include 'DIMENSIONS'
2221 include 'COMMON.CONTROL'
2222 include 'COMMON.IOUNITS'
2223 include 'COMMON.GEO'
2224 include 'COMMON.VAR'
2225 include 'COMMON.LOCAL'
2226 include 'COMMON.CHAIN'
2227 include 'COMMON.DERIV'
2228 include 'COMMON.INTERACT'
2229 include 'COMMON.CONTACTS'
2230 include 'COMMON.TORSION'
2231 include 'COMMON.VECTORS'
2232 include 'COMMON.FFIELD'
2234 cd write(iout,*) 'In EELEC_soft_sphere'
2241 do i=iatel_s,iatel_e
2245 xmedi=c(1,i)+0.5d0*dxi
2246 ymedi=c(2,i)+0.5d0*dyi
2247 zmedi=c(3,i)+0.5d0*dzi
2249 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2250 do j=ielstart(i),ielend(i)
2254 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2255 r0ij=rpp(iteli,itelj)
2260 xj=c(1,j)+0.5D0*dxj-xmedi
2261 yj=c(2,j)+0.5D0*dyj-ymedi
2262 zj=c(3,j)+0.5D0*dzj-zmedi
2263 rij=xj*xj+yj*yj+zj*zj
2264 if (rij.lt.r0ijsq) then
2265 evdw1ij=0.25d0*(rij-r0ijsq)**2
2273 C Calculate contributions to the Cartesian gradient.
2279 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2280 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2283 * Loop over residues i+1 thru j-1.
2287 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2292 cgrad do i=nnt,nct-1
2294 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2296 cgrad do j=i+1,nct-1
2298 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2304 c------------------------------------------------------------------------------
2305 subroutine vec_and_deriv
2306 implicit real*8 (a-h,o-z)
2307 include 'DIMENSIONS'
2311 include 'COMMON.IOUNITS'
2312 include 'COMMON.GEO'
2313 include 'COMMON.VAR'
2314 include 'COMMON.LOCAL'
2315 include 'COMMON.CHAIN'
2316 include 'COMMON.VECTORS'
2317 include 'COMMON.SETUP'
2318 include 'COMMON.TIME1'
2319 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2320 C Compute the local reference systems. For reference system (i), the
2321 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2322 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2324 do i=ivec_start,ivec_end
2328 if (i.eq.nres-1) then
2329 C Case of the last full residue
2330 C Compute the Z-axis
2331 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2332 costh=dcos(pi-theta(nres))
2333 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2337 C Compute the derivatives of uz
2339 uzder(2,1,1)=-dc_norm(3,i-1)
2340 uzder(3,1,1)= dc_norm(2,i-1)
2341 uzder(1,2,1)= dc_norm(3,i-1)
2343 uzder(3,2,1)=-dc_norm(1,i-1)
2344 uzder(1,3,1)=-dc_norm(2,i-1)
2345 uzder(2,3,1)= dc_norm(1,i-1)
2348 uzder(2,1,2)= dc_norm(3,i)
2349 uzder(3,1,2)=-dc_norm(2,i)
2350 uzder(1,2,2)=-dc_norm(3,i)
2352 uzder(3,2,2)= dc_norm(1,i)
2353 uzder(1,3,2)= dc_norm(2,i)
2354 uzder(2,3,2)=-dc_norm(1,i)
2356 C Compute the Y-axis
2359 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2361 C Compute the derivatives of uy
2364 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2365 & -dc_norm(k,i)*dc_norm(j,i-1)
2366 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2368 uyder(j,j,1)=uyder(j,j,1)-costh
2369 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2374 uygrad(l,k,j,i)=uyder(l,k,j)
2375 uzgrad(l,k,j,i)=uzder(l,k,j)
2379 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2380 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2381 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2382 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2385 C Compute the Z-axis
2386 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2387 costh=dcos(pi-theta(i+2))
2388 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2392 C Compute the derivatives of uz
2394 uzder(2,1,1)=-dc_norm(3,i+1)
2395 uzder(3,1,1)= dc_norm(2,i+1)
2396 uzder(1,2,1)= dc_norm(3,i+1)
2398 uzder(3,2,1)=-dc_norm(1,i+1)
2399 uzder(1,3,1)=-dc_norm(2,i+1)
2400 uzder(2,3,1)= dc_norm(1,i+1)
2403 uzder(2,1,2)= dc_norm(3,i)
2404 uzder(3,1,2)=-dc_norm(2,i)
2405 uzder(1,2,2)=-dc_norm(3,i)
2407 uzder(3,2,2)= dc_norm(1,i)
2408 uzder(1,3,2)= dc_norm(2,i)
2409 uzder(2,3,2)=-dc_norm(1,i)
2411 C Compute the Y-axis
2414 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2416 C Compute the derivatives of uy
2419 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2420 & -dc_norm(k,i)*dc_norm(j,i+1)
2421 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2423 uyder(j,j,1)=uyder(j,j,1)-costh
2424 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2429 uygrad(l,k,j,i)=uyder(l,k,j)
2430 uzgrad(l,k,j,i)=uzder(l,k,j)
2434 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2435 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2436 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2437 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2441 vbld_inv_temp(1)=vbld_inv(i+1)
2442 if (i.lt.nres-1) then
2443 vbld_inv_temp(2)=vbld_inv(i+2)
2445 vbld_inv_temp(2)=vbld_inv(i)
2450 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2451 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2456 #if defined(PARVEC) && defined(MPI)
2457 if (nfgtasks1.gt.1) then
2459 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2460 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2461 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2462 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2463 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2465 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2466 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2468 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2469 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2470 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2471 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2472 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2473 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2474 time_gather=time_gather+MPI_Wtime()-time00
2476 c if (fg_rank.eq.0) then
2477 c write (iout,*) "Arrays UY and UZ"
2479 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2486 C-----------------------------------------------------------------------------
2487 subroutine check_vecgrad
2488 implicit real*8 (a-h,o-z)
2489 include 'DIMENSIONS'
2490 include 'COMMON.IOUNITS'
2491 include 'COMMON.GEO'
2492 include 'COMMON.VAR'
2493 include 'COMMON.LOCAL'
2494 include 'COMMON.CHAIN'
2495 include 'COMMON.VECTORS'
2496 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2497 dimension uyt(3,maxres),uzt(3,maxres)
2498 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2499 double precision delta /1.0d-7/
2502 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2503 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2504 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2505 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2506 cd & (dc_norm(if90,i),if90=1,3)
2507 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2508 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2509 cd write(iout,'(a)')
2515 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2516 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2529 cd write (iout,*) 'i=',i
2531 erij(k)=dc_norm(k,i)
2535 dc_norm(k,i)=erij(k)
2537 dc_norm(j,i)=dc_norm(j,i)+delta
2538 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2540 c dc_norm(k,i)=dc_norm(k,i)/fac
2542 c write (iout,*) (dc_norm(k,i),k=1,3)
2543 c write (iout,*) (erij(k),k=1,3)
2546 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2547 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2548 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2549 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2551 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2552 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2553 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2556 dc_norm(k,i)=erij(k)
2559 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2560 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2561 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2562 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2563 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2564 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2565 cd write (iout,'(a)')
2570 C--------------------------------------------------------------------------
2571 subroutine set_matrices
2572 implicit real*8 (a-h,o-z)
2573 include 'DIMENSIONS'
2576 include "COMMON.SETUP"
2578 integer status(MPI_STATUS_SIZE)
2580 include 'COMMON.IOUNITS'
2581 include 'COMMON.GEO'
2582 include 'COMMON.VAR'
2583 include 'COMMON.LOCAL'
2584 include 'COMMON.CHAIN'
2585 include 'COMMON.DERIV'
2586 include 'COMMON.INTERACT'
2587 include 'COMMON.CONTACTS'
2588 include 'COMMON.TORSION'
2589 include 'COMMON.VECTORS'
2590 include 'COMMON.FFIELD'
2591 double precision auxvec(2),auxmat(2,2)
2593 C Compute the virtual-bond-torsional-angle dependent quantities needed
2594 C to calculate the el-loc multibody terms of various order.
2597 do i=ivec_start+2,ivec_end+2
2601 if (i .lt. nres+1) then
2638 if (i .gt. 3 .and. i .lt. nres+1) then
2639 obrot_der(1,i-2)=-sin1
2640 obrot_der(2,i-2)= cos1
2641 Ugder(1,1,i-2)= sin1
2642 Ugder(1,2,i-2)=-cos1
2643 Ugder(2,1,i-2)=-cos1
2644 Ugder(2,2,i-2)=-sin1
2647 obrot2_der(1,i-2)=-dwasin2
2648 obrot2_der(2,i-2)= dwacos2
2649 Ug2der(1,1,i-2)= dwasin2
2650 Ug2der(1,2,i-2)=-dwacos2
2651 Ug2der(2,1,i-2)=-dwacos2
2652 Ug2der(2,2,i-2)=-dwasin2
2654 obrot_der(1,i-2)=0.0d0
2655 obrot_der(2,i-2)=0.0d0
2656 Ugder(1,1,i-2)=0.0d0
2657 Ugder(1,2,i-2)=0.0d0
2658 Ugder(2,1,i-2)=0.0d0
2659 Ugder(2,2,i-2)=0.0d0
2660 obrot2_der(1,i-2)=0.0d0
2661 obrot2_der(2,i-2)=0.0d0
2662 Ug2der(1,1,i-2)=0.0d0
2663 Ug2der(1,2,i-2)=0.0d0
2664 Ug2der(2,1,i-2)=0.0d0
2665 Ug2der(2,2,i-2)=0.0d0
2667 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2668 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2669 iti = itortyp(itype(i-2))
2673 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2674 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2675 iti1 = itortyp(itype(i-1))
2679 cd write (iout,*) '*******i',i,' iti1',iti
2680 cd write (iout,*) 'b1',b1(:,iti)
2681 cd write (iout,*) 'b2',b2(:,iti)
2682 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2683 c if (i .gt. iatel_s+2) then
2684 if (i .gt. nnt+2) then
2685 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2686 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2687 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2689 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2690 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2691 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2692 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2693 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2704 DtUg2(l,k,i-2)=0.0d0
2708 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2709 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2711 muder(k,i-2)=Ub2der(k,i-2)
2713 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2714 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2715 iti1 = itortyp(itype(i-1))
2720 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2722 cd write (iout,*) 'mu ',mu(:,i-2)
2723 cd write (iout,*) 'mu1',mu1(:,i-2)
2724 cd write (iout,*) 'mu2',mu2(:,i-2)
2725 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2727 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2728 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2729 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2730 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2731 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2732 C Vectors and matrices dependent on a single virtual-bond dihedral.
2733 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2734 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2735 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2736 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2737 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2738 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2739 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2740 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2741 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2744 C Matrices dependent on two consecutive virtual-bond dihedrals.
2745 C The order of matrices is from left to right.
2746 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2748 c do i=max0(ivec_start,2),ivec_end
2750 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2751 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2752 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2753 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2754 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2755 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2756 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2757 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2760 #if defined(MPI) && defined(PARMAT)
2762 c if (fg_rank.eq.0) then
2763 write (iout,*) "Arrays UG and UGDER before GATHER"
2765 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2766 & ((ug(l,k,i),l=1,2),k=1,2),
2767 & ((ugder(l,k,i),l=1,2),k=1,2)
2769 write (iout,*) "Arrays UG2 and UG2DER"
2771 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2772 & ((ug2(l,k,i),l=1,2),k=1,2),
2773 & ((ug2der(l,k,i),l=1,2),k=1,2)
2775 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2777 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2778 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2779 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2781 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2783 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2784 & costab(i),sintab(i),costab2(i),sintab2(i)
2786 write (iout,*) "Array MUDER"
2788 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2792 if (nfgtasks.gt.1) then
2794 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2795 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2796 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2798 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2799 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2801 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2802 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2804 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2805 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2807 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2808 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2810 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2811 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2813 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2814 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2816 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2817 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2818 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2819 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2820 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2821 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2822 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2823 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2824 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2825 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2826 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2827 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2828 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2830 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2831 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2833 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2834 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2836 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2837 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2839 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2840 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2842 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2843 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2845 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2846 & ivec_count(fg_rank1),
2847 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2849 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2850 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2852 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2853 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2855 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2856 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2858 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2859 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2861 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2862 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2864 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2865 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2867 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2868 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2870 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2871 & ivec_count(fg_rank1),
2872 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2874 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2875 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2877 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2878 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2880 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2881 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2883 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2884 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2886 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2887 & ivec_count(fg_rank1),
2888 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2890 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2891 & ivec_count(fg_rank1),
2892 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2894 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2895 & ivec_count(fg_rank1),
2896 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2897 & MPI_MAT2,FG_COMM1,IERR)
2898 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2899 & ivec_count(fg_rank1),
2900 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2901 & MPI_MAT2,FG_COMM1,IERR)
2904 c Passes matrix info through the ring
2907 if (irecv.lt.0) irecv=nfgtasks1-1
2910 if (inext.ge.nfgtasks1) inext=0
2912 c write (iout,*) "isend",isend," irecv",irecv
2914 lensend=lentyp(isend)
2915 lenrecv=lentyp(irecv)
2916 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2917 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2918 c & MPI_ROTAT1(lensend),inext,2200+isend,
2919 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2920 c & iprev,2200+irecv,FG_COMM,status,IERR)
2921 c write (iout,*) "Gather ROTAT1"
2923 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2924 c & MPI_ROTAT2(lensend),inext,3300+isend,
2925 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2926 c & iprev,3300+irecv,FG_COMM,status,IERR)
2927 c write (iout,*) "Gather ROTAT2"
2929 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2930 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2931 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2932 & iprev,4400+irecv,FG_COMM,status,IERR)
2933 c write (iout,*) "Gather ROTAT_OLD"
2935 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2936 & MPI_PRECOMP11(lensend),inext,5500+isend,
2937 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2938 & iprev,5500+irecv,FG_COMM,status,IERR)
2939 c write (iout,*) "Gather PRECOMP11"
2941 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2942 & MPI_PRECOMP12(lensend),inext,6600+isend,
2943 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2944 & iprev,6600+irecv,FG_COMM,status,IERR)
2945 c write (iout,*) "Gather PRECOMP12"
2947 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2949 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2950 & MPI_ROTAT2(lensend),inext,7700+isend,
2951 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2952 & iprev,7700+irecv,FG_COMM,status,IERR)
2953 c write (iout,*) "Gather PRECOMP21"
2955 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2956 & MPI_PRECOMP22(lensend),inext,8800+isend,
2957 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2958 & iprev,8800+irecv,FG_COMM,status,IERR)
2959 c write (iout,*) "Gather PRECOMP22"
2961 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2962 & MPI_PRECOMP23(lensend),inext,9900+isend,
2963 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2964 & MPI_PRECOMP23(lenrecv),
2965 & iprev,9900+irecv,FG_COMM,status,IERR)
2966 c write (iout,*) "Gather PRECOMP23"
2971 if (irecv.lt.0) irecv=nfgtasks1-1
2974 time_gather=time_gather+MPI_Wtime()-time00
2977 c if (fg_rank.eq.0) then
2978 write (iout,*) "Arrays UG and UGDER"
2980 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2981 & ((ug(l,k,i),l=1,2),k=1,2),
2982 & ((ugder(l,k,i),l=1,2),k=1,2)
2984 write (iout,*) "Arrays UG2 and UG2DER"
2986 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2987 & ((ug2(l,k,i),l=1,2),k=1,2),
2988 & ((ug2der(l,k,i),l=1,2),k=1,2)
2990 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2992 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2993 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2994 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2996 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2998 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2999 & costab(i),sintab(i),costab2(i),sintab2(i)
3001 write (iout,*) "Array MUDER"
3003 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3009 cd iti = itortyp(itype(i))
3012 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3013 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3018 C--------------------------------------------------------------------------
3019 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3021 C This subroutine calculates the average interaction energy and its gradient
3022 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3023 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3024 C The potential depends both on the distance of peptide-group centers and on
3025 C the orientation of the CA-CA virtual bonds.
3027 implicit real*8 (a-h,o-z)
3031 include 'DIMENSIONS'
3032 include 'COMMON.CONTROL'
3033 include 'COMMON.SETUP'
3034 include 'COMMON.IOUNITS'
3035 include 'COMMON.GEO'
3036 include 'COMMON.VAR'
3037 include 'COMMON.LOCAL'
3038 include 'COMMON.CHAIN'
3039 include 'COMMON.DERIV'
3040 include 'COMMON.INTERACT'
3041 include 'COMMON.CONTACTS'
3042 include 'COMMON.TORSION'
3043 include 'COMMON.VECTORS'
3044 include 'COMMON.FFIELD'
3045 include 'COMMON.TIME1'
3046 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3047 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3048 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3049 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3050 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3051 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3053 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3055 double precision scal_el /1.0d0/
3057 double precision scal_el /0.5d0/
3060 C 13-go grudnia roku pamietnego...
3061 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3062 & 0.0d0,1.0d0,0.0d0,
3063 & 0.0d0,0.0d0,1.0d0/
3064 cd write(iout,*) 'In EELEC'
3066 cd write(iout,*) 'Type',i
3067 cd write(iout,*) 'B1',B1(:,i)
3068 cd write(iout,*) 'B2',B2(:,i)
3069 cd write(iout,*) 'CC',CC(:,:,i)
3070 cd write(iout,*) 'DD',DD(:,:,i)
3071 cd write(iout,*) 'EE',EE(:,:,i)
3073 cd call check_vecgrad
3075 if (icheckgrad.eq.1) then
3077 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3079 dc_norm(k,i)=dc(k,i)*fac
3081 c write (iout,*) 'i',i,' fac',fac
3084 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3085 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3086 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3087 c call vec_and_deriv
3093 time_mat=time_mat+MPI_Wtime()-time01
3097 cd write (iout,*) 'i=',i
3099 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3102 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3103 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3116 cd print '(a)','Enter EELEC'
3117 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3119 gel_loc_loc(i)=0.0d0
3124 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3126 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3128 do i=iturn3_start,iturn3_end
3132 dx_normi=dc_norm(1,i)
3133 dy_normi=dc_norm(2,i)
3134 dz_normi=dc_norm(3,i)
3135 xmedi=c(1,i)+0.5d0*dxi
3136 ymedi=c(2,i)+0.5d0*dyi
3137 zmedi=c(3,i)+0.5d0*dzi
3139 call eelecij(i,i+2,ees,evdw1,eel_loc)
3140 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3141 num_cont_hb(i)=num_conti
3143 do i=iturn4_start,iturn4_end
3147 dx_normi=dc_norm(1,i)
3148 dy_normi=dc_norm(2,i)
3149 dz_normi=dc_norm(3,i)
3150 xmedi=c(1,i)+0.5d0*dxi
3151 ymedi=c(2,i)+0.5d0*dyi
3152 zmedi=c(3,i)+0.5d0*dzi
3153 num_conti=num_cont_hb(i)
3154 call eelecij(i,i+3,ees,evdw1,eel_loc)
3155 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3156 num_cont_hb(i)=num_conti
3159 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3161 do i=iatel_s,iatel_e
3165 dx_normi=dc_norm(1,i)
3166 dy_normi=dc_norm(2,i)
3167 dz_normi=dc_norm(3,i)
3168 xmedi=c(1,i)+0.5d0*dxi
3169 ymedi=c(2,i)+0.5d0*dyi
3170 zmedi=c(3,i)+0.5d0*dzi
3171 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3172 num_conti=num_cont_hb(i)
3173 do j=ielstart(i),ielend(i)
3174 call eelecij(i,j,ees,evdw1,eel_loc)
3176 num_cont_hb(i)=num_conti
3178 c write (iout,*) "Number of loop steps in EELEC:",ind
3180 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3181 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3183 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3184 ccc eel_loc=eel_loc+eello_turn3
3185 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3188 C-------------------------------------------------------------------------------
3189 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3190 implicit real*8 (a-h,o-z)
3191 include 'DIMENSIONS'
3195 include 'COMMON.CONTROL'
3196 include 'COMMON.IOUNITS'
3197 include 'COMMON.GEO'
3198 include 'COMMON.VAR'
3199 include 'COMMON.LOCAL'
3200 include 'COMMON.CHAIN'
3201 include 'COMMON.DERIV'
3202 include 'COMMON.INTERACT'
3203 include 'COMMON.CONTACTS'
3204 include 'COMMON.TORSION'
3205 include 'COMMON.VECTORS'
3206 include 'COMMON.FFIELD'
3207 include 'COMMON.TIME1'
3208 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3209 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3210 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3211 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3212 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3213 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3215 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3217 double precision scal_el /1.0d0/
3219 double precision scal_el /0.5d0/
3222 C 13-go grudnia roku pamietnego...
3223 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3224 & 0.0d0,1.0d0,0.0d0,
3225 & 0.0d0,0.0d0,1.0d0/
3226 c time00=MPI_Wtime()
3227 cd write (iout,*) "eelecij",i,j
3231 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3232 aaa=app(iteli,itelj)
3233 bbb=bpp(iteli,itelj)
3234 ael6i=ael6(iteli,itelj)
3235 ael3i=ael3(iteli,itelj)
3239 dx_normj=dc_norm(1,j)
3240 dy_normj=dc_norm(2,j)
3241 dz_normj=dc_norm(3,j)
3242 xj=c(1,j)+0.5D0*dxj-xmedi
3243 yj=c(2,j)+0.5D0*dyj-ymedi
3244 zj=c(3,j)+0.5D0*dzj-zmedi
3245 rij=xj*xj+yj*yj+zj*zj
3251 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3252 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3253 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3254 fac=cosa-3.0D0*cosb*cosg
3256 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3257 if (j.eq.i+2) ev1=scal_el*ev1
3262 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3265 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3266 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3269 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3270 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3271 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3272 cd & xmedi,ymedi,zmedi,xj,yj,zj
3274 if (energy_dec) then
3275 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3276 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3280 C Calculate contributions to the Cartesian gradient.
3283 facvdw=-6*rrmij*(ev1+evdwij)
3284 facel=-3*rrmij*(el1+eesij)
3290 * Radial derivatives. First process both termini of the fragment (i,j)
3296 c ghalf=0.5D0*ggg(k)
3297 c gelc(k,i)=gelc(k,i)+ghalf
3298 c gelc(k,j)=gelc(k,j)+ghalf
3300 c 9/28/08 AL Gradient compotents will be summed only at the end
3302 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3303 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3306 * Loop over residues i+1 thru j-1.
3310 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3317 c ghalf=0.5D0*ggg(k)
3318 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3319 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3321 c 9/28/08 AL Gradient compotents will be summed only at the end
3323 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3324 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3327 * Loop over residues i+1 thru j-1.
3331 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3338 fac=-3*rrmij*(facvdw+facvdw+facel)
3343 * Radial derivatives. First process both termini of the fragment (i,j)
3349 c ghalf=0.5D0*ggg(k)
3350 c gelc(k,i)=gelc(k,i)+ghalf
3351 c gelc(k,j)=gelc(k,j)+ghalf
3353 c 9/28/08 AL Gradient compotents will be summed only at the end
3355 gelc_long(k,j)=gelc(k,j)+ggg(k)
3356 gelc_long(k,i)=gelc(k,i)-ggg(k)
3359 * Loop over residues i+1 thru j-1.
3363 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3366 c 9/28/08 AL Gradient compotents will be summed only at the end
3371 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3372 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3378 ecosa=2.0D0*fac3*fac1+fac4
3381 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3382 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3384 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3385 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3387 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3388 cd & (dcosg(k),k=1,3)
3390 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3393 c ghalf=0.5D0*ggg(k)
3394 c gelc(k,i)=gelc(k,i)+ghalf
3395 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3396 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3397 c gelc(k,j)=gelc(k,j)+ghalf
3398 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3399 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3403 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3408 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3409 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3411 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3412 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3413 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3414 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3416 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3417 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3418 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3420 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3421 C energy of a peptide unit is assumed in the form of a second-order
3422 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3423 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3424 C are computed for EVERY pair of non-contiguous peptide groups.
3426 if (j.lt.nres-1) then
3437 muij(kkk)=mu(k,i)*mu(l,j)
3440 cd write (iout,*) 'EELEC: i',i,' j',j
3441 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3442 cd write(iout,*) 'muij',muij
3443 ury=scalar(uy(1,i),erij)
3444 urz=scalar(uz(1,i),erij)
3445 vry=scalar(uy(1,j),erij)
3446 vrz=scalar(uz(1,j),erij)
3447 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3448 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3449 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3450 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3451 fac=dsqrt(-ael6i)*r3ij
3456 cd write (iout,'(4i5,4f10.5)')
3457 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3458 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3459 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3460 cd & uy(:,j),uz(:,j)
3461 cd write (iout,'(4f10.5)')
3462 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3463 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3464 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3465 cd write (iout,'(9f10.5/)')
3466 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3467 C Derivatives of the elements of A in virtual-bond vectors
3468 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3470 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3471 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3472 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3473 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3474 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3475 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3476 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3477 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3478 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3479 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3480 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3481 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3483 C Compute radial contributions to the gradient
3501 C Add the contributions coming from er
3504 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3505 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3506 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3507 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3510 C Derivatives in DC(i)
3511 cgrad ghalf1=0.5d0*agg(k,1)
3512 cgrad ghalf2=0.5d0*agg(k,2)
3513 cgrad ghalf3=0.5d0*agg(k,3)
3514 cgrad ghalf4=0.5d0*agg(k,4)
3515 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3516 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3517 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3518 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3519 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3520 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3521 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3522 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3523 C Derivatives in DC(i+1)
3524 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3525 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3526 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3527 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3528 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3529 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3530 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3531 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3532 C Derivatives in DC(j)
3533 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3534 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3535 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3536 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3537 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3538 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3539 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3540 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3541 C Derivatives in DC(j+1) or DC(nres-1)
3542 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3543 & -3.0d0*vryg(k,3)*ury)
3544 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3545 & -3.0d0*vrzg(k,3)*ury)
3546 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3547 & -3.0d0*vryg(k,3)*urz)
3548 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3549 & -3.0d0*vrzg(k,3)*urz)
3550 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3552 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3565 aggi(k,l)=-aggi(k,l)
3566 aggi1(k,l)=-aggi1(k,l)
3567 aggj(k,l)=-aggj(k,l)
3568 aggj1(k,l)=-aggj1(k,l)
3571 if (j.lt.nres-1) then
3577 aggi(k,l)=-aggi(k,l)
3578 aggi1(k,l)=-aggi1(k,l)
3579 aggj(k,l)=-aggj(k,l)
3580 aggj1(k,l)=-aggj1(k,l)
3591 aggi(k,l)=-aggi(k,l)
3592 aggi1(k,l)=-aggi1(k,l)
3593 aggj(k,l)=-aggj(k,l)
3594 aggj1(k,l)=-aggj1(k,l)
3599 IF (wel_loc.gt.0.0d0) THEN
3600 C Contribution to the local-electrostatic energy coming from the i-j pair
3601 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3603 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3605 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3606 & 'eelloc',i,j,eel_loc_ij
3608 eel_loc=eel_loc+eel_loc_ij
3609 C Partial derivatives in virtual-bond dihedral angles gamma
3611 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3612 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3613 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3614 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3615 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3616 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3617 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3619 ggg(l)=agg(l,1)*muij(1)+
3620 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3621 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3622 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3623 cgrad ghalf=0.5d0*ggg(l)
3624 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3625 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3629 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3632 C Remaining derivatives of eello
3634 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3635 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3636 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3637 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3638 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3639 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3640 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3641 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3644 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3645 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3646 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3647 & .and. num_conti.le.maxconts) then
3648 c write (iout,*) i,j," entered corr"
3650 C Calculate the contact function. The ith column of the array JCONT will
3651 C contain the numbers of atoms that make contacts with the atom I (of numbers
3652 C greater than I). The arrays FACONT and GACONT will contain the values of
3653 C the contact function and its derivative.
3654 c r0ij=1.02D0*rpp(iteli,itelj)
3655 c r0ij=1.11D0*rpp(iteli,itelj)
3656 r0ij=2.20D0*rpp(iteli,itelj)
3657 c r0ij=1.55D0*rpp(iteli,itelj)
3658 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3659 if (fcont.gt.0.0D0) then
3660 num_conti=num_conti+1
3661 if (num_conti.gt.maxconts) then
3662 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3663 & ' will skip next contacts for this conf.'
3665 jcont_hb(num_conti,i)=j
3666 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3667 cd & " jcont_hb",jcont_hb(num_conti,i)
3668 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3669 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3670 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3672 d_cont(num_conti,i)=rij
3673 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3674 C --- Electrostatic-interaction matrix ---
3675 a_chuj(1,1,num_conti,i)=a22
3676 a_chuj(1,2,num_conti,i)=a23
3677 a_chuj(2,1,num_conti,i)=a32
3678 a_chuj(2,2,num_conti,i)=a33
3679 C --- Gradient of rij
3681 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3688 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3689 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3690 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3691 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3692 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3697 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3698 C Calculate contact energies
3700 wij=cosa-3.0D0*cosb*cosg
3703 c fac3=dsqrt(-ael6i)/r0ij**3
3704 fac3=dsqrt(-ael6i)*r3ij
3705 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3706 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3707 if (ees0tmp.gt.0) then
3708 ees0pij=dsqrt(ees0tmp)
3712 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3713 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3714 if (ees0tmp.gt.0) then
3715 ees0mij=dsqrt(ees0tmp)
3720 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3721 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3722 C Diagnostics. Comment out or remove after debugging!
3723 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3724 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3725 c ees0m(num_conti,i)=0.0D0
3727 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3728 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3729 C Angular derivatives of the contact function
3730 ees0pij1=fac3/ees0pij
3731 ees0mij1=fac3/ees0mij
3732 fac3p=-3.0D0*fac3*rrmij
3733 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3734 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3736 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3737 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3738 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3739 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3740 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3741 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3742 ecosap=ecosa1+ecosa2
3743 ecosbp=ecosb1+ecosb2
3744 ecosgp=ecosg1+ecosg2
3745 ecosam=ecosa1-ecosa2
3746 ecosbm=ecosb1-ecosb2
3747 ecosgm=ecosg1-ecosg2
3756 facont_hb(num_conti,i)=fcont
3757 fprimcont=fprimcont/rij
3758 cd facont_hb(num_conti,i)=1.0D0
3759 C Following line is for diagnostics.
3762 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3763 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3766 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3767 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3769 gggp(1)=gggp(1)+ees0pijp*xj
3770 gggp(2)=gggp(2)+ees0pijp*yj
3771 gggp(3)=gggp(3)+ees0pijp*zj
3772 gggm(1)=gggm(1)+ees0mijp*xj
3773 gggm(2)=gggm(2)+ees0mijp*yj
3774 gggm(3)=gggm(3)+ees0mijp*zj
3775 C Derivatives due to the contact function
3776 gacont_hbr(1,num_conti,i)=fprimcont*xj
3777 gacont_hbr(2,num_conti,i)=fprimcont*yj
3778 gacont_hbr(3,num_conti,i)=fprimcont*zj
3781 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3782 c following the change of gradient-summation algorithm.
3784 cgrad ghalfp=0.5D0*gggp(k)
3785 cgrad ghalfm=0.5D0*gggm(k)
3786 gacontp_hb1(k,num_conti,i)=!ghalfp
3787 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3788 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3789 gacontp_hb2(k,num_conti,i)=!ghalfp
3790 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3791 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3792 gacontp_hb3(k,num_conti,i)=gggp(k)
3793 gacontm_hb1(k,num_conti,i)=!ghalfm
3794 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3795 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3796 gacontm_hb2(k,num_conti,i)=!ghalfm
3797 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3798 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3799 gacontm_hb3(k,num_conti,i)=gggm(k)
3801 C Diagnostics. Comment out or remove after debugging!
3803 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3804 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3805 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3806 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3807 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3808 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3811 endif ! num_conti.le.maxconts
3814 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3817 ghalf=0.5d0*agg(l,k)
3818 aggi(l,k)=aggi(l,k)+ghalf
3819 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3820 aggj(l,k)=aggj(l,k)+ghalf
3823 if (j.eq.nres-1 .and. i.lt.j-2) then
3826 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3831 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3834 C-----------------------------------------------------------------------------
3835 subroutine eturn3(i,eello_turn3)
3836 C Third- and fourth-order contributions from turns
3837 implicit real*8 (a-h,o-z)
3838 include 'DIMENSIONS'
3839 include 'COMMON.IOUNITS'
3840 include 'COMMON.GEO'
3841 include 'COMMON.VAR'
3842 include 'COMMON.LOCAL'
3843 include 'COMMON.CHAIN'
3844 include 'COMMON.DERIV'
3845 include 'COMMON.INTERACT'
3846 include 'COMMON.CONTACTS'
3847 include 'COMMON.TORSION'
3848 include 'COMMON.VECTORS'
3849 include 'COMMON.FFIELD'
3850 include 'COMMON.CONTROL'
3852 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3853 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3854 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3855 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3856 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3857 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3858 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3861 c write (iout,*) "eturn3",i,j,j1,j2
3866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3868 C Third-order contributions
3875 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3876 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3877 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3878 call transpose2(auxmat(1,1),auxmat1(1,1))
3879 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3880 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3881 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3882 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3883 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3884 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3885 cd & ' eello_turn3_num',4*eello_turn3_num
3886 C Derivatives in gamma(i)
3887 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3888 call transpose2(auxmat2(1,1),auxmat3(1,1))
3889 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3890 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3891 C Derivatives in gamma(i+1)
3892 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3893 call transpose2(auxmat2(1,1),auxmat3(1,1))
3894 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3895 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3896 & +0.5d0*(pizda(1,1)+pizda(2,2))
3897 C Cartesian derivatives
3900 c ghalf1=0.5d0*agg(l,1)
3901 c ghalf2=0.5d0*agg(l,2)
3902 c ghalf3=0.5d0*agg(l,3)
3903 c ghalf4=0.5d0*agg(l,4)
3904 a_temp(1,1)=aggi(l,1)!+ghalf1
3905 a_temp(1,2)=aggi(l,2)!+ghalf2
3906 a_temp(2,1)=aggi(l,3)!+ghalf3
3907 a_temp(2,2)=aggi(l,4)!+ghalf4
3908 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3909 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3910 & +0.5d0*(pizda(1,1)+pizda(2,2))
3911 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3912 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3913 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3914 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3915 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3916 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3917 & +0.5d0*(pizda(1,1)+pizda(2,2))
3918 a_temp(1,1)=aggj(l,1)!+ghalf1
3919 a_temp(1,2)=aggj(l,2)!+ghalf2
3920 a_temp(2,1)=aggj(l,3)!+ghalf3
3921 a_temp(2,2)=aggj(l,4)!+ghalf4
3922 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3923 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3924 & +0.5d0*(pizda(1,1)+pizda(2,2))
3925 a_temp(1,1)=aggj1(l,1)
3926 a_temp(1,2)=aggj1(l,2)
3927 a_temp(2,1)=aggj1(l,3)
3928 a_temp(2,2)=aggj1(l,4)
3929 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3930 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3931 & +0.5d0*(pizda(1,1)+pizda(2,2))
3935 C-------------------------------------------------------------------------------
3936 subroutine eturn4(i,eello_turn4)
3937 C Third- and fourth-order contributions from turns
3938 implicit real*8 (a-h,o-z)
3939 include 'DIMENSIONS'
3940 include 'COMMON.IOUNITS'
3941 include 'COMMON.GEO'
3942 include 'COMMON.VAR'
3943 include 'COMMON.LOCAL'
3944 include 'COMMON.CHAIN'
3945 include 'COMMON.DERIV'
3946 include 'COMMON.INTERACT'
3947 include 'COMMON.CONTACTS'
3948 include 'COMMON.TORSION'
3949 include 'COMMON.VECTORS'
3950 include 'COMMON.FFIELD'
3951 include 'COMMON.CONTROL'
3953 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3954 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3955 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3956 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3957 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3958 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3959 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3962 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3964 C Fourth-order contributions
3972 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3973 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3974 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3979 iti1=itortyp(itype(i+1))
3980 iti2=itortyp(itype(i+2))
3981 iti3=itortyp(itype(i+3))
3982 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3983 call transpose2(EUg(1,1,i+1),e1t(1,1))
3984 call transpose2(Eug(1,1,i+2),e2t(1,1))
3985 call transpose2(Eug(1,1,i+3),e3t(1,1))
3986 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3987 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3988 s1=scalar2(b1(1,iti2),auxvec(1))
3989 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3990 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3991 s2=scalar2(b1(1,iti1),auxvec(1))
3992 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3993 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3994 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3995 eello_turn4=eello_turn4-(s1+s2+s3)
3996 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3997 & 'eturn4',i,j,-(s1+s2+s3)
3998 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3999 cd & ' eello_turn4_num',8*eello_turn4_num
4000 C Derivatives in gamma(i)
4001 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4002 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4003 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4004 s1=scalar2(b1(1,iti2),auxvec(1))
4005 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4006 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4007 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4008 C Derivatives in gamma(i+1)
4009 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4010 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4011 s2=scalar2(b1(1,iti1),auxvec(1))
4012 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4013 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4014 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4015 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4016 C Derivatives in gamma(i+2)
4017 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4018 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4019 s1=scalar2(b1(1,iti2),auxvec(1))
4020 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4021 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4022 s2=scalar2(b1(1,iti1),auxvec(1))
4023 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4024 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4025 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4026 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4027 C Cartesian derivatives
4028 C Derivatives of this turn contributions in DC(i+2)
4029 if (j.lt.nres-1) then
4031 a_temp(1,1)=agg(l,1)
4032 a_temp(1,2)=agg(l,2)
4033 a_temp(2,1)=agg(l,3)
4034 a_temp(2,2)=agg(l,4)
4035 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4036 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4037 s1=scalar2(b1(1,iti2),auxvec(1))
4038 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4039 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4040 s2=scalar2(b1(1,iti1),auxvec(1))
4041 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4042 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4043 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4045 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4048 C Remaining derivatives of this turn contribution
4050 a_temp(1,1)=aggi(l,1)
4051 a_temp(1,2)=aggi(l,2)
4052 a_temp(2,1)=aggi(l,3)
4053 a_temp(2,2)=aggi(l,4)
4054 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4055 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4056 s1=scalar2(b1(1,iti2),auxvec(1))
4057 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4058 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4059 s2=scalar2(b1(1,iti1),auxvec(1))
4060 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4061 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4062 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4063 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4064 a_temp(1,1)=aggi1(l,1)
4065 a_temp(1,2)=aggi1(l,2)
4066 a_temp(2,1)=aggi1(l,3)
4067 a_temp(2,2)=aggi1(l,4)
4068 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4069 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4070 s1=scalar2(b1(1,iti2),auxvec(1))
4071 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4072 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4073 s2=scalar2(b1(1,iti1),auxvec(1))
4074 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4075 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4076 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4077 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4078 a_temp(1,1)=aggj(l,1)
4079 a_temp(1,2)=aggj(l,2)
4080 a_temp(2,1)=aggj(l,3)
4081 a_temp(2,2)=aggj(l,4)
4082 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4083 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4084 s1=scalar2(b1(1,iti2),auxvec(1))
4085 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4086 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4087 s2=scalar2(b1(1,iti1),auxvec(1))
4088 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4089 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4090 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4091 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4092 a_temp(1,1)=aggj1(l,1)
4093 a_temp(1,2)=aggj1(l,2)
4094 a_temp(2,1)=aggj1(l,3)
4095 a_temp(2,2)=aggj1(l,4)
4096 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4097 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4098 s1=scalar2(b1(1,iti2),auxvec(1))
4099 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4100 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4101 s2=scalar2(b1(1,iti1),auxvec(1))
4102 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4103 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4104 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4105 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4106 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4110 C-----------------------------------------------------------------------------
4111 subroutine vecpr(u,v,w)
4112 implicit real*8(a-h,o-z)
4113 dimension u(3),v(3),w(3)
4114 w(1)=u(2)*v(3)-u(3)*v(2)
4115 w(2)=-u(1)*v(3)+u(3)*v(1)
4116 w(3)=u(1)*v(2)-u(2)*v(1)
4119 C-----------------------------------------------------------------------------
4120 subroutine unormderiv(u,ugrad,unorm,ungrad)
4121 C This subroutine computes the derivatives of a normalized vector u, given
4122 C the derivatives computed without normalization conditions, ugrad. Returns
4125 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4126 double precision vec(3)
4127 double precision scalar
4129 c write (2,*) 'ugrad',ugrad
4132 vec(i)=scalar(ugrad(1,i),u(1))
4134 c write (2,*) 'vec',vec
4137 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4140 c write (2,*) 'ungrad',ungrad
4143 C-----------------------------------------------------------------------------
4144 subroutine escp_soft_sphere(evdw2,evdw2_14)
4146 C This subroutine calculates the excluded-volume interaction energy between
4147 C peptide-group centers and side chains and its gradient in virtual-bond and
4148 C side-chain vectors.
4150 implicit real*8 (a-h,o-z)
4151 include 'DIMENSIONS'
4152 include 'COMMON.GEO'
4153 include 'COMMON.VAR'
4154 include 'COMMON.LOCAL'
4155 include 'COMMON.CHAIN'
4156 include 'COMMON.DERIV'
4157 include 'COMMON.INTERACT'
4158 include 'COMMON.FFIELD'
4159 include 'COMMON.IOUNITS'
4160 include 'COMMON.CONTROL'
4165 cd print '(a)','Enter ESCP'
4166 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4167 do i=iatscp_s,iatscp_e
4169 xi=0.5D0*(c(1,i)+c(1,i+1))
4170 yi=0.5D0*(c(2,i)+c(2,i+1))
4171 zi=0.5D0*(c(3,i)+c(3,i+1))
4173 do iint=1,nscp_gr(i)
4175 do j=iscpstart(i,iint),iscpend(i,iint)
4177 C Uncomment following three lines for SC-p interactions
4181 C Uncomment following three lines for Ca-p interactions
4185 rij=xj*xj+yj*yj+zj*zj
4188 if (rij.lt.r0ijsq) then
4189 evdwij=0.25d0*(rij-r0ijsq)**2
4197 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4202 cgrad if (j.lt.i) then
4203 cd write (iout,*) 'j<i'
4204 C Uncomment following three lines for SC-p interactions
4206 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4209 cd write (iout,*) 'j>i'
4211 cgrad ggg(k)=-ggg(k)
4212 C Uncomment following line for SC-p interactions
4213 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4217 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4219 cgrad kstart=min0(i+1,j)
4220 cgrad kend=max0(i-1,j-1)
4221 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4222 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4223 cgrad do k=kstart,kend
4225 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4229 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4230 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4238 C-----------------------------------------------------------------------------
4239 subroutine escp(evdw2,evdw2_14)
4241 C This subroutine calculates the excluded-volume interaction energy between
4242 C peptide-group centers and side chains and its gradient in virtual-bond and
4243 C side-chain vectors.
4245 implicit real*8 (a-h,o-z)
4246 include 'DIMENSIONS'
4247 include 'COMMON.GEO'
4248 include 'COMMON.VAR'
4249 include 'COMMON.LOCAL'
4250 include 'COMMON.CHAIN'
4251 include 'COMMON.DERIV'
4252 include 'COMMON.INTERACT'
4253 include 'COMMON.FFIELD'
4254 include 'COMMON.IOUNITS'
4255 include 'COMMON.CONTROL'
4259 cd print '(a)','Enter ESCP'
4260 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4261 do i=iatscp_s,iatscp_e
4263 xi=0.5D0*(c(1,i)+c(1,i+1))
4264 yi=0.5D0*(c(2,i)+c(2,i+1))
4265 zi=0.5D0*(c(3,i)+c(3,i+1))
4267 do iint=1,nscp_gr(i)
4269 do j=iscpstart(i,iint),iscpend(i,iint)
4271 C Uncomment following three lines for SC-p interactions
4275 C Uncomment following three lines for Ca-p interactions
4279 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4281 e1=fac*fac*aad(itypj,iteli)
4282 e2=fac*bad(itypj,iteli)
4283 if (iabs(j-i) .le. 2) then
4286 evdw2_14=evdw2_14+e1+e2
4290 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4291 & 'evdw2',i,j,evdwij
4293 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4295 fac=-(evdwij+e1)*rrij
4299 cgrad if (j.lt.i) then
4300 cd write (iout,*) 'j<i'
4301 C Uncomment following three lines for SC-p interactions
4303 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4306 cd write (iout,*) 'j>i'
4308 cgrad ggg(k)=-ggg(k)
4309 C Uncomment following line for SC-p interactions
4310 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4311 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4315 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4317 cgrad kstart=min0(i+1,j)
4318 cgrad kend=max0(i-1,j-1)
4319 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4320 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4321 cgrad do k=kstart,kend
4323 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4327 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4328 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4336 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4337 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4338 gradx_scp(j,i)=expon*gradx_scp(j,i)
4341 C******************************************************************************
4345 C To save time the factor EXPON has been extracted from ALL components
4346 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4349 C******************************************************************************
4352 C--------------------------------------------------------------------------
4353 subroutine edis(ehpb)
4355 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4357 implicit real*8 (a-h,o-z)
4358 include 'DIMENSIONS'
4359 include 'COMMON.SBRIDGE'
4360 include 'COMMON.CHAIN'
4361 include 'COMMON.DERIV'
4362 include 'COMMON.VAR'
4363 include 'COMMON.INTERACT'
4364 include 'COMMON.IOUNITS'
4365 include 'COMMON.CONTROL'
4368 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4369 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4370 if (link_end.eq.0) return
4371 do i=link_start,link_end
4372 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4373 C CA-CA distance used in regularization of structure.
4376 C iii and jjj point to the residues for which the distance is assigned.
4377 if (ii.gt.nres) then
4384 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4385 c & dhpb(i),dhpb1(i),forcon(i)
4386 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4387 C distance and angle dependent SS bond potential.
4388 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4389 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4390 if (.not.dyn_ss .and. i.le.nss) then
4391 C 15/02/13 CC dynamic SSbond - additional check
4393 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4394 call ssbond_ene(iii,jjj,eij)
4397 cd write (iout,*) "eij",eij
4398 else if (ii.gt.nres .and. jj.gt.nres) then
4399 c Restraints from contact prediction
4401 if (constr_dist.eq.11) then
4402 ehpb=ehpb+fordepth(i)**4.0d0
4403 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4404 fac=fordepth(i)**4.0d0
4405 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4406 if (energy_dec) write (iout,'(a6,2i5,f15.6,2f8.3)')
4408 & fordepth(i)**4.0d0*rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)),
4411 if (dhpb1(i).gt.0.0d0) then
4412 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4413 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4414 c write (iout,*) "beta nmr",
4415 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4419 C Get the force constant corresponding to this distance.
4421 C Calculate the contribution to energy.
4422 ehpb=ehpb+waga*rdis*rdis
4423 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4425 C Evaluate gradient.
4431 ggg(j)=fac*(c(j,jj)-c(j,ii))
4434 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4435 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4438 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4439 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4442 C Calculate the distance between the two points and its difference from the
4445 if (constr_dist.eq.11) then
4446 ehpb=ehpb+fordepth(i)**4.0d0
4447 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4448 fac=fordepth(i)**4.0d0
4449 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4450 if (energy_dec) write (iout,'(a6,2i5,f15.6,2f8.3)')
4452 & fordepth(i)**4.0d0*rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)),
4455 c & write (iout,*) fac
4457 if (dhpb1(i).gt.0.0d0) then
4458 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4459 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4460 c write (iout,*) "alph nmr",
4461 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4464 C Get the force constant corresponding to this distance.
4466 C Calculate the contribution to energy.
4467 ehpb=ehpb+waga*rdis*rdis
4468 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4470 C Evaluate gradient.
4475 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4476 cd & ' waga=',waga,' fac=',fac
4478 ggg(j)=fac*(c(j,jj)-c(j,ii))
4480 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4481 C If this is a SC-SC distance, we need to calculate the contributions to the
4482 C Cartesian gradient in the SC vectors (ghpbx).
4485 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4486 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4489 cgrad do j=iii,jjj-1
4491 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4495 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4496 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4500 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4502 c write (iout,*) "ghpbc",i,(ghpbc(j,i),j=1,3)
4506 C--------------------------------------------------------------------------
4507 subroutine ssbond_ene(i,j,eij)
4509 C Calculate the distance and angle dependent SS-bond potential energy
4510 C using a free-energy function derived based on RHF/6-31G** ab initio
4511 C calculations of diethyl disulfide.
4513 C A. Liwo and U. Kozlowska, 11/24/03
4515 implicit real*8 (a-h,o-z)
4516 include 'DIMENSIONS'
4517 include 'COMMON.SBRIDGE'
4518 include 'COMMON.CHAIN'
4519 include 'COMMON.DERIV'
4520 include 'COMMON.LOCAL'
4521 include 'COMMON.INTERACT'
4522 include 'COMMON.VAR'
4523 include 'COMMON.IOUNITS'
4524 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4529 dxi=dc_norm(1,nres+i)
4530 dyi=dc_norm(2,nres+i)
4531 dzi=dc_norm(3,nres+i)
4532 c dsci_inv=dsc_inv(itypi)
4533 dsci_inv=vbld_inv(nres+i)
4535 c dscj_inv=dsc_inv(itypj)
4536 dscj_inv=vbld_inv(nres+j)
4540 dxj=dc_norm(1,nres+j)
4541 dyj=dc_norm(2,nres+j)
4542 dzj=dc_norm(3,nres+j)
4543 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4548 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4549 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4550 om12=dxi*dxj+dyi*dyj+dzi*dzj
4552 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4553 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4559 deltat12=om2-om1+2.0d0
4561 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4562 & +akct*deltad*deltat12+ebr
4563 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4564 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4565 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4566 c & " deltat12",deltat12," eij",eij
4567 ed=2*akcm*deltad+akct*deltat12
4569 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4570 eom1=-2*akth*deltat1-pom1-om2*pom2
4571 eom2= 2*akth*deltat2+pom1-om1*pom2
4574 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4575 ghpbx(k,i)=ghpbx(k,i)-ggk
4576 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4577 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4578 ghpbx(k,j)=ghpbx(k,j)+ggk
4579 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4580 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4581 ghpbc(k,i)=ghpbc(k,i)-ggk
4582 ghpbc(k,j)=ghpbc(k,j)+ggk
4585 C Calculate the components of the gradient in DC and X
4589 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4594 C--------------------------------------------------------------------------
4595 subroutine ebond(estr)
4597 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4599 implicit real*8 (a-h,o-z)
4600 include 'DIMENSIONS'
4601 include 'COMMON.LOCAL'
4602 include 'COMMON.GEO'
4603 include 'COMMON.INTERACT'
4604 include 'COMMON.DERIV'
4605 include 'COMMON.VAR'
4606 include 'COMMON.CHAIN'
4607 include 'COMMON.IOUNITS'
4608 include 'COMMON.NAMES'
4609 include 'COMMON.FFIELD'
4610 include 'COMMON.CONTROL'
4611 include 'COMMON.SETUP'
4612 double precision u(3),ud(3)
4614 do i=ibondp_start,ibondp_end
4615 diff = vbld(i)-vbldp0
4616 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4617 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4618 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4621 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4623 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4627 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4629 do i=ibond_start,ibond_end
4634 diff=vbld(i+nres)-vbldsc0(1,iti)
4635 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4636 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4637 if (energy_dec) then
4639 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4640 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4643 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4645 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4649 diff=vbld(i+nres)-vbldsc0(j,iti)
4650 ud(j)=aksc(j,iti)*diff
4651 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4665 uprod2=uprod2*u(k)*u(k)
4669 usumsqder=usumsqder+ud(j)*uprod2
4671 estr=estr+uprod/usum
4673 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4681 C--------------------------------------------------------------------------
4682 subroutine ebend(etheta)
4684 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4685 C angles gamma and its derivatives in consecutive thetas and gammas.
4687 implicit real*8 (a-h,o-z)
4688 include 'DIMENSIONS'
4689 include 'COMMON.LOCAL'
4690 include 'COMMON.GEO'
4691 include 'COMMON.INTERACT'
4692 include 'COMMON.DERIV'
4693 include 'COMMON.VAR'
4694 include 'COMMON.CHAIN'
4695 include 'COMMON.IOUNITS'
4696 include 'COMMON.NAMES'
4697 include 'COMMON.FFIELD'
4698 include 'COMMON.CONTROL'
4699 common /calcthet/ term1,term2,termm,diffak,ratak,
4700 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4701 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4702 double precision y(2),z(2)
4704 c time11=dexp(-2*time)
4707 c write (*,'(a,i2)') 'EBEND ICG=',icg
4708 do i=ithet_start,ithet_end
4709 C Zero the energy function and its derivative at 0 or pi.
4710 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4715 if (phii.ne.phii) phii=150.0
4728 if (phii1.ne.phii1) phii1=150.0
4740 C Calculate the "mean" value of theta from the part of the distribution
4741 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4742 C In following comments this theta will be referred to as t_c.
4743 thet_pred_mean=0.0d0
4747 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4749 dthett=thet_pred_mean*ssd
4750 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4751 C Derivatives of the "mean" values in gamma1 and gamma2.
4752 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4753 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4754 if (theta(i).gt.pi-delta) then
4755 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4757 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4758 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4759 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4761 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4763 else if (theta(i).lt.delta) then
4764 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4765 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4766 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4768 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4769 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4772 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4775 etheta=etheta+ethetai
4776 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4778 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4779 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4780 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4782 C Ufff.... We've done all this!!!
4785 C---------------------------------------------------------------------------
4786 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4788 implicit real*8 (a-h,o-z)
4789 include 'DIMENSIONS'
4790 include 'COMMON.LOCAL'
4791 include 'COMMON.IOUNITS'
4792 common /calcthet/ term1,term2,termm,diffak,ratak,
4793 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4794 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4795 C Calculate the contributions to both Gaussian lobes.
4796 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4797 C The "polynomial part" of the "standard deviation" of this part of
4801 sig=sig*thet_pred_mean+polthet(j,it)
4803 C Derivative of the "interior part" of the "standard deviation of the"
4804 C gamma-dependent Gaussian lobe in t_c.
4805 sigtc=3*polthet(3,it)
4807 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4810 C Set the parameters of both Gaussian lobes of the distribution.
4811 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4812 fac=sig*sig+sigc0(it)
4815 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4816 sigsqtc=-4.0D0*sigcsq*sigtc
4817 c print *,i,sig,sigtc,sigsqtc
4818 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4819 sigtc=-sigtc/(fac*fac)
4820 C Following variable is sigma(t_c)**(-2)
4821 sigcsq=sigcsq*sigcsq
4823 sig0inv=1.0D0/sig0i**2
4824 delthec=thetai-thet_pred_mean
4825 delthe0=thetai-theta0i
4826 term1=-0.5D0*sigcsq*delthec*delthec
4827 term2=-0.5D0*sig0inv*delthe0*delthe0
4828 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4829 C NaNs in taking the logarithm. We extract the largest exponent which is added
4830 C to the energy (this being the log of the distribution) at the end of energy
4831 C term evaluation for this virtual-bond angle.
4832 if (term1.gt.term2) then
4834 term2=dexp(term2-termm)
4838 term1=dexp(term1-termm)
4841 C The ratio between the gamma-independent and gamma-dependent lobes of
4842 C the distribution is a Gaussian function of thet_pred_mean too.
4843 diffak=gthet(2,it)-thet_pred_mean
4844 ratak=diffak/gthet(3,it)**2
4845 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4846 C Let's differentiate it in thet_pred_mean NOW.
4848 C Now put together the distribution terms to make complete distribution.
4849 termexp=term1+ak*term2
4850 termpre=sigc+ak*sig0i
4851 C Contribution of the bending energy from this theta is just the -log of
4852 C the sum of the contributions from the two lobes and the pre-exponential
4853 C factor. Simple enough, isn't it?
4854 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4855 C NOW the derivatives!!!
4856 C 6/6/97 Take into account the deformation.
4857 E_theta=(delthec*sigcsq*term1
4858 & +ak*delthe0*sig0inv*term2)/termexp
4859 E_tc=((sigtc+aktc*sig0i)/termpre
4860 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4861 & aktc*term2)/termexp)
4864 c-----------------------------------------------------------------------------
4865 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4866 implicit real*8 (a-h,o-z)
4867 include 'DIMENSIONS'
4868 include 'COMMON.LOCAL'
4869 include 'COMMON.IOUNITS'
4870 common /calcthet/ term1,term2,termm,diffak,ratak,
4871 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4872 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4873 delthec=thetai-thet_pred_mean
4874 delthe0=thetai-theta0i
4875 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4876 t3 = thetai-thet_pred_mean
4880 t14 = t12+t6*sigsqtc
4882 t21 = thetai-theta0i
4888 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4889 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4890 & *(-t12*t9-ak*sig0inv*t27)
4894 C--------------------------------------------------------------------------
4895 subroutine ebend(etheta)
4897 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4898 C angles gamma and its derivatives in consecutive thetas and gammas.
4899 C ab initio-derived potentials from
4900 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4902 implicit real*8 (a-h,o-z)
4903 include 'DIMENSIONS'
4904 include 'COMMON.LOCAL'
4905 include 'COMMON.GEO'
4906 include 'COMMON.INTERACT'
4907 include 'COMMON.DERIV'
4908 include 'COMMON.VAR'
4909 include 'COMMON.CHAIN'
4910 include 'COMMON.IOUNITS'
4911 include 'COMMON.NAMES'
4912 include 'COMMON.FFIELD'
4913 include 'COMMON.CONTROL'
4914 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4915 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4916 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4917 & sinph1ph2(maxdouble,maxdouble)
4918 logical lprn /.false./, lprn1 /.false./
4920 c write (iout,*) "EBEND ithet_start",ithet_start,
4921 c & " ithet_end",ithet_end
4922 do i=ithet_start,ithet_end
4923 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4924 &(itype(i).eq.ntyp1)) cycle
4928 theti2=0.5d0*theta(i)
4929 ityp2=ithetyp(itype(i-1))
4931 coskt(k)=dcos(k*theti2)
4932 sinkt(k)=dsin(k*theti2)
4935 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4938 if (phii.ne.phii) phii=150.0
4942 ityp1=ithetyp(itype(i-2))
4944 cosph1(k)=dcos(k*phii)
4945 sinph1(k)=dsin(k*phii)
4949 ityp1=ithetyp(itype(i-2))
4955 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4958 if (phii1.ne.phii1) phii1=150.0
4963 ityp3=ithetyp(itype(i))
4965 cosph2(k)=dcos(k*phii1)
4966 sinph2(k)=dsin(k*phii1)
4970 ityp3=ithetyp(itype(i))
4976 ethetai=aa0thet(ityp1,ityp2,ityp3)
4979 ccl=cosph1(l)*cosph2(k-l)
4980 ssl=sinph1(l)*sinph2(k-l)
4981 scl=sinph1(l)*cosph2(k-l)
4982 csl=cosph1(l)*sinph2(k-l)
4983 cosph1ph2(l,k)=ccl-ssl
4984 cosph1ph2(k,l)=ccl+ssl
4985 sinph1ph2(l,k)=scl+csl
4986 sinph1ph2(k,l)=scl-csl
4990 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4991 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4992 write (iout,*) "coskt and sinkt"
4994 write (iout,*) k,coskt(k),sinkt(k)
4998 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4999 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5002 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5003 & " ethetai",ethetai
5006 write (iout,*) "cosph and sinph"
5008 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5010 write (iout,*) "cosph1ph2 and sinph2ph2"
5013 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5014 & sinph1ph2(l,k),sinph1ph2(k,l)
5017 write(iout,*) "ethetai",ethetai
5021 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5022 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5023 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5024 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5025 ethetai=ethetai+sinkt(m)*aux
5026 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5027 dephii=dephii+k*sinkt(m)*(
5028 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5029 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5030 dephii1=dephii1+k*sinkt(m)*(
5031 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5032 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5034 & write (iout,*) "m",m," k",k," bbthet",
5035 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5036 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5037 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5038 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5042 & write(iout,*) "ethetai",ethetai
5046 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5047 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5048 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5049 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5050 ethetai=ethetai+sinkt(m)*aux
5051 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5052 dephii=dephii+l*sinkt(m)*(
5053 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5054 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5055 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5056 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5057 dephii1=dephii1+(k-l)*sinkt(m)*(
5058 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5059 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5060 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5061 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5063 write (iout,*) "m",m," k",k," l",l," ffthet",
5064 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5065 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5066 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5067 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5068 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5069 & cosph1ph2(k,l)*sinkt(m),
5070 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5077 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5078 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5079 & phii1*rad2deg,ethetai
5081 etheta=etheta+ethetai
5082 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5084 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5085 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5086 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5092 c-----------------------------------------------------------------------------
5093 subroutine esc(escloc)
5094 C Calculate the local energy of a side chain and its derivatives in the
5095 C corresponding virtual-bond valence angles THETA and the spherical angles
5097 implicit real*8 (a-h,o-z)
5098 include 'DIMENSIONS'
5099 include 'COMMON.GEO'
5100 include 'COMMON.LOCAL'
5101 include 'COMMON.VAR'
5102 include 'COMMON.INTERACT'
5103 include 'COMMON.DERIV'
5104 include 'COMMON.CHAIN'
5105 include 'COMMON.IOUNITS'
5106 include 'COMMON.NAMES'
5107 include 'COMMON.FFIELD'
5108 include 'COMMON.CONTROL'
5109 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5110 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5111 common /sccalc/ time11,time12,time112,theti,it,nlobit
5114 c write (iout,'(a)') 'ESC'
5115 do i=loc_start,loc_end
5117 if (it.eq.10) goto 1
5119 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5120 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5121 theti=theta(i+1)-pipol
5126 if (x(2).gt.pi-delta) then
5130 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5132 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5133 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5135 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5136 & ddersc0(1),dersc(1))
5137 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5138 & ddersc0(3),dersc(3))
5140 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5142 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5143 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5144 & dersc0(2),esclocbi,dersc02)
5145 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5147 call splinthet(x(2),0.5d0*delta,ss,ssd)
5152 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5154 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5155 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5157 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5159 c write (iout,*) escloci
5160 else if (x(2).lt.delta) then
5164 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5166 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5167 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5169 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5170 & ddersc0(1),dersc(1))
5171 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5172 & ddersc0(3),dersc(3))
5174 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5176 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5177 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5178 & dersc0(2),esclocbi,dersc02)
5179 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5184 call splinthet(x(2),0.5d0*delta,ss,ssd)
5186 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5188 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5189 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5191 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5192 c write (iout,*) escloci
5194 call enesc(x,escloci,dersc,ddummy,.false.)
5197 escloc=escloc+escloci
5198 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5199 & 'escloc',i,escloci
5200 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5202 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5204 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5205 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5210 C---------------------------------------------------------------------------
5211 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5212 implicit real*8 (a-h,o-z)
5213 include 'DIMENSIONS'
5214 include 'COMMON.GEO'
5215 include 'COMMON.LOCAL'
5216 include 'COMMON.IOUNITS'
5217 common /sccalc/ time11,time12,time112,theti,it,nlobit
5218 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5219 double precision contr(maxlob,-1:1)
5221 c write (iout,*) 'it=',it,' nlobit=',nlobit
5225 if (mixed) ddersc(j)=0.0d0
5229 C Because of periodicity of the dependence of the SC energy in omega we have
5230 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5231 C To avoid underflows, first compute & store the exponents.
5239 z(k)=x(k)-censc(k,j,it)
5244 Axk=Axk+gaussc(l,k,j,it)*z(l)
5250 expfac=expfac+Ax(k,j,iii)*z(k)
5258 C As in the case of ebend, we want to avoid underflows in exponentiation and
5259 C subsequent NaNs and INFs in energy calculation.
5260 C Find the largest exponent
5264 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5268 cd print *,'it=',it,' emin=',emin
5270 C Compute the contribution to SC energy and derivatives
5275 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5276 if(adexp.ne.adexp) adexp=1.0
5279 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5281 cd print *,'j=',j,' expfac=',expfac
5282 escloc_i=escloc_i+expfac
5284 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5288 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5289 & +gaussc(k,2,j,it))*expfac
5296 dersc(1)=dersc(1)/cos(theti)**2
5297 ddersc(1)=ddersc(1)/cos(theti)**2
5300 escloci=-(dlog(escloc_i)-emin)
5302 dersc(j)=dersc(j)/escloc_i
5306 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5311 C------------------------------------------------------------------------------
5312 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5313 implicit real*8 (a-h,o-z)
5314 include 'DIMENSIONS'
5315 include 'COMMON.GEO'
5316 include 'COMMON.LOCAL'
5317 include 'COMMON.IOUNITS'
5318 common /sccalc/ time11,time12,time112,theti,it,nlobit
5319 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5320 double precision contr(maxlob)
5331 z(k)=x(k)-censc(k,j,it)
5337 Axk=Axk+gaussc(l,k,j,it)*z(l)
5343 expfac=expfac+Ax(k,j)*z(k)
5348 C As in the case of ebend, we want to avoid underflows in exponentiation and
5349 C subsequent NaNs and INFs in energy calculation.
5350 C Find the largest exponent
5353 if (emin.gt.contr(j)) emin=contr(j)
5357 C Compute the contribution to SC energy and derivatives
5361 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5362 escloc_i=escloc_i+expfac
5364 dersc(k)=dersc(k)+Ax(k,j)*expfac
5366 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5367 & +gaussc(1,2,j,it))*expfac
5371 dersc(1)=dersc(1)/cos(theti)**2
5372 dersc12=dersc12/cos(theti)**2
5373 escloci=-(dlog(escloc_i)-emin)
5375 dersc(j)=dersc(j)/escloc_i
5377 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5381 c----------------------------------------------------------------------------------
5382 subroutine esc(escloc)
5383 C Calculate the local energy of a side chain and its derivatives in the
5384 C corresponding virtual-bond valence angles THETA and the spherical angles
5385 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5386 C added by Urszula Kozlowska. 07/11/2007
5388 implicit real*8 (a-h,o-z)
5389 include 'DIMENSIONS'
5390 include 'COMMON.GEO'
5391 include 'COMMON.LOCAL'
5392 include 'COMMON.VAR'
5393 include 'COMMON.SCROT'
5394 include 'COMMON.INTERACT'
5395 include 'COMMON.DERIV'
5396 include 'COMMON.CHAIN'
5397 include 'COMMON.IOUNITS'
5398 include 'COMMON.NAMES'
5399 include 'COMMON.FFIELD'
5400 include 'COMMON.CONTROL'
5401 include 'COMMON.VECTORS'
5402 double precision x_prime(3),y_prime(3),z_prime(3)
5403 & , sumene,dsc_i,dp2_i,x(65),
5404 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5405 & de_dxx,de_dyy,de_dzz,de_dt
5406 double precision s1_t,s1_6_t,s2_t,s2_6_t
5408 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5409 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5410 & dt_dCi(3),dt_dCi1(3)
5411 common /sccalc/ time11,time12,time112,theti,it,nlobit
5414 c write(iout,*) "ESC: loc_start",loc_start," loc_end",loc_end
5415 do i=loc_start,loc_end
5416 costtab(i+1) =dcos(theta(i+1))
5417 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5418 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5419 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5420 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5421 cosfac=dsqrt(cosfac2)
5422 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5423 sinfac=dsqrt(sinfac2)
5425 if (it.eq.10) goto 1
5427 C Compute the axes of tghe local cartesian coordinates system; store in
5428 c x_prime, y_prime and z_prime
5435 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5436 C & dc_norm(3,i+nres)
5438 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5439 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5442 z_prime(j) = -uz(j,i-1)
5445 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5446 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5447 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5448 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5449 c & " xy",scalar(x_prime(1),y_prime(1)),
5450 c & " xz",scalar(x_prime(1),z_prime(1)),
5451 c & " yy",scalar(y_prime(1),y_prime(1)),
5452 c & " yz",scalar(y_prime(1),z_prime(1)),
5453 c & " zz",scalar(z_prime(1),z_prime(1))
5455 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5456 C to local coordinate system. Store in xx, yy, zz.
5462 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5463 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5464 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5471 C Compute the energy of the ith side cbain
5473 c write (2,*) "xx",xx," yy",yy," zz",zz
5476 x(j) = sc_parmin(j,it)
5479 Cc diagnostics - remove later
5481 yy1 = dsin(alph(2))*dcos(omeg(2))
5482 zz1 = -dsin(alph(2))*dsin(omeg(2))
5483 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5484 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5486 C," --- ", xx_w,yy_w,zz_w
5489 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5490 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5492 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5493 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5495 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5496 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5497 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5498 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5499 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5501 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5502 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5503 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5504 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5505 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5507 dsc_i = 0.743d0+x(61)
5509 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5510 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5511 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5512 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5513 s1=(1+x(63))/(0.1d0 + dscp1)
5514 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5515 s2=(1+x(65))/(0.1d0 + dscp2)
5516 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5517 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5518 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5519 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5521 c & dscp1,dscp2,sumene
5522 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5523 escloc = escloc + sumene
5524 c write (2,*) "i",i," escloc",sumene,escloc
5527 C This section to check the numerical derivatives of the energy of ith side
5528 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5529 C #define DEBUG in the code to turn it on.
5531 write (2,*) "sumene =",sumene
5535 write (2,*) xx,yy,zz
5536 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5537 de_dxx_num=(sumenep-sumene)/aincr
5539 write (2,*) "xx+ sumene from enesc=",sumenep
5542 write (2,*) xx,yy,zz
5543 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5544 de_dyy_num=(sumenep-sumene)/aincr
5546 write (2,*) "yy+ sumene from enesc=",sumenep
5549 write (2,*) xx,yy,zz
5550 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5551 de_dzz_num=(sumenep-sumene)/aincr
5553 write (2,*) "zz+ sumene from enesc=",sumenep
5554 costsave=cost2tab(i+1)
5555 sintsave=sint2tab(i+1)
5556 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5557 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5558 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5559 de_dt_num=(sumenep-sumene)/aincr
5560 write (2,*) " t+ sumene from enesc=",sumenep
5561 cost2tab(i+1)=costsave
5562 sint2tab(i+1)=sintsave
5563 C End of diagnostics section.
5566 C Compute the gradient of esc
5568 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5569 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5570 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5571 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5572 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5573 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5574 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5575 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5576 pom1=(sumene3*sint2tab(i+1)+sumene1)
5577 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5578 pom2=(sumene4*cost2tab(i+1)+sumene2)
5579 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5580 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5581 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5582 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5584 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5585 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5586 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5588 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5589 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5590 & +(pom1+pom2)*pom_dx
5592 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5595 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5596 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5597 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5599 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5600 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5601 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5602 & +x(59)*zz**2 +x(60)*xx*zz
5603 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5604 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5605 & +(pom1-pom2)*pom_dy
5607 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5610 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5611 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5612 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5613 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5614 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5615 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5616 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5617 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5619 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5622 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5623 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5624 & +pom1*pom_dt1+pom2*pom_dt2
5626 write(2,*), "de_dt = ", de_dt,de_dt_num
5630 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5631 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5632 cosfac2xx=cosfac2*xx
5633 sinfac2yy=sinfac2*yy
5635 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5637 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5639 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5640 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5641 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5642 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5643 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5644 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5645 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5646 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5647 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5648 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5652 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5653 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5656 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5657 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5658 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5660 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5661 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5665 dXX_Ctab(k,i)=dXX_Ci(k)
5666 dXX_C1tab(k,i)=dXX_Ci1(k)
5667 dYY_Ctab(k,i)=dYY_Ci(k)
5668 dYY_C1tab(k,i)=dYY_Ci1(k)
5669 dZZ_Ctab(k,i)=dZZ_Ci(k)
5670 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5671 dXX_XYZtab(k,i)=dXX_XYZ(k)
5672 dYY_XYZtab(k,i)=dYY_XYZ(k)
5673 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5677 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5678 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5679 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5680 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5681 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5683 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5684 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5685 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5686 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5687 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5688 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5689 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5690 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5692 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5693 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5695 C to check gradient call subroutine check_grad
5701 c------------------------------------------------------------------------------
5702 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5704 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5705 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5706 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5707 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5709 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5710 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5712 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5713 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5714 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5715 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5716 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5718 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5719 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5720 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5721 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5722 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5724 dsc_i = 0.743d0+x(61)
5726 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5727 & *(xx*cost2+yy*sint2))
5728 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5729 & *(xx*cost2-yy*sint2))
5730 s1=(1+x(63))/(0.1d0 + dscp1)
5731 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5732 s2=(1+x(65))/(0.1d0 + dscp2)
5733 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5734 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5735 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5740 c------------------------------------------------------------------------------
5741 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5743 C This procedure calculates two-body contact function g(rij) and its derivative:
5746 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5749 C where x=(rij-r0ij)/delta
5751 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5754 double precision rij,r0ij,eps0ij,fcont,fprimcont
5755 double precision x,x2,x4,delta
5759 if (x.lt.-1.0D0) then
5762 else if (x.le.1.0D0) then
5765 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5766 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5773 c------------------------------------------------------------------------------
5774 subroutine splinthet(theti,delta,ss,ssder)
5775 implicit real*8 (a-h,o-z)
5776 include 'DIMENSIONS'
5777 include 'COMMON.VAR'
5778 include 'COMMON.GEO'
5781 if (theti.gt.pipol) then
5782 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5784 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5789 c------------------------------------------------------------------------------
5790 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5792 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5793 double precision ksi,ksi2,ksi3,a1,a2,a3
5794 a1=fprim0*delta/(f1-f0)
5800 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5801 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5804 c------------------------------------------------------------------------------
5805 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5807 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5808 double precision ksi,ksi2,ksi3,a1,a2,a3
5813 a2=3*(f1x-f0x)-2*fprim0x*delta
5814 a3=fprim0x*delta-2*(f1x-f0x)
5815 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5818 C-----------------------------------------------------------------------------
5820 C-----------------------------------------------------------------------------
5821 subroutine etor(etors,edihcnstr)
5822 implicit real*8 (a-h,o-z)
5823 include 'DIMENSIONS'
5824 include 'COMMON.VAR'
5825 include 'COMMON.GEO'
5826 include 'COMMON.LOCAL'
5827 include 'COMMON.TORSION'
5828 include 'COMMON.INTERACT'
5829 include 'COMMON.DERIV'
5830 include 'COMMON.CHAIN'
5831 include 'COMMON.NAMES'
5832 include 'COMMON.IOUNITS'
5833 include 'COMMON.FFIELD'
5834 include 'COMMON.TORCNSTR'
5835 include 'COMMON.CONTROL'
5837 C Set lprn=.true. for debugging
5841 do i=iphi_start,iphi_end
5843 itori=itortyp(itype(i-2))
5844 itori1=itortyp(itype(i-1))
5847 C Proline-Proline pair is a special case...
5848 if (itori.eq.3 .and. itori1.eq.3) then
5849 if (phii.gt.-dwapi3) then
5851 fac=1.0D0/(1.0D0-cosphi)
5852 etorsi=v1(1,3,3)*fac
5853 etorsi=etorsi+etorsi
5854 etors=etors+etorsi-v1(1,3,3)
5855 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5856 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5859 v1ij=v1(j+1,itori,itori1)
5860 v2ij=v2(j+1,itori,itori1)
5863 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5864 if (energy_dec) etors_ii=etors_ii+
5865 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5866 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5870 v1ij=v1(j,itori,itori1)
5871 v2ij=v2(j,itori,itori1)
5874 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5875 if (energy_dec) etors_ii=etors_ii+
5876 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5877 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5880 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5883 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5884 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5885 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5886 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5887 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5889 ! 6/20/98 - dihedral angle constraints
5892 itori=idih_constr(i)
5895 if (difi.gt.drange(i)) then
5897 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5898 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5899 else if (difi.lt.-drange(i)) then
5901 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5902 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5904 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5905 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5907 ! write (iout,*) 'edihcnstr',edihcnstr
5910 c------------------------------------------------------------------------------
5911 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5912 subroutine e_modeller(ehomology_constr)
5913 ehomology_constr=0.0d0
5914 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5917 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5919 c------------------------------------------------------------------------------
5920 subroutine etor_d(etors_d)
5924 c----------------------------------------------------------------------------
5926 subroutine etor(etors,edihcnstr)
5927 implicit real*8 (a-h,o-z)
5928 include 'DIMENSIONS'
5929 include 'COMMON.VAR'
5930 include 'COMMON.GEO'
5931 include 'COMMON.LOCAL'
5932 include 'COMMON.TORSION'
5933 include 'COMMON.INTERACT'
5934 include 'COMMON.DERIV'
5935 include 'COMMON.CHAIN'
5936 include 'COMMON.NAMES'
5937 include 'COMMON.IOUNITS'
5938 include 'COMMON.FFIELD'
5939 include 'COMMON.TORCNSTR'
5940 include 'COMMON.CONTROL'
5942 C Set lprn=.true. for debugging
5946 do i=iphi_start,iphi_end
5948 itori=itortyp(itype(i-2))
5949 itori1=itortyp(itype(i-1))
5952 C Regular cosine and sine terms
5953 do j=1,nterm(itori,itori1)
5954 v1ij=v1(j,itori,itori1)
5955 v2ij=v2(j,itori,itori1)
5958 etors=etors+v1ij*cosphi+v2ij*sinphi
5959 if (energy_dec) etors_ii=etors_ii+
5960 & v1ij*cosphi+v2ij*sinphi
5961 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5965 C E = SUM ----------------------------------- - v1
5966 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5968 cosphi=dcos(0.5d0*phii)
5969 sinphi=dsin(0.5d0*phii)
5970 do j=1,nlor(itori,itori1)
5971 vl1ij=vlor1(j,itori,itori1)
5972 vl2ij=vlor2(j,itori,itori1)
5973 vl3ij=vlor3(j,itori,itori1)
5974 pom=vl2ij*cosphi+vl3ij*sinphi
5975 pom1=1.0d0/(pom*pom+1.0d0)
5976 etors=etors+vl1ij*pom1
5977 if (energy_dec) etors_ii=etors_ii+
5980 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5982 C Subtract the constant term
5983 etors=etors-v0(itori,itori1)
5984 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5985 & 'etor',i,etors_ii-v0(itori,itori1)
5987 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5988 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5989 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5990 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5991 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5993 ! 6/20/98 - dihedral angle constraints
5995 c do i=1,ndih_constr
5996 do i=idihconstr_start,idihconstr_end
5997 itori=idih_constr(i)
5999 difi=pinorm(phii-phi0(i))
6000 if (difi.gt.drange(i)) then
6002 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6003 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6004 else if (difi.lt.-drange(i)) then
6006 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6007 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6011 c write (iout,*) "gloci", gloc(i-3,icg)
6012 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6013 cd & rad2deg*phi0(i), rad2deg*drange(i),
6014 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6016 cd write (iout,*) 'edihcnstr',edihcnstr
6019 c----------------------------------------------------------------------------
6020 c MODELLER restraint function
6021 subroutine e_modeller(ehomology_constr)
6022 implicit real*8 (a-h,o-z)
6023 include 'DIMENSIONS'
6025 integer nnn, i, j, k, ki, irec, l
6026 integer katy, odleglosci, test7
6027 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
6029 real*8 distance(max_template),distancek(max_template),
6030 & min_odl,godl(max_template),dih_diff(max_template)
6033 c FP - 30/10/2014 Temporary specifications for homology restraints
6035 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
6037 double precision, dimension (maxres) :: guscdiff,usc_diff
6038 double precision, dimension (max_template) ::
6039 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
6043 include 'COMMON.SBRIDGE'
6044 include 'COMMON.CHAIN'
6045 include 'COMMON.GEO'
6046 include 'COMMON.DERIV'
6047 include 'COMMON.LOCAL'
6048 include 'COMMON.INTERACT'
6049 include 'COMMON.VAR'
6050 include 'COMMON.IOUNITS'
6052 include 'COMMON.CONTROL'
6054 c From subroutine Econstr_back
6056 include 'COMMON.NAMES'
6057 include 'COMMON.TIME1'
6062 distancek(i)=9999999.9
6068 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6070 C AL 5/2/14 - Introduce list of restraints
6071 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6073 write(iout,*) "------- dist restrs start -------"
6075 do ii = link_start_homo,link_end_homo
6079 c write (iout,*) "dij(",i,j,") =",dij
6081 do k=1,constr_homology
6082 c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
6083 if(.not.l_homo(k,ii)) then
6087 distance(k)=odl(k,ii)-dij
6088 c write (iout,*) "distance(",k,") =",distance(k)
6090 c For Gaussian-type Urestr
6092 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6093 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6094 c write (iout,*) "distancek(",k,") =",distancek(k)
6095 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6097 c For Lorentzian-type Urestr
6099 if (waga_dist.lt.0.0d0) then
6100 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6101 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6102 & (distance(k)**2+sigma_odlir(k,ii)**2))
6105 c write (iout,*) "distance: ii",ii," nexl",nexl
6108 c min_odl=minval(distancek)
6109 do kk=1,constr_homology
6110 if(l_homo(kk,ii)) then
6111 min_odl=distancek(kk)
6115 do kk=1,constr_homology
6116 if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
6117 & min_odl=distancek(kk)
6119 c write (iout,* )"min_odl",min_odl
6121 write (iout,*) "ij dij",i,j,dij
6122 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6123 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6124 write (iout,* )"min_odl",min_odl
6129 if (waga_dist.ge.0.0d0) then
6135 do k=1,constr_homology
6136 c Nie wiem po co to liczycie jeszcze raz!
6137 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6138 c & (2*(sigma_odl(i,j,k))**2))
6139 if(.not.l_homo(k,ii)) cycle
6140 if (waga_dist.ge.0.0d0) then
6142 c For Gaussian-type Urestr
6144 godl(k)=dexp(-distancek(k)+min_odl)
6145 odleg2=odleg2+godl(k)
6147 c For Lorentzian-type Urestr
6150 odleg2=odleg2+distancek(k)
6153 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6154 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6155 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6156 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6159 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6160 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6162 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6163 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6165 if (waga_dist.ge.0.0d0) then
6167 c For Gaussian-type Urestr
6169 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6171 c For Lorentzian-type Urestr
6174 odleg=odleg+odleg2/constr_homology
6177 c write (iout,*) "odleg",odleg ! sum of -ln-s
6180 c For Gaussian-type Urestr
6182 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6184 do k=1,constr_homology
6185 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6186 c & *waga_dist)+min_odl
6187 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6189 if(.not.l_homo(k,ii)) cycle
6190 if (waga_dist.ge.0.0d0) then
6191 c For Gaussian-type Urestr
6193 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6195 c For Lorentzian-type Urestr
6198 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6199 & sigma_odlir(k,ii)**2)**2)
6201 sum_sgodl=sum_sgodl+sgodl
6203 c sgodl2=sgodl2+sgodl
6204 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6205 c write(iout,*) "constr_homology=",constr_homology
6206 c write(iout,*) i, j, k, "TEST K"
6208 if (waga_dist.ge.0.0d0) then
6210 c For Gaussian-type Urestr
6212 grad_odl3=waga_homology(iset)*waga_dist
6213 & *sum_sgodl/(sum_godl*dij)
6215 c For Lorentzian-type Urestr
6218 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6219 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6220 grad_odl3=-waga_homology(iset)*waga_dist*
6221 & sum_sgodl/(constr_homology*dij)
6224 c grad_odl3=sum_sgodl/(sum_godl*dij)
6227 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6228 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6229 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6231 ccc write(iout,*) godl, sgodl, grad_odl3
6233 c grad_odl=grad_odl+grad_odl3
6236 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6237 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6238 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6239 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6240 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6241 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6242 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6243 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6244 c if (i.eq.25.and.j.eq.27) then
6245 c write(iout,*) "jik",jik,"i",i,"j",j
6246 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
6247 c write(iout,*) "grad_odl3",grad_odl3
6248 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
6249 c write(iout,*) "ggodl",ggodl
6250 c write(iout,*) "ghpbc(",jik,i,")",
6251 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
6255 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6256 ccc & dLOG(odleg2),"-odleg=", -odleg
6258 enddo ! ii-loop for dist
6260 write(iout,*) "------- dist restrs end -------"
6261 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
6262 c & waga_d.eq.1.0d0) call sum_gradient
6264 c Pseudo-energy and gradient from dihedral-angle restraints from
6265 c homology templates
6266 c write (iout,*) "End of distance loop"
6269 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6271 write(iout,*) "------- dih restrs start -------"
6272 do i=idihconstr_start_homo,idihconstr_end_homo
6273 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
6276 do i=idihconstr_start_homo,idihconstr_end_homo
6277 c betai=beta(i,i+1,i+2,i+3)
6279 c write (iout,*) "betai =",betai
6281 do k=1,constr_homology
6282 dih_diff(k)=pinorm(dih(k,i)-betai)
6283 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
6284 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6285 c & -(6.28318-dih_diff(i,k))
6286 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6287 c & 6.28318+dih_diff(i,k)
6289 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6291 kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6293 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
6296 c write(iout,*) "i",i," k",k," sigma",sigma_dih(k,i),
6297 c & " kat2=", kat2, "gdih=",gdih(k)
6299 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
6300 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
6302 write (iout,*) "i",i," betai",betai," kat2",kat2
6303 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6305 if (kat2.le.1.0d-14) cycle
6306 kat=kat-dLOG(kat2/constr_homology)
6307 c write (iout,*) "kat",kat ! sum of -ln-s
6309 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6310 ccc & dLOG(kat2), "-kat=", -kat
6312 c ----------------------------------------------------------------------
6314 c ----------------------------------------------------------------------
6318 do k=1,constr_homology
6320 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
6322 sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
6324 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
6325 sum_sgdih=sum_sgdih+sgdih
6327 c grad_dih3=sum_sgdih/sum_gdih
6328 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
6330 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6331 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6332 ccc & gloc(nphi+i-3,icg)
6333 gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
6335 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
6337 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6338 ccc & gloc(nphi+i-3,icg)
6340 enddo ! i-loop for dih
6342 write(iout,*) "------- dih restrs end -------"
6345 c Pseudo-energy and gradient for theta angle restraints from
6346 c homology templates
6347 c FP 01/15 - inserted from econstr_local_test.F, loop structure
6351 c For constr_homology reference structures (FP)
6353 c Uconst_back_tot=0.0d0
6356 c Econstr_back legacy
6358 c do i=ithet_start,ithet_end
6361 c do i=loc_start,loc_end
6364 duscdiffx(j,i)=0.0d0
6369 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
6370 c write (iout,*) "waga_theta",waga_theta
6371 if (waga_theta.gt.0.0d0) then
6373 write (iout,*) "usampl",usampl
6374 write(iout,*) "------- theta restrs start -------"
6375 c do i=ithet_start,ithet_end
6376 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
6379 c write (iout,*) "maxres",maxres,"nres",nres
6381 do i=ithet_start,ithet_end
6384 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
6386 c Deviation of theta angles wrt constr_homology ref structures
6388 utheta_i=0.0d0 ! argument of Gaussian for single k
6389 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6390 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
6391 c over residues in a fragment
6392 c write (iout,*) "theta(",i,")=",theta(i)
6393 do k=1,constr_homology
6395 c dtheta_i=theta(j)-thetaref(j,iref)
6396 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
6397 theta_diff(k)=thetatpl(k,i)-theta(i)
6399 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
6400 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
6401 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
6402 gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
6403 c write (iout,*) "i",i," k",k," sigma_theta",sigma_theta(k,i),
6404 c & " gtheta",gtheta(k)
6405 c Gradient for single Gaussian restraint in subr Econstr_back
6406 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
6409 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
6410 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
6413 c Gradient for multiple Gaussian restraint
6414 sum_gtheta=gutheta_i
6416 do k=1,constr_homology
6417 c New generalized expr for multiple Gaussian from Econstr_back
6418 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
6420 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
6421 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
6423 c Final value of gradient using same var as in Econstr_back
6424 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
6425 & +sum_sgtheta/sum_gtheta*waga_theta
6426 & *waga_homology(iset)
6427 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
6428 c & *waga_homology(iset)
6429 c dutheta(i)=sum_sgtheta/sum_gtheta
6431 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
6432 Eval=Eval-dLOG(gutheta_i/constr_homology)
6433 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
6434 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
6435 c Uconst_back=Uconst_back+utheta(i)
6436 enddo ! (i-loop for theta)
6438 write(iout,*) "------- theta restrs end -------"
6442 c Deviation of local SC geometry
6444 c Separation of two i-loops (instructed by AL - 11/3/2014)
6446 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
6447 c write (iout,*) "waga_d",waga_d
6450 write(iout,*) "------- SC restrs start -------"
6451 write (iout,*) "Initial duscdiff,duscdiffx"
6452 do i=loc_start,loc_end
6453 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
6454 & (duscdiffx(jik,i),jik=1,3)
6457 do i=loc_start,loc_end
6458 usc_diff_i=0.0d0 ! argument of Gaussian for single k
6459 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6460 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
6461 c write(iout,*) "xxtab, yytab, zztab"
6462 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
6463 do k=1,constr_homology
6465 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6466 c Original sign inverted for calc of gradients (s. Econstr_back)
6467 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6468 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6469 c write(iout,*) "dxx, dyy, dzz"
6470 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6472 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
6473 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
6474 c uscdiffk(k)=usc_diff(i)
6475 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
6476 c write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
6477 c & " guscdiff2",guscdiff2(k)
6478 guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
6479 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
6480 c & xxref(j),yyref(j),zzref(j)
6485 c Generalized expression for multiple Gaussian acc to that for a single
6486 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
6488 c Original implementation
6489 c sum_guscdiff=guscdiff(i)
6491 c sum_sguscdiff=0.0d0
6492 c do k=1,constr_homology
6493 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
6494 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
6495 c sum_sguscdiff=sum_sguscdiff+sguscdiff
6498 c Implementation of new expressions for gradient (Jan. 2015)
6500 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
6501 do k=1,constr_homology
6503 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
6504 c before. Now the drivatives should be correct
6506 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6507 c Original sign inverted for calc of gradients (s. Econstr_back)
6508 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6509 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6511 c New implementation
6513 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
6514 & sigma_d(k,i) ! for the grad wrt r'
6515 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
6518 c New implementation
6519 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
6521 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
6522 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
6523 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
6524 duscdiff(jik,i)=duscdiff(jik,i)+
6525 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
6526 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
6527 duscdiffx(jik,i)=duscdiffx(jik,i)+
6528 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
6529 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
6532 write(iout,*) "jik",jik,"i",i
6533 write(iout,*) "dxx, dyy, dzz"
6534 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6535 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
6536 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
6537 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
6538 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
6539 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
6540 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
6541 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
6542 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
6543 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
6544 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
6545 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
6546 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
6547 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
6548 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
6554 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
6555 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
6557 c write (iout,*) i," uscdiff",uscdiff(i)
6559 c Put together deviations from local geometry
6561 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
6562 c & wfrag_back(3,i,iset)*uscdiff(i)
6563 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
6564 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
6565 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
6566 c Uconst_back=Uconst_back+usc_diff(i)
6568 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
6570 c New implment: multiplied by sum_sguscdiff
6573 enddo ! (i-loop for dscdiff)
6578 write(iout,*) "------- SC restrs end -------"
6579 write (iout,*) "------ After SC loop in e_modeller ------"
6580 do i=loc_start,loc_end
6581 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
6582 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
6584 if (waga_theta.eq.1.0d0) then
6585 write (iout,*) "in e_modeller after SC restr end: dutheta"
6586 do i=ithet_start,ithet_end
6587 write (iout,*) i,dutheta(i)
6590 if (waga_d.eq.1.0d0) then
6591 write (iout,*) "e_modeller after SC loop: duscdiff/x"
6593 write (iout,*) i,(duscdiff(j,i),j=1,3)
6594 write (iout,*) i,(duscdiffx(j,i),j=1,3)
6599 c Total energy from homology restraints
6601 write (iout,*) "odleg",odleg," kat",kat
6604 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
6606 c ehomology_constr=odleg+kat
6608 c For Lorentzian-type Urestr
6611 if (waga_dist.ge.0.0d0) then
6613 c For Gaussian-type Urestr
6615 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
6616 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6617 c write (iout,*) "ehomology_constr=",ehomology_constr
6620 c For Lorentzian-type Urestr
6622 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
6623 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6624 c write (iout,*) "ehomology_constr=",ehomology_constr
6627 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
6628 & "Eval",waga_theta,eval,
6629 & "Erot",waga_d,Erot
6630 write (iout,*) "ehomology_constr",ehomology_constr
6636 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6637 747 format(a12,i4,i4,i4,f8.3,f8.3)
6638 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6639 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6640 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6641 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6644 c------------------------------------------------------------------------------
6645 subroutine etor_d(etors_d)
6646 C 6/23/01 Compute double torsional energy
6647 implicit real*8 (a-h,o-z)
6648 include 'DIMENSIONS'
6649 include 'COMMON.VAR'
6650 include 'COMMON.GEO'
6651 include 'COMMON.LOCAL'
6652 include 'COMMON.TORSION'
6653 include 'COMMON.INTERACT'
6654 include 'COMMON.DERIV'
6655 include 'COMMON.CHAIN'
6656 include 'COMMON.NAMES'
6657 include 'COMMON.IOUNITS'
6658 include 'COMMON.FFIELD'
6659 include 'COMMON.TORCNSTR'
6660 include 'COMMON.CONTROL'
6662 C Set lprn=.true. for debugging
6666 do i=iphid_start,iphid_end
6668 itori=itortyp(itype(i-2))
6669 itori1=itortyp(itype(i-1))
6670 itori2=itortyp(itype(i))
6675 do j=1,ntermd_1(itori,itori1,itori2)
6676 v1cij=v1c(1,j,itori,itori1,itori2)
6677 v1sij=v1s(1,j,itori,itori1,itori2)
6678 v2cij=v1c(2,j,itori,itori1,itori2)
6679 v2sij=v1s(2,j,itori,itori1,itori2)
6680 cosphi1=dcos(j*phii)
6681 sinphi1=dsin(j*phii)
6682 cosphi2=dcos(j*phii1)
6683 sinphi2=dsin(j*phii1)
6684 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6685 & v2cij*cosphi2+v2sij*sinphi2
6686 if (energy_dec) etors_d_ii=etors_d_ii+
6687 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6688 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6689 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6691 do k=2,ntermd_2(itori,itori1,itori2)
6693 v1cdij = v2c(k,l,itori,itori1,itori2)
6694 v2cdij = v2c(l,k,itori,itori1,itori2)
6695 v1sdij = v2s(k,l,itori,itori1,itori2)
6696 v2sdij = v2s(l,k,itori,itori1,itori2)
6697 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6698 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6699 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6700 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6701 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6702 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6703 if (energy_dec) etors_d_ii=etors_d_ii+
6704 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6705 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6706 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6707 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6708 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6709 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6712 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6713 & 'etor_d',i,etors_d_ii
6714 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6715 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6716 c write (iout,*) "gloci", gloc(i-3,icg)
6721 c------------------------------------------------------------------------------
6722 subroutine eback_sc_corr(esccor)
6723 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6724 c conformational states; temporarily implemented as differences
6725 c between UNRES torsional potentials (dependent on three types of
6726 c residues) and the torsional potentials dependent on all 20 types
6727 c of residues computed from AM1 energy surfaces of terminally-blocked
6728 c amino-acid residues.
6729 implicit real*8 (a-h,o-z)
6730 include 'DIMENSIONS'
6731 include 'COMMON.VAR'
6732 include 'COMMON.GEO'
6733 include 'COMMON.LOCAL'
6734 include 'COMMON.TORSION'
6735 include 'COMMON.SCCOR'
6736 include 'COMMON.INTERACT'
6737 include 'COMMON.DERIV'
6738 include 'COMMON.CHAIN'
6739 include 'COMMON.NAMES'
6740 include 'COMMON.IOUNITS'
6741 include 'COMMON.FFIELD'
6742 include 'COMMON.CONTROL'
6744 C Set lprn=.true. for debugging
6747 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6749 do i=itau_start,itau_end
6751 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6752 isccori=isccortyp(itype(i-2))
6753 isccori1=isccortyp(itype(i-1))
6755 cccc Added 9 May 2012
6756 cc Tauangle is torsional engle depending on the value of first digit
6757 c(see comment below)
6758 cc Omicron is flat angle depending on the value of first digit
6759 c(see comment below)
6762 do intertyp=1,3 !intertyp
6763 cc Added 09 May 2012 (Adasko)
6764 cc Intertyp means interaction type of backbone mainchain correlation:
6765 c 1 = SC...Ca...Ca...Ca
6766 c 2 = Ca...Ca...Ca...SC
6767 c 3 = SC...Ca...Ca...SCi
6769 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6770 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6771 & (itype(i-1).eq.21)))
6772 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6773 & .or.(itype(i-2).eq.21)))
6774 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6775 & (itype(i-1).eq.21)))) cycle
6776 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6777 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6779 do j=1,nterm_sccor(isccori,isccori1)
6780 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6781 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6782 cosphi=dcos(j*tauangle(intertyp,i))
6783 sinphi=dsin(j*tauangle(intertyp,i))
6784 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6785 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6787 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6788 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6789 c &gloc_sc(intertyp,i-3,icg)
6791 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6792 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6793 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6794 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6795 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6799 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6803 c----------------------------------------------------------------------------
6804 subroutine multibody(ecorr)
6805 C This subroutine calculates multi-body contributions to energy following
6806 C the idea of Skolnick et al. If side chains I and J make a contact and
6807 C at the same time side chains I+1 and J+1 make a contact, an extra
6808 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6809 implicit real*8 (a-h,o-z)
6810 include 'DIMENSIONS'
6811 include 'COMMON.IOUNITS'
6812 include 'COMMON.DERIV'
6813 include 'COMMON.INTERACT'
6814 include 'COMMON.CONTACTS'
6815 double precision gx(3),gx1(3)
6818 C Set lprn=.true. for debugging
6822 write (iout,'(a)') 'Contact function values:'
6824 write (iout,'(i2,20(1x,i2,f10.5))')
6825 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6840 num_conti=num_cont(i)
6841 num_conti1=num_cont(i1)
6846 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6847 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6848 cd & ' ishift=',ishift
6849 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6850 C The system gains extra energy.
6851 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6852 endif ! j1==j+-ishift
6861 c------------------------------------------------------------------------------
6862 double precision function esccorr(i,j,k,l,jj,kk)
6863 implicit real*8 (a-h,o-z)
6864 include 'DIMENSIONS'
6865 include 'COMMON.IOUNITS'
6866 include 'COMMON.DERIV'
6867 include 'COMMON.INTERACT'
6868 include 'COMMON.CONTACTS'
6869 double precision gx(3),gx1(3)
6874 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6875 C Calculate the multi-body contribution to energy.
6876 C Calculate multi-body contributions to the gradient.
6877 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6878 cd & k,l,(gacont(m,kk,k),m=1,3)
6880 gx(m) =ekl*gacont(m,jj,i)
6881 gx1(m)=eij*gacont(m,kk,k)
6882 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6883 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6884 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6885 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6889 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6894 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6900 c------------------------------------------------------------------------------
6901 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6902 C This subroutine calculates multi-body contributions to hydrogen-bonding
6903 implicit real*8 (a-h,o-z)
6904 include 'DIMENSIONS'
6905 include 'COMMON.IOUNITS'
6908 parameter (max_cont=maxconts)
6909 parameter (max_dim=26)
6910 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6911 double precision zapas(max_dim,maxconts,max_fg_procs),
6912 & zapas_recv(max_dim,maxconts,max_fg_procs)
6913 common /przechowalnia/ zapas
6914 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6915 & status_array(MPI_STATUS_SIZE,maxconts*2)
6917 include 'COMMON.SETUP'
6918 include 'COMMON.FFIELD'
6919 include 'COMMON.DERIV'
6920 include 'COMMON.INTERACT'
6921 include 'COMMON.CONTACTS'
6922 include 'COMMON.CONTROL'
6923 include 'COMMON.LOCAL'
6924 double precision gx(3),gx1(3),time00
6927 C Set lprn=.true. for debugging
6932 if (nfgtasks.le.1) goto 30
6934 write (iout,'(a)') 'Contact function values before RECEIVE:'
6936 write (iout,'(2i3,50(1x,i2,f5.2))')
6937 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6938 & j=1,num_cont_hb(i))
6942 do i=1,ntask_cont_from
6945 do i=1,ntask_cont_to
6948 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6950 C Make the list of contacts to send to send to other procesors
6951 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6953 do i=iturn3_start,iturn3_end
6954 c write (iout,*) "make contact list turn3",i," num_cont",
6956 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6958 do i=iturn4_start,iturn4_end
6959 c write (iout,*) "make contact list turn4",i," num_cont",
6961 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6965 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6967 do j=1,num_cont_hb(i)
6970 iproc=iint_sent_local(k,jjc,ii)
6971 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6972 if (iproc.gt.0) then
6973 ncont_sent(iproc)=ncont_sent(iproc)+1
6974 nn=ncont_sent(iproc)
6976 zapas(2,nn,iproc)=jjc
6977 zapas(3,nn,iproc)=facont_hb(j,i)
6978 zapas(4,nn,iproc)=ees0p(j,i)
6979 zapas(5,nn,iproc)=ees0m(j,i)
6980 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6981 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6982 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6983 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6984 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6985 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6986 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6987 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6988 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6989 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6990 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6991 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6992 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6993 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6994 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6995 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6996 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6997 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6998 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6999 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7000 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7007 & "Numbers of contacts to be sent to other processors",
7008 & (ncont_sent(i),i=1,ntask_cont_to)
7009 write (iout,*) "Contacts sent"
7010 do ii=1,ntask_cont_to
7012 iproc=itask_cont_to(ii)
7013 write (iout,*) nn," contacts to processor",iproc,
7014 & " of CONT_TO_COMM group"
7016 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7024 CorrelID1=nfgtasks+fg_rank+1
7026 C Receive the numbers of needed contacts from other processors
7027 do ii=1,ntask_cont_from
7028 iproc=itask_cont_from(ii)
7030 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7031 & FG_COMM,req(ireq),IERR)
7033 c write (iout,*) "IRECV ended"
7035 C Send the number of contacts needed by other processors
7036 do ii=1,ntask_cont_to
7037 iproc=itask_cont_to(ii)
7039 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7040 & FG_COMM,req(ireq),IERR)
7042 c write (iout,*) "ISEND ended"
7043 c write (iout,*) "number of requests (nn)",ireq
7046 & call MPI_Waitall(ireq,req,status_array,ierr)
7048 c & "Numbers of contacts to be received from other processors",
7049 c & (ncont_recv(i),i=1,ntask_cont_from)
7053 do ii=1,ntask_cont_from
7054 iproc=itask_cont_from(ii)
7056 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7057 c & " of CONT_TO_COMM group"
7061 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7062 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7063 c write (iout,*) "ireq,req",ireq,req(ireq)
7066 C Send the contacts to processors that need them
7067 do ii=1,ntask_cont_to
7068 iproc=itask_cont_to(ii)
7070 c write (iout,*) nn," contacts to processor",iproc,
7071 c & " of CONT_TO_COMM group"
7074 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7075 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7076 c write (iout,*) "ireq,req",ireq,req(ireq)
7078 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7082 c write (iout,*) "number of requests (contacts)",ireq
7083 c write (iout,*) "req",(req(i),i=1,4)
7086 & call MPI_Waitall(ireq,req,status_array,ierr)
7087 do iii=1,ntask_cont_from
7088 iproc=itask_cont_from(iii)
7091 write (iout,*) "Received",nn," contacts from processor",iproc,
7092 & " of CONT_FROM_COMM group"
7095 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7100 ii=zapas_recv(1,i,iii)
7101 c Flag the received contacts to prevent double-counting
7102 jj=-zapas_recv(2,i,iii)
7103 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7105 nnn=num_cont_hb(ii)+1
7108 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7109 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7110 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7111 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7112 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7113 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7114 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7115 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7116 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7117 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7118 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7119 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7120 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7121 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7122 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7123 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7124 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7125 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7126 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7127 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7128 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7129 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7130 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7131 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7136 write (iout,'(a)') 'Contact function values after receive:'
7138 write (iout,'(2i3,50(1x,i3,f5.2))')
7139 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7140 & j=1,num_cont_hb(i))
7147 write (iout,'(a)') 'Contact function values:'
7149 write (iout,'(2i3,50(1x,i3,f5.2))')
7150 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7151 & j=1,num_cont_hb(i))
7155 C Remove the loop below after debugging !!!
7162 C Calculate the local-electrostatic correlation terms
7163 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7165 num_conti=num_cont_hb(i)
7166 num_conti1=num_cont_hb(i+1)
7173 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7174 c & ' jj=',jj,' kk=',kk
7175 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7176 & .or. j.lt.0 .and. j1.gt.0) .and.
7177 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7178 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7179 C The system gains extra energy.
7180 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7181 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7182 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7184 else if (j1.eq.j) then
7185 C Contacts I-J and I-(J+1) occur simultaneously.
7186 C The system loses extra energy.
7187 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7192 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7193 c & ' jj=',jj,' kk=',kk
7195 C Contacts I-J and (I+1)-J occur simultaneously.
7196 C The system loses extra energy.
7197 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7204 c------------------------------------------------------------------------------
7205 subroutine add_hb_contact(ii,jj,itask)
7206 implicit real*8 (a-h,o-z)
7207 include "DIMENSIONS"
7208 include "COMMON.IOUNITS"
7211 parameter (max_cont=maxconts)
7212 parameter (max_dim=26)
7213 include "COMMON.CONTACTS"
7214 double precision zapas(max_dim,maxconts,max_fg_procs),
7215 & zapas_recv(max_dim,maxconts,max_fg_procs)
7216 common /przechowalnia/ zapas
7217 integer i,j,ii,jj,iproc,itask(4),nn
7218 c write (iout,*) "itask",itask
7221 if (iproc.gt.0) then
7222 do j=1,num_cont_hb(ii)
7224 c write (iout,*) "i",ii," j",jj," jjc",jjc
7226 ncont_sent(iproc)=ncont_sent(iproc)+1
7227 nn=ncont_sent(iproc)
7228 zapas(1,nn,iproc)=ii
7229 zapas(2,nn,iproc)=jjc
7230 zapas(3,nn,iproc)=facont_hb(j,ii)
7231 zapas(4,nn,iproc)=ees0p(j,ii)
7232 zapas(5,nn,iproc)=ees0m(j,ii)
7233 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7234 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7235 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7236 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7237 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7238 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7239 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7240 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7241 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7242 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7243 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7244 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7245 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7246 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7247 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7248 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7249 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7250 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7251 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7252 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7253 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7261 c------------------------------------------------------------------------------
7262 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7264 C This subroutine calculates multi-body contributions to hydrogen-bonding
7265 implicit real*8 (a-h,o-z)
7266 include 'DIMENSIONS'
7267 include 'COMMON.IOUNITS'
7270 parameter (max_cont=maxconts)
7271 parameter (max_dim=70)
7272 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7273 double precision zapas(max_dim,maxconts,max_fg_procs),
7274 & zapas_recv(max_dim,maxconts,max_fg_procs)
7275 common /przechowalnia/ zapas
7276 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7277 & status_array(MPI_STATUS_SIZE,maxconts*2)
7279 include 'COMMON.SETUP'
7280 include 'COMMON.FFIELD'
7281 include 'COMMON.DERIV'
7282 include 'COMMON.LOCAL'
7283 include 'COMMON.INTERACT'
7284 include 'COMMON.CONTACTS'
7285 include 'COMMON.CHAIN'
7286 include 'COMMON.CONTROL'
7287 double precision gx(3),gx1(3)
7288 integer num_cont_hb_old(maxres)
7290 double precision eello4,eello5,eelo6,eello_turn6
7291 external eello4,eello5,eello6,eello_turn6
7292 C Set lprn=.true. for debugging
7297 num_cont_hb_old(i)=num_cont_hb(i)
7301 if (nfgtasks.le.1) goto 30
7303 write (iout,'(a)') 'Contact function values before RECEIVE:'
7305 write (iout,'(2i3,50(1x,i2,f5.2))')
7306 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7307 & j=1,num_cont_hb(i))
7311 do i=1,ntask_cont_from
7314 do i=1,ntask_cont_to
7317 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7319 C Make the list of contacts to send to send to other procesors
7320 do i=iturn3_start,iturn3_end
7321 c write (iout,*) "make contact list turn3",i," num_cont",
7323 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7325 do i=iturn4_start,iturn4_end
7326 c write (iout,*) "make contact list turn4",i," num_cont",
7328 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7332 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7334 do j=1,num_cont_hb(i)
7337 iproc=iint_sent_local(k,jjc,ii)
7338 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7339 if (iproc.ne.0) then
7340 ncont_sent(iproc)=ncont_sent(iproc)+1
7341 nn=ncont_sent(iproc)
7343 zapas(2,nn,iproc)=jjc
7344 zapas(3,nn,iproc)=d_cont(j,i)
7348 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7353 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7361 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7372 & "Numbers of contacts to be sent to other processors",
7373 & (ncont_sent(i),i=1,ntask_cont_to)
7374 write (iout,*) "Contacts sent"
7375 do ii=1,ntask_cont_to
7377 iproc=itask_cont_to(ii)
7378 write (iout,*) nn," contacts to processor",iproc,
7379 & " of CONT_TO_COMM group"
7381 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7389 CorrelID1=nfgtasks+fg_rank+1
7391 C Receive the numbers of needed contacts from other processors
7392 do ii=1,ntask_cont_from
7393 iproc=itask_cont_from(ii)
7395 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7396 & FG_COMM,req(ireq),IERR)
7398 c write (iout,*) "IRECV ended"
7400 C Send the number of contacts needed by other processors
7401 do ii=1,ntask_cont_to
7402 iproc=itask_cont_to(ii)
7404 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7405 & FG_COMM,req(ireq),IERR)
7407 c write (iout,*) "ISEND ended"
7408 c write (iout,*) "number of requests (nn)",ireq
7411 & call MPI_Waitall(ireq,req,status_array,ierr)
7413 c & "Numbers of contacts to be received from other processors",
7414 c & (ncont_recv(i),i=1,ntask_cont_from)
7418 do ii=1,ntask_cont_from
7419 iproc=itask_cont_from(ii)
7421 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7422 c & " of CONT_TO_COMM group"
7426 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7427 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7428 c write (iout,*) "ireq,req",ireq,req(ireq)
7431 C Send the contacts to processors that need them
7432 do ii=1,ntask_cont_to
7433 iproc=itask_cont_to(ii)
7435 c write (iout,*) nn," contacts to processor",iproc,
7436 c & " of CONT_TO_COMM group"
7439 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7440 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7441 c write (iout,*) "ireq,req",ireq,req(ireq)
7443 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7447 c write (iout,*) "number of requests (contacts)",ireq
7448 c write (iout,*) "req",(req(i),i=1,4)
7451 & call MPI_Waitall(ireq,req,status_array,ierr)
7452 do iii=1,ntask_cont_from
7453 iproc=itask_cont_from(iii)
7456 write (iout,*) "Received",nn," contacts from processor",iproc,
7457 & " of CONT_FROM_COMM group"
7460 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7465 ii=zapas_recv(1,i,iii)
7466 c Flag the received contacts to prevent double-counting
7467 jj=-zapas_recv(2,i,iii)
7468 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7470 nnn=num_cont_hb(ii)+1
7473 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7477 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7482 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7490 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7499 write (iout,'(a)') 'Contact function values after receive:'
7501 write (iout,'(2i3,50(1x,i3,5f6.3))')
7502 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7503 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7510 write (iout,'(a)') 'Contact function values:'
7512 write (iout,'(2i3,50(1x,i2,5f6.3))')
7513 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7514 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7520 C Remove the loop below after debugging !!!
7527 C Calculate the dipole-dipole interaction energies
7528 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7529 do i=iatel_s,iatel_e+1
7530 num_conti=num_cont_hb(i)
7539 C Calculate the local-electrostatic correlation terms
7540 c write (iout,*) "gradcorr5 in eello5 before loop"
7542 c write (iout,'(i5,3f10.5)')
7543 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7545 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7546 c write (iout,*) "corr loop i",i
7548 num_conti=num_cont_hb(i)
7549 num_conti1=num_cont_hb(i+1)
7556 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7557 c & ' jj=',jj,' kk=',kk
7558 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7559 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7560 & .or. j.lt.0 .and. j1.gt.0) .and.
7561 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7562 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7563 C The system gains extra energy.
7565 sqd1=dsqrt(d_cont(jj,i))
7566 sqd2=dsqrt(d_cont(kk,i1))
7567 sred_geom = sqd1*sqd2
7568 IF (sred_geom.lt.cutoff_corr) THEN
7569 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7571 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7572 cd & ' jj=',jj,' kk=',kk
7573 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7574 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7576 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7577 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7580 cd write (iout,*) 'sred_geom=',sred_geom,
7581 cd & ' ekont=',ekont,' fprim=',fprimcont,
7582 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7583 cd write (iout,*) "g_contij",g_contij
7584 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7585 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7586 call calc_eello(i,jp,i+1,jp1,jj,kk)
7587 if (wcorr4.gt.0.0d0)
7588 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7589 if (energy_dec.and.wcorr4.gt.0.0d0)
7590 1 write (iout,'(a6,4i5,0pf7.3)')
7591 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7592 c write (iout,*) "gradcorr5 before eello5"
7594 c write (iout,'(i5,3f10.5)')
7595 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7597 if (wcorr5.gt.0.0d0)
7598 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7599 c write (iout,*) "gradcorr5 after eello5"
7601 c write (iout,'(i5,3f10.5)')
7602 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7604 if (energy_dec.and.wcorr5.gt.0.0d0)
7605 1 write (iout,'(a6,4i5,0pf7.3)')
7606 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7607 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7608 cd write(2,*)'ijkl',i,jp,i+1,jp1
7609 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7610 & .or. wturn6.eq.0.0d0))then
7611 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7612 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7613 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7614 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7615 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7616 cd & 'ecorr6=',ecorr6
7617 cd write (iout,'(4e15.5)') sred_geom,
7618 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7619 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7620 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7621 else if (wturn6.gt.0.0d0
7622 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7623 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7624 eturn6=eturn6+eello_turn6(i,jj,kk)
7625 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7626 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7627 cd write (2,*) 'multibody_eello:eturn6',eturn6
7636 num_cont_hb(i)=num_cont_hb_old(i)
7638 c write (iout,*) "gradcorr5 in eello5"
7640 c write (iout,'(i5,3f10.5)')
7641 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7645 c------------------------------------------------------------------------------
7646 subroutine add_hb_contact_eello(ii,jj,itask)
7647 implicit real*8 (a-h,o-z)
7648 include "DIMENSIONS"
7649 include "COMMON.IOUNITS"
7652 parameter (max_cont=maxconts)
7653 parameter (max_dim=70)
7654 include "COMMON.CONTACTS"
7655 double precision zapas(max_dim,maxconts,max_fg_procs),
7656 & zapas_recv(max_dim,maxconts,max_fg_procs)
7657 common /przechowalnia/ zapas
7658 integer i,j,ii,jj,iproc,itask(4),nn
7659 c write (iout,*) "itask",itask
7662 if (iproc.gt.0) then
7663 do j=1,num_cont_hb(ii)
7665 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7667 ncont_sent(iproc)=ncont_sent(iproc)+1
7668 nn=ncont_sent(iproc)
7669 zapas(1,nn,iproc)=ii
7670 zapas(2,nn,iproc)=jjc
7671 zapas(3,nn,iproc)=d_cont(j,ii)
7675 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7680 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7688 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7700 c------------------------------------------------------------------------------
7701 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7702 implicit real*8 (a-h,o-z)
7703 include 'DIMENSIONS'
7704 include 'COMMON.IOUNITS'
7705 include 'COMMON.DERIV'
7706 include 'COMMON.INTERACT'
7707 include 'COMMON.CONTACTS'
7708 double precision gx(3),gx1(3)
7718 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7719 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7720 C Following 4 lines for diagnostics.
7725 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7726 c & 'Contacts ',i,j,
7727 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7728 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7730 C Calculate the multi-body contribution to energy.
7731 c ecorr=ecorr+ekont*ees
7732 C Calculate multi-body contributions to the gradient.
7733 coeffpees0pij=coeffp*ees0pij
7734 coeffmees0mij=coeffm*ees0mij
7735 coeffpees0pkl=coeffp*ees0pkl
7736 coeffmees0mkl=coeffm*ees0mkl
7738 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7739 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7740 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7741 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7742 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7743 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7744 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7745 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7746 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7747 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7748 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7749 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7750 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7751 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7752 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7753 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7754 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7755 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7756 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7757 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7758 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7759 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7760 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7761 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7762 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7767 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7768 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7769 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7770 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7775 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7776 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7777 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7778 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7781 c write (iout,*) "ehbcorr",ekont*ees
7786 C---------------------------------------------------------------------------
7787 subroutine dipole(i,j,jj)
7788 implicit real*8 (a-h,o-z)
7789 include 'DIMENSIONS'
7790 include 'COMMON.IOUNITS'
7791 include 'COMMON.CHAIN'
7792 include 'COMMON.FFIELD'
7793 include 'COMMON.DERIV'
7794 include 'COMMON.INTERACT'
7795 include 'COMMON.CONTACTS'
7796 include 'COMMON.TORSION'
7797 include 'COMMON.VAR'
7798 include 'COMMON.GEO'
7799 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7801 iti1 = itortyp(itype(i+1))
7802 if (j.lt.nres-1) then
7803 itj1 = itortyp(itype(j+1))
7808 dipi(iii,1)=Ub2(iii,i)
7809 dipderi(iii)=Ub2der(iii,i)
7810 dipi(iii,2)=b1(iii,iti1)
7811 dipj(iii,1)=Ub2(iii,j)
7812 dipderj(iii)=Ub2der(iii,j)
7813 dipj(iii,2)=b1(iii,itj1)
7817 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7820 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7827 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7831 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7836 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7837 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7839 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7841 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7843 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7848 C---------------------------------------------------------------------------
7849 subroutine calc_eello(i,j,k,l,jj,kk)
7851 C This subroutine computes matrices and vectors needed to calculate
7852 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7854 implicit real*8 (a-h,o-z)
7855 include 'DIMENSIONS'
7856 include 'COMMON.IOUNITS'
7857 include 'COMMON.CHAIN'
7858 include 'COMMON.DERIV'
7859 include 'COMMON.INTERACT'
7860 include 'COMMON.CONTACTS'
7861 include 'COMMON.TORSION'
7862 include 'COMMON.VAR'
7863 include 'COMMON.GEO'
7864 include 'COMMON.FFIELD'
7865 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7866 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7869 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7870 cd & ' jj=',jj,' kk=',kk
7871 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7872 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7873 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7876 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7877 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7880 call transpose2(aa1(1,1),aa1t(1,1))
7881 call transpose2(aa2(1,1),aa2t(1,1))
7884 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7885 & aa1tder(1,1,lll,kkk))
7886 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7887 & aa2tder(1,1,lll,kkk))
7891 C parallel orientation of the two CA-CA-CA frames.
7893 iti=itortyp(itype(i))
7897 itk1=itortyp(itype(k+1))
7898 itj=itortyp(itype(j))
7899 if (l.lt.nres-1) then
7900 itl1=itortyp(itype(l+1))
7904 C A1 kernel(j+1) A2T
7906 cd write (iout,'(3f10.5,5x,3f10.5)')
7907 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7909 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7910 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7911 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7912 C Following matrices are needed only for 6-th order cumulants
7913 IF (wcorr6.gt.0.0d0) THEN
7914 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7915 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7916 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7917 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7918 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7919 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7920 & ADtEAderx(1,1,1,1,1,1))
7922 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7923 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7924 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7925 & ADtEA1derx(1,1,1,1,1,1))
7927 C End 6-th order cumulants
7930 cd write (2,*) 'In calc_eello6'
7932 cd write (2,*) 'iii=',iii
7934 cd write (2,*) 'kkk=',kkk
7936 cd write (2,'(3(2f10.5),5x)')
7937 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7942 call transpose2(EUgder(1,1,k),auxmat(1,1))
7943 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7944 call transpose2(EUg(1,1,k),auxmat(1,1))
7945 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7946 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7950 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7951 & EAEAderx(1,1,lll,kkk,iii,1))
7955 C A1T kernel(i+1) A2
7956 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7957 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7958 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7959 C Following matrices are needed only for 6-th order cumulants
7960 IF (wcorr6.gt.0.0d0) THEN
7961 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7962 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7963 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7964 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7965 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7966 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7967 & ADtEAderx(1,1,1,1,1,2))
7968 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7969 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7970 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7971 & ADtEA1derx(1,1,1,1,1,2))
7973 C End 6-th order cumulants
7974 call transpose2(EUgder(1,1,l),auxmat(1,1))
7975 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7976 call transpose2(EUg(1,1,l),auxmat(1,1))
7977 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7978 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7982 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7983 & EAEAderx(1,1,lll,kkk,iii,2))
7988 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7989 C They are needed only when the fifth- or the sixth-order cumulants are
7991 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7992 call transpose2(AEA(1,1,1),auxmat(1,1))
7993 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7994 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7995 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7996 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7997 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7998 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7999 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8000 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8001 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8002 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8003 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8004 call transpose2(AEA(1,1,2),auxmat(1,1))
8005 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8006 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8007 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8008 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8009 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8010 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8011 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8012 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8013 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8014 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8015 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8016 C Calculate the Cartesian derivatives of the vectors.
8020 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8021 call matvec2(auxmat(1,1),b1(1,iti),
8022 & AEAb1derx(1,lll,kkk,iii,1,1))
8023 call matvec2(auxmat(1,1),Ub2(1,i),
8024 & AEAb2derx(1,lll,kkk,iii,1,1))
8025 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8026 & AEAb1derx(1,lll,kkk,iii,2,1))
8027 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8028 & AEAb2derx(1,lll,kkk,iii,2,1))
8029 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8030 call matvec2(auxmat(1,1),b1(1,itj),
8031 & AEAb1derx(1,lll,kkk,iii,1,2))
8032 call matvec2(auxmat(1,1),Ub2(1,j),
8033 & AEAb2derx(1,lll,kkk,iii,1,2))
8034 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8035 & AEAb1derx(1,lll,kkk,iii,2,2))
8036 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8037 & AEAb2derx(1,lll,kkk,iii,2,2))
8044 C Antiparallel orientation of the two CA-CA-CA frames.
8046 iti=itortyp(itype(i))
8050 itk1=itortyp(itype(k+1))
8051 itl=itortyp(itype(l))
8052 itj=itortyp(itype(j))
8053 if (j.lt.nres-1) then
8054 itj1=itortyp(itype(j+1))
8058 C A2 kernel(j-1)T A1T
8059 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8060 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8061 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8062 C Following matrices are needed only for 6-th order cumulants
8063 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8064 & j.eq.i+4 .and. l.eq.i+3)) THEN
8065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8066 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8067 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8068 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8069 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8070 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8071 & ADtEAderx(1,1,1,1,1,1))
8072 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8073 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8074 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8075 & ADtEA1derx(1,1,1,1,1,1))
8077 C End 6-th order cumulants
8078 call transpose2(EUgder(1,1,k),auxmat(1,1))
8079 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8080 call transpose2(EUg(1,1,k),auxmat(1,1))
8081 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8082 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8086 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8087 & EAEAderx(1,1,lll,kkk,iii,1))
8091 C A2T kernel(i+1)T A1
8092 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8093 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8094 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8095 C Following matrices are needed only for 6-th order cumulants
8096 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8097 & j.eq.i+4 .and. l.eq.i+3)) THEN
8098 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8099 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8100 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8101 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8102 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8103 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8104 & ADtEAderx(1,1,1,1,1,2))
8105 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8106 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8107 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8108 & ADtEA1derx(1,1,1,1,1,2))
8110 C End 6-th order cumulants
8111 call transpose2(EUgder(1,1,j),auxmat(1,1))
8112 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8113 call transpose2(EUg(1,1,j),auxmat(1,1))
8114 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8115 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8119 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8120 & EAEAderx(1,1,lll,kkk,iii,2))
8125 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8126 C They are needed only when the fifth- or the sixth-order cumulants are
8128 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8129 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8130 call transpose2(AEA(1,1,1),auxmat(1,1))
8131 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8132 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8133 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8134 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8135 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8136 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8137 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8138 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8139 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8140 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8141 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8142 call transpose2(AEA(1,1,2),auxmat(1,1))
8143 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8144 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8145 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8146 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8147 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8148 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8149 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8150 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8151 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8152 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8153 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8154 C Calculate the Cartesian derivatives of the vectors.
8158 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8159 call matvec2(auxmat(1,1),b1(1,iti),
8160 & AEAb1derx(1,lll,kkk,iii,1,1))
8161 call matvec2(auxmat(1,1),Ub2(1,i),
8162 & AEAb2derx(1,lll,kkk,iii,1,1))
8163 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8164 & AEAb1derx(1,lll,kkk,iii,2,1))
8165 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8166 & AEAb2derx(1,lll,kkk,iii,2,1))
8167 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8168 call matvec2(auxmat(1,1),b1(1,itl),
8169 & AEAb1derx(1,lll,kkk,iii,1,2))
8170 call matvec2(auxmat(1,1),Ub2(1,l),
8171 & AEAb2derx(1,lll,kkk,iii,1,2))
8172 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8173 & AEAb1derx(1,lll,kkk,iii,2,2))
8174 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8175 & AEAb2derx(1,lll,kkk,iii,2,2))
8184 C---------------------------------------------------------------------------
8185 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8186 & KK,KKderg,AKA,AKAderg,AKAderx)
8190 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8191 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8192 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8197 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8199 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8202 cd if (lprn) write (2,*) 'In kernel'
8204 cd if (lprn) write (2,*) 'kkk=',kkk
8206 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8207 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8209 cd write (2,*) 'lll=',lll
8210 cd write (2,*) 'iii=1'
8212 cd write (2,'(3(2f10.5),5x)')
8213 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8216 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8217 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8219 cd write (2,*) 'lll=',lll
8220 cd write (2,*) 'iii=2'
8222 cd write (2,'(3(2f10.5),5x)')
8223 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8230 C---------------------------------------------------------------------------
8231 double precision function eello4(i,j,k,l,jj,kk)
8232 implicit real*8 (a-h,o-z)
8233 include 'DIMENSIONS'
8234 include 'COMMON.IOUNITS'
8235 include 'COMMON.CHAIN'
8236 include 'COMMON.DERIV'
8237 include 'COMMON.INTERACT'
8238 include 'COMMON.CONTACTS'
8239 include 'COMMON.TORSION'
8240 include 'COMMON.VAR'
8241 include 'COMMON.GEO'
8242 double precision pizda(2,2),ggg1(3),ggg2(3)
8243 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8247 cd print *,'eello4:',i,j,k,l,jj,kk
8248 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8249 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8250 cold eij=facont_hb(jj,i)
8251 cold ekl=facont_hb(kk,k)
8253 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8254 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8255 gcorr_loc(k-1)=gcorr_loc(k-1)
8256 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8258 gcorr_loc(l-1)=gcorr_loc(l-1)
8259 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8261 gcorr_loc(j-1)=gcorr_loc(j-1)
8262 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8267 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8268 & -EAEAderx(2,2,lll,kkk,iii,1)
8269 cd derx(lll,kkk,iii)=0.0d0
8273 cd gcorr_loc(l-1)=0.0d0
8274 cd gcorr_loc(j-1)=0.0d0
8275 cd gcorr_loc(k-1)=0.0d0
8277 cd write (iout,*)'Contacts have occurred for peptide groups',
8278 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8279 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8280 if (j.lt.nres-1) then
8287 if (l.lt.nres-1) then
8295 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8296 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8297 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8298 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8299 cgrad ghalf=0.5d0*ggg1(ll)
8300 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8301 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8302 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8303 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8304 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8305 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8306 cgrad ghalf=0.5d0*ggg2(ll)
8307 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8308 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8309 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8310 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8311 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8312 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8316 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8321 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8326 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8331 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8335 cd write (2,*) iii,gcorr_loc(iii)
8338 cd write (2,*) 'ekont',ekont
8339 cd write (iout,*) 'eello4',ekont*eel4
8342 C---------------------------------------------------------------------------
8343 double precision function eello5(i,j,k,l,jj,kk)
8344 implicit real*8 (a-h,o-z)
8345 include 'DIMENSIONS'
8346 include 'COMMON.IOUNITS'
8347 include 'COMMON.CHAIN'
8348 include 'COMMON.DERIV'
8349 include 'COMMON.INTERACT'
8350 include 'COMMON.CONTACTS'
8351 include 'COMMON.TORSION'
8352 include 'COMMON.VAR'
8353 include 'COMMON.GEO'
8354 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8355 double precision ggg1(3),ggg2(3)
8356 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8361 C /l\ / \ \ / \ / \ / C
8362 C / \ / \ \ / \ / \ / C
8363 C j| o |l1 | o | o| o | | o |o C
8364 C \ |/k\| |/ \| / |/ \| |/ \| C
8365 C \i/ \ / \ / / \ / \ C
8367 C (I) (II) (III) (IV) C
8369 C eello5_1 eello5_2 eello5_3 eello5_4 C
8371 C Antiparallel chains C
8374 C /j\ / \ \ / \ / \ / C
8375 C / \ / \ \ / \ / \ / C
8376 C j1| o |l | o | o| o | | o |o C
8377 C \ |/k\| |/ \| / |/ \| |/ \| C
8378 C \i/ \ / \ / / \ / \ C
8380 C (I) (II) (III) (IV) C
8382 C eello5_1 eello5_2 eello5_3 eello5_4 C
8384 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8386 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8387 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8392 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8394 itk=itortyp(itype(k))
8395 itl=itortyp(itype(l))
8396 itj=itortyp(itype(j))
8401 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8402 cd & eel5_3_num,eel5_4_num)
8406 derx(lll,kkk,iii)=0.0d0
8410 cd eij=facont_hb(jj,i)
8411 cd ekl=facont_hb(kk,k)
8413 cd write (iout,*)'Contacts have occurred for peptide groups',
8414 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8416 C Contribution from the graph I.
8417 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8418 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8419 call transpose2(EUg(1,1,k),auxmat(1,1))
8420 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8421 vv(1)=pizda(1,1)-pizda(2,2)
8422 vv(2)=pizda(1,2)+pizda(2,1)
8423 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8424 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8425 C Explicit gradient in virtual-dihedral angles.
8426 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8427 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8428 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8429 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8430 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8431 vv(1)=pizda(1,1)-pizda(2,2)
8432 vv(2)=pizda(1,2)+pizda(2,1)
8433 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8434 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8435 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8436 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8437 vv(1)=pizda(1,1)-pizda(2,2)
8438 vv(2)=pizda(1,2)+pizda(2,1)
8440 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8441 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8442 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8444 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8445 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8446 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8448 C Cartesian gradient
8452 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8454 vv(1)=pizda(1,1)-pizda(2,2)
8455 vv(2)=pizda(1,2)+pizda(2,1)
8456 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8457 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8458 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8464 C Contribution from graph II
8465 call transpose2(EE(1,1,itk),auxmat(1,1))
8466 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8467 vv(1)=pizda(1,1)+pizda(2,2)
8468 vv(2)=pizda(2,1)-pizda(1,2)
8469 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8470 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8471 C Explicit gradient in virtual-dihedral angles.
8472 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8473 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8474 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8475 vv(1)=pizda(1,1)+pizda(2,2)
8476 vv(2)=pizda(2,1)-pizda(1,2)
8478 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8479 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8480 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8482 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8483 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8484 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8486 C Cartesian gradient
8490 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8492 vv(1)=pizda(1,1)+pizda(2,2)
8493 vv(2)=pizda(2,1)-pizda(1,2)
8494 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8495 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8496 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8504 C Parallel orientation
8505 C Contribution from graph III
8506 call transpose2(EUg(1,1,l),auxmat(1,1))
8507 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8508 vv(1)=pizda(1,1)-pizda(2,2)
8509 vv(2)=pizda(1,2)+pizda(2,1)
8510 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8511 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8512 C Explicit gradient in virtual-dihedral angles.
8513 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8514 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8515 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8516 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8517 vv(1)=pizda(1,1)-pizda(2,2)
8518 vv(2)=pizda(1,2)+pizda(2,1)
8519 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8520 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8521 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8522 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8523 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8524 vv(1)=pizda(1,1)-pizda(2,2)
8525 vv(2)=pizda(1,2)+pizda(2,1)
8526 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8527 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8528 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8529 C Cartesian gradient
8533 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8535 vv(1)=pizda(1,1)-pizda(2,2)
8536 vv(2)=pizda(1,2)+pizda(2,1)
8537 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8538 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8539 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8544 C Contribution from graph IV
8546 call transpose2(EE(1,1,itl),auxmat(1,1))
8547 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8548 vv(1)=pizda(1,1)+pizda(2,2)
8549 vv(2)=pizda(2,1)-pizda(1,2)
8550 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8551 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8552 C Explicit gradient in virtual-dihedral angles.
8553 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8554 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8555 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8556 vv(1)=pizda(1,1)+pizda(2,2)
8557 vv(2)=pizda(2,1)-pizda(1,2)
8558 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8559 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8560 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8561 C Cartesian gradient
8565 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8567 vv(1)=pizda(1,1)+pizda(2,2)
8568 vv(2)=pizda(2,1)-pizda(1,2)
8569 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8570 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8571 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8576 C Antiparallel orientation
8577 C Contribution from graph III
8579 call transpose2(EUg(1,1,j),auxmat(1,1))
8580 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8581 vv(1)=pizda(1,1)-pizda(2,2)
8582 vv(2)=pizda(1,2)+pizda(2,1)
8583 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8584 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8585 C Explicit gradient in virtual-dihedral angles.
8586 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8587 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8588 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8589 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8590 vv(1)=pizda(1,1)-pizda(2,2)
8591 vv(2)=pizda(1,2)+pizda(2,1)
8592 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8593 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8594 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8595 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8596 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8597 vv(1)=pizda(1,1)-pizda(2,2)
8598 vv(2)=pizda(1,2)+pizda(2,1)
8599 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8600 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8601 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8602 C Cartesian gradient
8606 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8608 vv(1)=pizda(1,1)-pizda(2,2)
8609 vv(2)=pizda(1,2)+pizda(2,1)
8610 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8611 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8612 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8617 C Contribution from graph IV
8619 call transpose2(EE(1,1,itj),auxmat(1,1))
8620 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8621 vv(1)=pizda(1,1)+pizda(2,2)
8622 vv(2)=pizda(2,1)-pizda(1,2)
8623 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8624 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8625 C Explicit gradient in virtual-dihedral angles.
8626 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8627 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8628 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8629 vv(1)=pizda(1,1)+pizda(2,2)
8630 vv(2)=pizda(2,1)-pizda(1,2)
8631 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8632 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8633 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8634 C Cartesian gradient
8638 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8640 vv(1)=pizda(1,1)+pizda(2,2)
8641 vv(2)=pizda(2,1)-pizda(1,2)
8642 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8643 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8644 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8650 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8651 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8652 cd write (2,*) 'ijkl',i,j,k,l
8653 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8654 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8656 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8657 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8658 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8659 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8660 if (j.lt.nres-1) then
8667 if (l.lt.nres-1) then
8677 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8678 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8679 C summed up outside the subrouine as for the other subroutines
8680 C handling long-range interactions. The old code is commented out
8681 C with "cgrad" to keep track of changes.
8683 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8684 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8685 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8686 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8687 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8688 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8689 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8690 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8691 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8692 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8694 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8695 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8696 cgrad ghalf=0.5d0*ggg1(ll)
8698 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8699 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8700 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8701 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8702 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8703 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8704 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8705 cgrad ghalf=0.5d0*ggg2(ll)
8707 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8708 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8709 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8710 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8711 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8712 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8717 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8718 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8723 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8724 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8730 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8735 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8739 cd write (2,*) iii,g_corr5_loc(iii)
8742 cd write (2,*) 'ekont',ekont
8743 cd write (iout,*) 'eello5',ekont*eel5
8746 c--------------------------------------------------------------------------
8747 double precision function eello6(i,j,k,l,jj,kk)
8748 implicit real*8 (a-h,o-z)
8749 include 'DIMENSIONS'
8750 include 'COMMON.IOUNITS'
8751 include 'COMMON.CHAIN'
8752 include 'COMMON.DERIV'
8753 include 'COMMON.INTERACT'
8754 include 'COMMON.CONTACTS'
8755 include 'COMMON.TORSION'
8756 include 'COMMON.VAR'
8757 include 'COMMON.GEO'
8758 include 'COMMON.FFIELD'
8759 double precision ggg1(3),ggg2(3)
8760 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8765 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8773 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8774 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8778 derx(lll,kkk,iii)=0.0d0
8782 cd eij=facont_hb(jj,i)
8783 cd ekl=facont_hb(kk,k)
8789 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8790 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8791 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8792 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8793 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8794 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8796 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8797 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8798 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8799 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8800 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8801 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8805 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8807 C If turn contributions are considered, they will be handled separately.
8808 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8809 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8810 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8811 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8812 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8813 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8814 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8816 if (j.lt.nres-1) then
8823 if (l.lt.nres-1) then
8831 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8832 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8833 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8834 cgrad ghalf=0.5d0*ggg1(ll)
8836 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8837 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8838 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8839 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8840 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8841 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8842 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8843 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8844 cgrad ghalf=0.5d0*ggg2(ll)
8845 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8847 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8848 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8849 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8850 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8851 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8852 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8857 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8858 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8863 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8864 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8870 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8875 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8879 cd write (2,*) iii,g_corr6_loc(iii)
8882 cd write (2,*) 'ekont',ekont
8883 cd write (iout,*) 'eello6',ekont*eel6
8886 c--------------------------------------------------------------------------
8887 double precision function eello6_graph1(i,j,k,l,imat,swap)
8888 implicit real*8 (a-h,o-z)
8889 include 'DIMENSIONS'
8890 include 'COMMON.IOUNITS'
8891 include 'COMMON.CHAIN'
8892 include 'COMMON.DERIV'
8893 include 'COMMON.INTERACT'
8894 include 'COMMON.CONTACTS'
8895 include 'COMMON.TORSION'
8896 include 'COMMON.VAR'
8897 include 'COMMON.GEO'
8898 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8902 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8904 C Parallel Antiparallel
8910 C \ j|/k\| / \ |/k\|l /
8915 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8916 itk=itortyp(itype(k))
8917 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8918 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8919 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8920 call transpose2(EUgC(1,1,k),auxmat(1,1))
8921 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8922 vv1(1)=pizda1(1,1)-pizda1(2,2)
8923 vv1(2)=pizda1(1,2)+pizda1(2,1)
8924 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8925 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8926 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8927 s5=scalar2(vv(1),Dtobr2(1,i))
8928 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8929 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8930 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8931 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8932 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8933 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8934 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8935 & +scalar2(vv(1),Dtobr2der(1,i)))
8936 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8937 vv1(1)=pizda1(1,1)-pizda1(2,2)
8938 vv1(2)=pizda1(1,2)+pizda1(2,1)
8939 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8940 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8942 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8943 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8944 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8945 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8946 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8948 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8949 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8950 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8951 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8952 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8954 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8955 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8956 vv1(1)=pizda1(1,1)-pizda1(2,2)
8957 vv1(2)=pizda1(1,2)+pizda1(2,1)
8958 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8959 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8960 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8961 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8970 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8971 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8972 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8973 call transpose2(EUgC(1,1,k),auxmat(1,1))
8974 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8976 vv1(1)=pizda1(1,1)-pizda1(2,2)
8977 vv1(2)=pizda1(1,2)+pizda1(2,1)
8978 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8979 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8980 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8981 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8982 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8983 s5=scalar2(vv(1),Dtobr2(1,i))
8984 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8990 c----------------------------------------------------------------------------
8991 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8992 implicit real*8 (a-h,o-z)
8993 include 'DIMENSIONS'
8994 include 'COMMON.IOUNITS'
8995 include 'COMMON.CHAIN'
8996 include 'COMMON.DERIV'
8997 include 'COMMON.INTERACT'
8998 include 'COMMON.CONTACTS'
8999 include 'COMMON.TORSION'
9000 include 'COMMON.VAR'
9001 include 'COMMON.GEO'
9003 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9004 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9007 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9009 C Parallel Antiparallel C
9015 C \ j|/k\| \ |/k\|l C
9020 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9021 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9022 C AL 7/4/01 s1 would occur in the sixth-order moment,
9023 C but not in a cluster cumulant
9025 s1=dip(1,jj,i)*dip(1,kk,k)
9027 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9028 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9029 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9030 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9031 call transpose2(EUg(1,1,k),auxmat(1,1))
9032 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9033 vv(1)=pizda(1,1)-pizda(2,2)
9034 vv(2)=pizda(1,2)+pizda(2,1)
9035 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9036 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9038 eello6_graph2=-(s1+s2+s3+s4)
9040 eello6_graph2=-(s2+s3+s4)
9043 C Derivatives in gamma(i-1)
9046 s1=dipderg(1,jj,i)*dip(1,kk,k)
9048 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9049 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9050 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9051 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9053 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9055 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9057 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9059 C Derivatives in gamma(k-1)
9061 s1=dip(1,jj,i)*dipderg(1,kk,k)
9063 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9064 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9065 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9066 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9067 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9068 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9069 vv(1)=pizda(1,1)-pizda(2,2)
9070 vv(2)=pizda(1,2)+pizda(2,1)
9071 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9073 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9075 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9077 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9078 C Derivatives in gamma(j-1) or gamma(l-1)
9081 s1=dipderg(3,jj,i)*dip(1,kk,k)
9083 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9084 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9085 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9086 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9087 vv(1)=pizda(1,1)-pizda(2,2)
9088 vv(2)=pizda(1,2)+pizda(2,1)
9089 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9092 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9094 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9097 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9098 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9100 C Derivatives in gamma(l-1) or gamma(j-1)
9103 s1=dip(1,jj,i)*dipderg(3,kk,k)
9105 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9106 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9107 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9108 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9109 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9110 vv(1)=pizda(1,1)-pizda(2,2)
9111 vv(2)=pizda(1,2)+pizda(2,1)
9112 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9115 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9117 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9120 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9121 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9123 C Cartesian derivatives.
9125 write (2,*) 'In eello6_graph2'
9127 write (2,*) 'iii=',iii
9129 write (2,*) 'kkk=',kkk
9131 write (2,'(3(2f10.5),5x)')
9132 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9142 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9144 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9147 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9149 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9150 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9152 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9153 call transpose2(EUg(1,1,k),auxmat(1,1))
9154 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9156 vv(1)=pizda(1,1)-pizda(2,2)
9157 vv(2)=pizda(1,2)+pizda(2,1)
9158 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9159 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9161 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9163 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9166 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9168 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9175 c----------------------------------------------------------------------------
9176 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9177 implicit real*8 (a-h,o-z)
9178 include 'DIMENSIONS'
9179 include 'COMMON.IOUNITS'
9180 include 'COMMON.CHAIN'
9181 include 'COMMON.DERIV'
9182 include 'COMMON.INTERACT'
9183 include 'COMMON.CONTACTS'
9184 include 'COMMON.TORSION'
9185 include 'COMMON.VAR'
9186 include 'COMMON.GEO'
9187 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9189 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9191 C Parallel Antiparallel C
9197 C j|/k\| / |/k\|l / C
9202 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9204 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9205 C energy moment and not to the cluster cumulant.
9206 iti=itortyp(itype(i))
9207 if (j.lt.nres-1) then
9208 itj1=itortyp(itype(j+1))
9212 itk=itortyp(itype(k))
9213 itk1=itortyp(itype(k+1))
9214 if (l.lt.nres-1) then
9215 itl1=itortyp(itype(l+1))
9220 s1=dip(4,jj,i)*dip(4,kk,k)
9222 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9223 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9224 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9225 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9226 call transpose2(EE(1,1,itk),auxmat(1,1))
9227 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9228 vv(1)=pizda(1,1)+pizda(2,2)
9229 vv(2)=pizda(2,1)-pizda(1,2)
9230 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9231 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9232 cd & "sum",-(s2+s3+s4)
9234 eello6_graph3=-(s1+s2+s3+s4)
9236 eello6_graph3=-(s2+s3+s4)
9239 C Derivatives in gamma(k-1)
9240 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9241 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9242 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9243 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9244 C Derivatives in gamma(l-1)
9245 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9246 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9247 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9248 vv(1)=pizda(1,1)+pizda(2,2)
9249 vv(2)=pizda(2,1)-pizda(1,2)
9250 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9251 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9252 C Cartesian derivatives.
9258 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9260 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9263 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9265 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9266 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9268 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9269 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9271 vv(1)=pizda(1,1)+pizda(2,2)
9272 vv(2)=pizda(2,1)-pizda(1,2)
9273 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9275 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9277 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9280 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9282 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9284 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9290 c----------------------------------------------------------------------------
9291 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9292 implicit real*8 (a-h,o-z)
9293 include 'DIMENSIONS'
9294 include 'COMMON.IOUNITS'
9295 include 'COMMON.CHAIN'
9296 include 'COMMON.DERIV'
9297 include 'COMMON.INTERACT'
9298 include 'COMMON.CONTACTS'
9299 include 'COMMON.TORSION'
9300 include 'COMMON.VAR'
9301 include 'COMMON.GEO'
9302 include 'COMMON.FFIELD'
9303 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9304 & auxvec1(2),auxmat1(2,2)
9306 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9308 C Parallel Antiparallel C
9314 C \ j|/k\| \ |/k\|l C
9319 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9321 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9322 C energy moment and not to the cluster cumulant.
9323 cd write (2,*) 'eello_graph4: wturn6',wturn6
9324 iti=itortyp(itype(i))
9325 itj=itortyp(itype(j))
9326 if (j.lt.nres-1) then
9327 itj1=itortyp(itype(j+1))
9331 itk=itortyp(itype(k))
9332 if (k.lt.nres-1) then
9333 itk1=itortyp(itype(k+1))
9337 itl=itortyp(itype(l))
9338 if (l.lt.nres-1) then
9339 itl1=itortyp(itype(l+1))
9343 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9344 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9345 cd & ' itl',itl,' itl1',itl1
9348 s1=dip(3,jj,i)*dip(3,kk,k)
9350 s1=dip(2,jj,j)*dip(2,kk,l)
9353 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9354 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9356 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9357 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9359 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9360 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9362 call transpose2(EUg(1,1,k),auxmat(1,1))
9363 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9364 vv(1)=pizda(1,1)-pizda(2,2)
9365 vv(2)=pizda(2,1)+pizda(1,2)
9366 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9367 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9369 eello6_graph4=-(s1+s2+s3+s4)
9371 eello6_graph4=-(s2+s3+s4)
9373 C Derivatives in gamma(i-1)
9377 s1=dipderg(2,jj,i)*dip(3,kk,k)
9379 s1=dipderg(4,jj,j)*dip(2,kk,l)
9382 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9384 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9385 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9387 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9388 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9390 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9391 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9392 cd write (2,*) 'turn6 derivatives'
9394 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9396 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9400 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9402 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9406 C Derivatives in gamma(k-1)
9409 s1=dip(3,jj,i)*dipderg(2,kk,k)
9411 s1=dip(2,jj,j)*dipderg(4,kk,l)
9414 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9415 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9417 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9418 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9420 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9421 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9423 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9424 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9425 vv(1)=pizda(1,1)-pizda(2,2)
9426 vv(2)=pizda(2,1)+pizda(1,2)
9427 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9428 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9430 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9432 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9436 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9438 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9441 C Derivatives in gamma(j-1) or gamma(l-1)
9442 if (l.eq.j+1 .and. l.gt.1) then
9443 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9444 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9445 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9446 vv(1)=pizda(1,1)-pizda(2,2)
9447 vv(2)=pizda(2,1)+pizda(1,2)
9448 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9449 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9450 else if (j.gt.1) then
9451 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9452 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9453 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9454 vv(1)=pizda(1,1)-pizda(2,2)
9455 vv(2)=pizda(2,1)+pizda(1,2)
9456 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9457 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9458 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9460 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9463 C Cartesian derivatives.
9470 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9472 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9476 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9478 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9482 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9484 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9486 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9487 & b1(1,itj1),auxvec(1))
9488 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9490 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9491 & b1(1,itl1),auxvec(1))
9492 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9494 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9496 vv(1)=pizda(1,1)-pizda(2,2)
9497 vv(2)=pizda(2,1)+pizda(1,2)
9498 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9500 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9502 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9505 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9508 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9511 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9513 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9515 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9519 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9521 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9524 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9526 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9534 c----------------------------------------------------------------------------
9535 double precision function eello_turn6(i,jj,kk)
9536 implicit real*8 (a-h,o-z)
9537 include 'DIMENSIONS'
9538 include 'COMMON.IOUNITS'
9539 include 'COMMON.CHAIN'
9540 include 'COMMON.DERIV'
9541 include 'COMMON.INTERACT'
9542 include 'COMMON.CONTACTS'
9543 include 'COMMON.TORSION'
9544 include 'COMMON.VAR'
9545 include 'COMMON.GEO'
9546 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9547 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9549 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9550 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9551 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9552 C the respective energy moment and not to the cluster cumulant.
9561 iti=itortyp(itype(i))
9562 itk=itortyp(itype(k))
9563 itk1=itortyp(itype(k+1))
9564 itl=itortyp(itype(l))
9565 itj=itortyp(itype(j))
9566 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9567 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9568 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9573 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9575 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9579 derx_turn(lll,kkk,iii)=0.0d0
9586 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9588 cd write (2,*) 'eello6_5',eello6_5
9590 call transpose2(AEA(1,1,1),auxmat(1,1))
9591 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9592 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9593 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9595 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9596 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9597 s2 = scalar2(b1(1,itk),vtemp1(1))
9599 call transpose2(AEA(1,1,2),atemp(1,1))
9600 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9601 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9602 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9604 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9605 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9606 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9608 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9609 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9610 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9611 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9612 ss13 = scalar2(b1(1,itk),vtemp4(1))
9613 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9615 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9621 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9622 C Derivatives in gamma(i+2)
9626 call transpose2(AEA(1,1,1),auxmatd(1,1))
9627 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9628 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9629 call transpose2(AEAderg(1,1,2),atempd(1,1))
9630 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9631 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9633 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9634 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9635 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9641 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9642 C Derivatives in gamma(i+3)
9644 call transpose2(AEA(1,1,1),auxmatd(1,1))
9645 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9646 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9647 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9649 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9650 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9651 s2d = scalar2(b1(1,itk),vtemp1d(1))
9653 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9654 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9656 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9658 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9659 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9660 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9668 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9669 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9671 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9672 & -0.5d0*ekont*(s2d+s12d)
9674 C Derivatives in gamma(i+4)
9675 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9676 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9677 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9679 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9680 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9681 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9689 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9691 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9693 C Derivatives in gamma(i+5)
9695 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9696 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9697 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9699 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9700 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9701 s2d = scalar2(b1(1,itk),vtemp1d(1))
9703 call transpose2(AEA(1,1,2),atempd(1,1))
9704 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9705 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9707 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9708 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9710 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9711 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9712 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9720 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9721 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9723 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9724 & -0.5d0*ekont*(s2d+s12d)
9726 C Cartesian derivatives
9731 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9732 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9733 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9735 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9736 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9738 s2d = scalar2(b1(1,itk),vtemp1d(1))
9740 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9741 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9742 s8d = -(atempd(1,1)+atempd(2,2))*
9743 & scalar2(cc(1,1,itl),vtemp2(1))
9745 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9747 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9748 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9755 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9758 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9762 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9763 & - 0.5d0*(s8d+s12d)
9765 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9774 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9776 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9777 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9778 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9779 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9780 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9782 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9783 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9784 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9788 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9789 cd & 16*eel_turn6_num
9791 if (j.lt.nres-1) then
9798 if (l.lt.nres-1) then
9806 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9807 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9808 cgrad ghalf=0.5d0*ggg1(ll)
9810 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9811 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9812 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9813 & +ekont*derx_turn(ll,2,1)
9814 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9815 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9816 & +ekont*derx_turn(ll,4,1)
9817 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9818 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9819 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9820 cgrad ghalf=0.5d0*ggg2(ll)
9822 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9823 & +ekont*derx_turn(ll,2,2)
9824 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9825 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9826 & +ekont*derx_turn(ll,4,2)
9827 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9828 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9829 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9834 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9839 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9845 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9850 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9854 cd write (2,*) iii,g_corr6_loc(iii)
9856 eello_turn6=ekont*eel_turn6
9857 cd write (2,*) 'ekont',ekont
9858 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9862 C-----------------------------------------------------------------------------
9863 double precision function scalar(u,v)
9864 !DIR$ INLINEALWAYS scalar
9866 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9869 double precision u(3),v(3)
9870 cd double precision sc
9878 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9881 crc-------------------------------------------------
9882 SUBROUTINE MATVEC2(A1,V1,V2)
9883 !DIR$ INLINEALWAYS MATVEC2
9885 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9887 implicit real*8 (a-h,o-z)
9888 include 'DIMENSIONS'
9889 DIMENSION A1(2,2),V1(2),V2(2)
9893 c 3 VI=VI+A1(I,K)*V1(K)
9897 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9898 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9903 C---------------------------------------
9904 SUBROUTINE MATMAT2(A1,A2,A3)
9906 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9908 implicit real*8 (a-h,o-z)
9909 include 'DIMENSIONS'
9910 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9911 c DIMENSION AI3(2,2)
9915 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9921 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9922 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9923 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9924 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9932 c-------------------------------------------------------------------------
9933 double precision function scalar2(u,v)
9934 !DIR$ INLINEALWAYS scalar2
9936 double precision u(2),v(2)
9939 scalar2=u(1)*v(1)+u(2)*v(2)
9943 C-----------------------------------------------------------------------------
9945 subroutine transpose2(a,at)
9946 !DIR$ INLINEALWAYS transpose2
9948 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9951 double precision a(2,2),at(2,2)
9958 c--------------------------------------------------------------------------
9959 subroutine transpose(n,a,at)
9962 double precision a(n,n),at(n,n)
9970 C---------------------------------------------------------------------------
9971 subroutine prodmat3(a1,a2,kk,transp,prod)
9972 !DIR$ INLINEALWAYS prodmat3
9974 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9978 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9980 crc double precision auxmat(2,2),prod_(2,2)
9983 crc call transpose2(kk(1,1),auxmat(1,1))
9984 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9985 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9987 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9988 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9989 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9990 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9991 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9992 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9993 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9994 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9997 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9998 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10000 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10001 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10002 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10003 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10004 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10005 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10006 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10007 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10010 c call transpose2(a2(1,1),a2t(1,1))
10013 crc print *,((prod_(i,j),i=1,2),j=1,2)
10014 crc print *,((prod(i,j),i=1,2),j=1,2)