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
30 if (nfgtasks.gt.1) then
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
37 if (fg_rank.eq.0) then
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
39 c print *,"Processor",myrank," BROADCAST iorder"
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
41 C FG slaves as WEIGHTS array.
62 C FG Master broadcasts the WEIGHTS_ array
63 call MPI_Bcast(weights_(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
66 C FG slaves receive the WEIGHTS array
67 call MPI_Bcast(weights(1),n_ene,
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
92 c call chainbuild_cart
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
98 c call int_from_cart1(.false.)
109 C Compute the side-chain and electrostatic interaction energy
111 goto (101,102,103,104,105,106) ipot
112 C Lennard-Jones potential.
113 101 call elj(evdw,evdw_p,evdw_m)
114 cd print '(a)','Exit ELJ'
116 C Lennard-Jones-Kihara potential (shifted).
117 102 call eljk(evdw,evdw_p,evdw_m)
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
120 103 call ebp(evdw,evdw_p,evdw_m)
122 C Gay-Berne potential (shifted LJ, angular dependence).
123 104 call egb(evdw,evdw_p,evdw_m)
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
126 105 call egbv(evdw,evdw_p,evdw_m)
128 C Soft-sphere potential
129 106 call e_softsphere(evdw)
131 C Calculate electrostatic (H-bonding) energy of the main chain.
135 cmc Sep-06: egb takes care of dynamic ss bonds too
137 c if (dyn_ss) call dyn_set_nss
139 c print *,"Processor",myrank," computed USCSC"
150 time_vec=time_vec+MPI_Wtime()-time01
152 time_vec=time_vec+tcpu()-time01
155 c print *,"Processor",myrank," left VEC_AND_DERIV"
158 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
159 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
160 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
161 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
163 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
164 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
165 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
166 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
168 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
177 c write (iout,*) "Soft-spheer ELEC potential"
178 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
181 c print *,"Processor",myrank," computed UELEC"
183 C Calculate excluded-volume interaction energy between peptide groups
188 call escp(evdw2,evdw2_14)
194 c write (iout,*) "Soft-sphere SCP potential"
195 call escp_soft_sphere(evdw2,evdw2_14)
198 c Calculate the bond-stretching energy
202 C Calculate the disulfide-bridge and other energy and the contributions
203 C from other distance constraints.
204 cd print *,'Calling EHPB'
206 cd print *,'EHPB exitted succesfully.'
208 C Calculate the virtual-bond-angle energy.
210 if (wang.gt.0d0) then
215 c print *,"Processor",myrank," computed UB"
217 C Calculate the SC local energy.
220 c print *,"Processor",myrank," computed USC"
222 C Calculate the virtual-bond torsional energy.
224 cd print *,'nterm=',nterm
226 call etor(etors,edihcnstr)
232 if (constr_homology.ge.1) then
233 call e_modeller(ehomology_constr)
239 c write(iout,*) ehomology_constr
240 c print *,"Processor",myrank," computed Utor"
242 C 6/23/01 Calculate double-torsional energy
244 if (wtor_d.gt.0) then
249 c print *,"Processor",myrank," computed Utord"
251 C 21/5/07 Calculate local sicdechain correlation energy
253 if (wsccor.gt.0.0d0) then
254 call eback_sc_corr(esccor)
258 c print *,"Processor",myrank," computed Usccorr"
260 C 12/1/95 Multi-body terms
264 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
265 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
266 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
267 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
268 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
275 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
276 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
277 cd write (iout,*) "multibody_hb ecorr",ecorr
279 c print *,"Processor",myrank," computed Ucorr"
281 C If performing constraint dynamics, call the constraint energy
282 C after the equilibration time
283 if(usampl.and.totT.gt.eq_time) then
292 time_enecalc=time_enecalc+MPI_Wtime()-time00
294 time_enecalc=time_enecalc+tcpu()-time00
297 c print *,"Processor",myrank," computed Uconstr"
310 energia(2)=evdw2-evdw2_14
327 energia(8)=eello_turn3
328 energia(9)=eello_turn4
335 energia(19)=edihcnstr
337 energia(20)=Uconst+Uconst_back
341 energia(24)=ehomology_constr
342 c print *," Processor",myrank," calls SUM_ENERGY"
343 call sum_energy(energia,.true.)
344 if (dyn_ss) call dyn_set_nss
345 c print *," Processor",myrank," left SUM_ENERGY"
348 time_sumene=time_sumene+MPI_Wtime()-time00
350 time_sumene=time_sumene+tcpu()-time00
355 c-------------------------------------------------------------------------------
356 subroutine sum_energy(energia,reduce)
357 implicit real*8 (a-h,o-z)
362 cMS$ATTRIBUTES C :: proc_proc
368 include 'COMMON.SETUP'
369 include 'COMMON.IOUNITS'
370 double precision energia(0:n_ene),enebuff(0:n_ene+1)
371 include 'COMMON.FFIELD'
372 include 'COMMON.DERIV'
373 include 'COMMON.INTERACT'
374 include 'COMMON.SBRIDGE'
375 include 'COMMON.CHAIN'
377 include 'COMMON.CONTROL'
378 include 'COMMON.TIME1'
381 if (nfgtasks.gt.1 .and. reduce) then
383 write (iout,*) "energies before REDUCE"
384 call enerprint(energia)
388 enebuff(i)=energia(i)
391 call MPI_Barrier(FG_COMM,IERR)
392 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
394 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
395 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
397 write (iout,*) "energies after REDUCE"
398 call enerprint(energia)
401 time_Reduce=time_Reduce+MPI_Wtime()-time00
403 if (fg_rank.eq.0) then
406 evdw=energia(22)+wsct*energia(23)
411 evdw2=energia(2)+energia(18)
427 eello_turn3=energia(8)
428 eello_turn4=energia(9)
435 edihcnstr=energia(19)
439 ehomology_constr=energia(24)
441 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
442 & +wang*ebe+wtor*etors+wscloc*escloc
443 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
444 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
445 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
446 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
448 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
449 & +wang*ebe+wtor*etors+wscloc*escloc
450 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
451 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
452 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
453 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
459 if (isnan(etot).ne.0) energia(0)=1.0d+99
461 if (isnan(etot)) energia(0)=1.0d+99
466 idumm=proc_proc(etot,i)
468 call proc_proc(etot,i)
470 if(i.eq.1)energia(0)=1.0d+99
477 c-------------------------------------------------------------------------------
478 subroutine sum_gradient
479 implicit real*8 (a-h,o-z)
484 cMS$ATTRIBUTES C :: proc_proc
490 double precision gradbufc(3,maxres),gradbufx(3,maxres),
491 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
492 include 'COMMON.SETUP'
493 include 'COMMON.IOUNITS'
494 include 'COMMON.FFIELD'
495 include 'COMMON.DERIV'
496 include 'COMMON.INTERACT'
497 include 'COMMON.SBRIDGE'
498 include 'COMMON.CHAIN'
500 include 'COMMON.CONTROL'
501 include 'COMMON.TIME1'
502 include 'COMMON.MAXGRAD'
503 include 'COMMON.SCCOR'
512 write (iout,*) "sum_gradient gvdwc, gvdwx"
514 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
515 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
516 & (gvdwcT(j,i),j=1,3)
521 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
522 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
523 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
526 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
527 C in virtual-bond-vector coordinates
530 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
532 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
533 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
535 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
537 c write (iout,'(i5,3f10.5,2x,f10.5)')
538 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
540 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
542 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
543 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
552 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
553 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
554 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
555 & wel_loc*gel_loc_long(j,i)+
556 & wcorr*gradcorr_long(j,i)+
557 & wcorr5*gradcorr5_long(j,i)+
558 & wcorr6*gradcorr6_long(j,i)+
559 & wturn6*gcorr6_turn_long(j,i)+
566 gradbufc(j,i)=wsc*gvdwc(j,i)+
567 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
568 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
569 & wel_loc*gel_loc_long(j,i)+
570 & wcorr*gradcorr_long(j,i)+
571 & wcorr5*gradcorr5_long(j,i)+
572 & wcorr6*gradcorr6_long(j,i)+
573 & wturn6*gcorr6_turn_long(j,i)+
581 gradbufc(j,i)=wsc*gvdwc(j,i)+
582 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
583 & welec*gelc_long(j,i)+
585 & wel_loc*gel_loc_long(j,i)+
586 & wcorr*gradcorr_long(j,i)+
587 & wcorr5*gradcorr5_long(j,i)+
588 & wcorr6*gradcorr6_long(j,i)+
589 & wturn6*gcorr6_turn_long(j,i)+
595 if (nfgtasks.gt.1) then
598 write (iout,*) "gradbufc before allreduce"
600 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
606 gradbufc_sum(j,i)=gradbufc(j,i)
609 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
610 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
611 c time_reduce=time_reduce+MPI_Wtime()-time00
613 c write (iout,*) "gradbufc_sum after allreduce"
615 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
620 c time_allreduce=time_allreduce+MPI_Wtime()-time00
628 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
629 write (iout,*) (i," jgrad_start",jgrad_start(i),
630 & " jgrad_end ",jgrad_end(i),
631 & i=igrad_start,igrad_end)
634 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
635 c do not parallelize this part.
637 c do i=igrad_start,igrad_end
638 c do j=jgrad_start(i),jgrad_end(i)
640 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
645 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
649 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
653 write (iout,*) "gradbufc after summing"
655 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
662 write (iout,*) "gradbufc"
664 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
670 gradbufc_sum(j,i)=gradbufc(j,i)
675 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
679 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
684 c gradbufc(k,i)=0.0d0
688 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
693 write (iout,*) "gradbufc after summing"
695 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
703 gradbufc(k,nres)=0.0d0
708 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
709 & wel_loc*gel_loc(j,i)+
710 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
711 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
712 & wel_loc*gel_loc_long(j,i)+
713 & wcorr*gradcorr_long(j,i)+
714 & wcorr5*gradcorr5_long(j,i)+
715 & wcorr6*gradcorr6_long(j,i)+
716 & wturn6*gcorr6_turn_long(j,i))+
718 & wcorr*gradcorr(j,i)+
719 & wturn3*gcorr3_turn(j,i)+
720 & wturn4*gcorr4_turn(j,i)+
721 & wcorr5*gradcorr5(j,i)+
722 & wcorr6*gradcorr6(j,i)+
723 & wturn6*gcorr6_turn(j,i)+
724 & wsccor*gsccorc(j,i)
725 & +wscloc*gscloc(j,i)
727 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
728 & wel_loc*gel_loc(j,i)+
729 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
730 & welec*gelc_long(j,i)+
731 & wel_loc*gel_loc_long(j,i)+
732 & wcorr*gcorr_long(j,i)+
733 & wcorr5*gradcorr5_long(j,i)+
734 & wcorr6*gradcorr6_long(j,i)+
735 & wturn6*gcorr6_turn_long(j,i))+
737 & wcorr*gradcorr(j,i)+
738 & wturn3*gcorr3_turn(j,i)+
739 & wturn4*gcorr4_turn(j,i)+
740 & wcorr5*gradcorr5(j,i)+
741 & wcorr6*gradcorr6(j,i)+
742 & wturn6*gcorr6_turn(j,i)+
743 & wsccor*gsccorc(j,i)
744 & +wscloc*gscloc(j,i)
747 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
748 & wscp*gradx_scp(j,i)+
750 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
751 & wsccor*gsccorx(j,i)
752 & +wscloc*gsclocx(j,i)
754 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
756 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
757 & wsccor*gsccorx(j,i)
758 & +wscloc*gsclocx(j,i)
763 write (iout,*) "gloc before adding corr"
765 write (iout,*) i,gloc(i,icg)
769 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
770 & +wcorr5*g_corr5_loc(i)
771 & +wcorr6*g_corr6_loc(i)
772 & +wturn4*gel_loc_turn4(i)
773 & +wturn3*gel_loc_turn3(i)
774 & +wturn6*gel_loc_turn6(i)
775 & +wel_loc*gel_loc_loc(i)
778 write (iout,*) "gloc after adding corr"
780 write (iout,*) i,gloc(i,icg)
784 if (nfgtasks.gt.1) then
787 gradbufc(j,i)=gradc(j,i,icg)
788 gradbufx(j,i)=gradx(j,i,icg)
792 glocbuf(i)=gloc(i,icg)
795 write (iout,*) "gloc_sc before reduce"
798 write (iout,*) i,j,gloc_sc(j,i,icg)
804 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
808 call MPI_Barrier(FG_COMM,IERR)
809 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
811 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
812 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
813 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
814 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
815 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
816 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
817 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
818 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
819 time_reduce=time_reduce+MPI_Wtime()-time00
821 write (iout,*) "gloc_sc after reduce"
824 write (iout,*) i,j,gloc_sc(j,i,icg)
829 write (iout,*) "gloc after reduce"
831 write (iout,*) i,gloc(i,icg)
836 if (gnorm_check) then
838 c Compute the maximum elements of the gradient
848 gcorr3_turn_max=0.0d0
849 gcorr4_turn_max=0.0d0
852 gcorr6_turn_max=0.0d0
862 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
863 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
865 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
866 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
868 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
869 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
870 & gvdwc_scp_max=gvdwc_scp_norm
871 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
872 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
873 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
874 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
875 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
876 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
877 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
878 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
879 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
880 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
881 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
882 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
883 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
885 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
886 & gcorr3_turn_max=gcorr3_turn_norm
887 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
889 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
890 & gcorr4_turn_max=gcorr4_turn_norm
891 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
892 if (gradcorr5_norm.gt.gradcorr5_max)
893 & gradcorr5_max=gradcorr5_norm
894 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
895 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
896 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
898 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
899 & gcorr6_turn_max=gcorr6_turn_norm
900 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
901 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
902 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
903 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
904 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
905 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
907 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
908 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
910 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
911 if (gradx_scp_norm.gt.gradx_scp_max)
912 & gradx_scp_max=gradx_scp_norm
913 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
914 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
915 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
916 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
917 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
918 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
919 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
920 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
924 open(istat,file=statname,position="append")
926 open(istat,file=statname,access="append")
928 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
929 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
930 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
931 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
932 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
933 & gsccorx_max,gsclocx_max
935 if (gvdwc_max.gt.1.0d4) then
936 write (iout,*) "gvdwc gvdwx gradb gradbx"
938 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
939 & gradb(j,i),gradbx(j,i),j=1,3)
941 call pdbout(0.0d0,'cipiszcze',iout)
947 write (iout,*) "gradc gradx gloc"
949 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
950 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
955 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
957 time_sumgradient=time_sumgradient+tcpu()-time01
962 c-------------------------------------------------------------------------------
963 subroutine rescale_weights(t_bath)
964 implicit real*8 (a-h,o-z)
966 include 'COMMON.IOUNITS'
967 include 'COMMON.FFIELD'
968 include 'COMMON.SBRIDGE'
969 double precision kfac /2.4d0/
970 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
972 c facT=2*temp0/(t_bath+temp0)
973 if (rescale_mode.eq.0) then
979 else if (rescale_mode.eq.1) then
980 facT=kfac/(kfac-1.0d0+t_bath/temp0)
981 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
982 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
983 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
984 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
985 else if (rescale_mode.eq.2) then
991 facT=licznik/dlog(dexp(x)+dexp(-x))
992 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
993 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
994 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
995 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
997 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
998 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1000 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1004 welec=weights(3)*fact
1005 wcorr=weights(4)*fact3
1006 wcorr5=weights(5)*fact4
1007 wcorr6=weights(6)*fact5
1008 wel_loc=weights(7)*fact2
1009 wturn3=weights(8)*fact2
1010 wturn4=weights(9)*fact3
1011 wturn6=weights(10)*fact5
1012 wtor=weights(13)*fact
1013 wtor_d=weights(14)*fact2
1014 wsccor=weights(21)*fact
1017 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1021 C------------------------------------------------------------------------
1022 subroutine enerprint(energia)
1023 implicit real*8 (a-h,o-z)
1024 include 'DIMENSIONS'
1025 include 'COMMON.IOUNITS'
1026 include 'COMMON.FFIELD'
1027 include 'COMMON.SBRIDGE'
1029 double precision energia(0:n_ene)
1032 evdw=energia(22)+wsct*energia(23)
1038 evdw2=energia(2)+energia(18)
1050 eello_turn3=energia(8)
1051 eello_turn4=energia(9)
1052 eello_turn6=energia(10)
1058 edihcnstr=energia(19)
1062 ehomology_constr=energia(24)
1065 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1066 & estr,wbond,ebe,wang,
1067 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1069 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1070 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1071 & edihcnstr,ehomology_constr, ebr*nss,
1073 10 format (/'Virtual-chain energies:'//
1074 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1075 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1076 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1077 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1078 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1079 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1080 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1081 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1082 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1083 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1084 & ' (SS bridges & dist. cnstr.)'/
1085 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1086 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1087 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1088 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1089 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1090 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1091 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1092 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1093 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1094 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1095 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1096 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1097 & 'ETOT= ',1pE16.6,' (total)')
1099 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1100 & estr,wbond,ebe,wang,
1101 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1103 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1104 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1105 & ehomology_constr,ebr*nss,Uconst,etot
1106 10 format (/'Virtual-chain energies:'//
1107 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1108 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1109 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1110 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1111 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1112 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1113 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1114 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1115 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1116 & ' (SS bridges & dist. cnstr.)'/
1117 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1118 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1119 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1120 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1121 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1122 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1123 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1124 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1125 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1126 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1127 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1128 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1129 & 'ETOT= ',1pE16.6,' (total)')
1133 C-----------------------------------------------------------------------
1134 subroutine elj(evdw,evdw_p,evdw_m)
1136 C This subroutine calculates the interaction energy of nonbonded side chains
1137 C assuming the LJ potential of interaction.
1139 implicit real*8 (a-h,o-z)
1140 include 'DIMENSIONS'
1141 parameter (accur=1.0d-10)
1142 include 'COMMON.GEO'
1143 include 'COMMON.VAR'
1144 include 'COMMON.LOCAL'
1145 include 'COMMON.CHAIN'
1146 include 'COMMON.DERIV'
1147 include 'COMMON.INTERACT'
1148 include 'COMMON.TORSION'
1149 include 'COMMON.SBRIDGE'
1150 include 'COMMON.NAMES'
1151 include 'COMMON.IOUNITS'
1152 include 'COMMON.CONTACTS'
1154 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1156 do i=iatsc_s,iatsc_e
1165 C Calculate SC interaction energy.
1167 do iint=1,nint_gr(i)
1168 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1169 cd & 'iend=',iend(i,iint)
1170 do j=istart(i,iint),iend(i,iint)
1175 C Change 12/1/95 to calculate four-body interactions
1176 rij=xj*xj+yj*yj+zj*zj
1178 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1179 eps0ij=eps(itypi,itypj)
1181 e1=fac*fac*aa(itypi,itypj)
1182 e2=fac*bb(itypi,itypj)
1184 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1185 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1186 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1187 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1188 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1189 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1191 if (bb(itypi,itypj).gt.0) then
1192 evdw_p=evdw_p+evdwij
1194 evdw_m=evdw_m+evdwij
1200 C Calculate the components of the gradient in DC and X
1202 fac=-rrij*(e1+evdwij)
1207 if (bb(itypi,itypj).gt.0.0d0) then
1209 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1210 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1211 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1212 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1216 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1217 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1218 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1219 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1224 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1225 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1226 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1227 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1232 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1236 C 12/1/95, revised on 5/20/97
1238 C Calculate the contact function. The ith column of the array JCONT will
1239 C contain the numbers of atoms that make contacts with the atom I (of numbers
1240 C greater than I). The arrays FACONT and GACONT will contain the values of
1241 C the contact function and its derivative.
1243 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1244 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1245 C Uncomment next line, if the correlation interactions are contact function only
1246 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1248 sigij=sigma(itypi,itypj)
1249 r0ij=rs0(itypi,itypj)
1251 C Check whether the SC's are not too far to make a contact.
1254 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1255 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1257 if (fcont.gt.0.0D0) then
1258 C If the SC-SC distance if close to sigma, apply spline.
1259 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1260 cAdam & fcont1,fprimcont1)
1261 cAdam fcont1=1.0d0-fcont1
1262 cAdam if (fcont1.gt.0.0d0) then
1263 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1264 cAdam fcont=fcont*fcont1
1266 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1267 cga eps0ij=1.0d0/dsqrt(eps0ij)
1269 cga gg(k)=gg(k)*eps0ij
1271 cga eps0ij=-evdwij*eps0ij
1272 C Uncomment for AL's type of SC correlation interactions.
1273 cadam eps0ij=-evdwij
1274 num_conti=num_conti+1
1275 jcont(num_conti,i)=j
1276 facont(num_conti,i)=fcont*eps0ij
1277 fprimcont=eps0ij*fprimcont/rij
1279 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1280 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1281 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1282 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1283 gacont(1,num_conti,i)=-fprimcont*xj
1284 gacont(2,num_conti,i)=-fprimcont*yj
1285 gacont(3,num_conti,i)=-fprimcont*zj
1286 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1287 cd write (iout,'(2i3,3f10.5)')
1288 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1294 num_cont(i)=num_conti
1298 gvdwc(j,i)=expon*gvdwc(j,i)
1299 gvdwx(j,i)=expon*gvdwx(j,i)
1302 C******************************************************************************
1306 C To save time, the factor of EXPON has been extracted from ALL components
1307 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1310 C******************************************************************************
1313 C-----------------------------------------------------------------------------
1314 subroutine eljk(evdw,evdw_p,evdw_m)
1316 C This subroutine calculates the interaction energy of nonbonded side chains
1317 C assuming the LJK potential of interaction.
1319 implicit real*8 (a-h,o-z)
1320 include 'DIMENSIONS'
1321 include 'COMMON.GEO'
1322 include 'COMMON.VAR'
1323 include 'COMMON.LOCAL'
1324 include 'COMMON.CHAIN'
1325 include 'COMMON.DERIV'
1326 include 'COMMON.INTERACT'
1327 include 'COMMON.IOUNITS'
1328 include 'COMMON.NAMES'
1331 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1333 do i=iatsc_s,iatsc_e
1340 C Calculate SC interaction energy.
1342 do iint=1,nint_gr(i)
1343 do j=istart(i,iint),iend(i,iint)
1348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1349 fac_augm=rrij**expon
1350 e_augm=augm(itypi,itypj)*fac_augm
1351 r_inv_ij=dsqrt(rrij)
1353 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1354 fac=r_shift_inv**expon
1355 e1=fac*fac*aa(itypi,itypj)
1356 e2=fac*bb(itypi,itypj)
1358 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1359 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1360 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1361 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1362 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1363 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1364 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1366 if (bb(itypi,itypj).gt.0) then
1367 evdw_p=evdw_p+evdwij
1369 evdw_m=evdw_m+evdwij
1375 C Calculate the components of the gradient in DC and X
1377 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1382 if (bb(itypi,itypj).gt.0.0d0) then
1384 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1385 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1386 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1387 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1391 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1392 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1393 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1394 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1399 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1400 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1401 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1402 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1407 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1415 gvdwc(j,i)=expon*gvdwc(j,i)
1416 gvdwx(j,i)=expon*gvdwx(j,i)
1421 C-----------------------------------------------------------------------------
1422 subroutine ebp(evdw,evdw_p,evdw_m)
1424 C This subroutine calculates the interaction energy of nonbonded side chains
1425 C assuming the Berne-Pechukas potential of interaction.
1427 implicit real*8 (a-h,o-z)
1428 include 'DIMENSIONS'
1429 include 'COMMON.GEO'
1430 include 'COMMON.VAR'
1431 include 'COMMON.LOCAL'
1432 include 'COMMON.CHAIN'
1433 include 'COMMON.DERIV'
1434 include 'COMMON.NAMES'
1435 include 'COMMON.INTERACT'
1436 include 'COMMON.IOUNITS'
1437 include 'COMMON.CALC'
1438 common /srutu/ icall
1439 c double precision rrsave(maxdim)
1442 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1444 c if (icall.eq.0) then
1450 do i=iatsc_s,iatsc_e
1456 dxi=dc_norm(1,nres+i)
1457 dyi=dc_norm(2,nres+i)
1458 dzi=dc_norm(3,nres+i)
1459 c dsci_inv=dsc_inv(itypi)
1460 dsci_inv=vbld_inv(i+nres)
1462 C Calculate SC interaction energy.
1464 do iint=1,nint_gr(i)
1465 do j=istart(i,iint),iend(i,iint)
1468 c dscj_inv=dsc_inv(itypj)
1469 dscj_inv=vbld_inv(j+nres)
1470 chi1=chi(itypi,itypj)
1471 chi2=chi(itypj,itypi)
1478 alf12=0.5D0*(alf1+alf2)
1479 C For diagnostics only!!!
1492 dxj=dc_norm(1,nres+j)
1493 dyj=dc_norm(2,nres+j)
1494 dzj=dc_norm(3,nres+j)
1495 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1496 cd if (icall.eq.0) then
1502 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1504 C Calculate whole angle-dependent part of epsilon and contributions
1505 C to its derivatives
1506 fac=(rrij*sigsq)**expon2
1507 e1=fac*fac*aa(itypi,itypj)
1508 e2=fac*bb(itypi,itypj)
1509 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1510 eps2der=evdwij*eps3rt
1511 eps3der=evdwij*eps2rt
1512 evdwij=evdwij*eps2rt*eps3rt
1514 if (bb(itypi,itypj).gt.0) then
1515 evdw_p=evdw_p+evdwij
1517 evdw_m=evdw_m+evdwij
1523 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1524 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1525 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1526 cd & restyp(itypi),i,restyp(itypj),j,
1527 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1528 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1529 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1532 C Calculate gradient components.
1533 e1=e1*eps1*eps2rt**2*eps3rt**2
1534 fac=-expon*(e1+evdwij)
1537 C Calculate radial part of the gradient
1541 C Calculate the angular part of the gradient and sum add the contributions
1542 C to the appropriate components of the Cartesian gradient.
1544 if (bb(itypi,itypj).gt.0) then
1558 C-----------------------------------------------------------------------------
1559 subroutine egb(evdw,evdw_p,evdw_m)
1561 C This subroutine calculates the interaction energy of nonbonded side chains
1562 C assuming the Gay-Berne potential of interaction.
1564 implicit real*8 (a-h,o-z)
1565 include 'DIMENSIONS'
1566 include 'COMMON.GEO'
1567 include 'COMMON.VAR'
1568 include 'COMMON.LOCAL'
1569 include 'COMMON.CHAIN'
1570 include 'COMMON.DERIV'
1571 include 'COMMON.NAMES'
1572 include 'COMMON.INTERACT'
1573 include 'COMMON.IOUNITS'
1574 include 'COMMON.CALC'
1575 include 'COMMON.CONTROL'
1576 include 'COMMON.SBRIDGE'
1579 ccccc energy_dec=.false.
1580 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1585 c if (icall.eq.0) lprn=.false.
1587 do i=iatsc_s,iatsc_e
1593 dxi=dc_norm(1,nres+i)
1594 dyi=dc_norm(2,nres+i)
1595 dzi=dc_norm(3,nres+i)
1596 c dsci_inv=dsc_inv(itypi)
1597 dsci_inv=vbld_inv(i+nres)
1598 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1599 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1601 C Calculate SC interaction energy.
1603 do iint=1,nint_gr(i)
1604 do j=istart(i,iint),iend(i,iint)
1605 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1606 call dyn_ssbond_ene(i,j,evdwij)
1608 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1609 & 'evdw',i,j,evdwij,' ss'
1613 c dscj_inv=dsc_inv(itypj)
1614 dscj_inv=vbld_inv(j+nres)
1615 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1616 c & 1.0d0/vbld(j+nres)
1617 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1618 sig0ij=sigma(itypi,itypj)
1619 chi1=chi(itypi,itypj)
1620 chi2=chi(itypj,itypi)
1627 alf12=0.5D0*(alf1+alf2)
1628 C For diagnostics only!!!
1641 dxj=dc_norm(1,nres+j)
1642 dyj=dc_norm(2,nres+j)
1643 dzj=dc_norm(3,nres+j)
1644 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1645 c write (iout,*) "j",j," dc_norm",
1646 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1647 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1649 C Calculate angle-dependent terms of energy and contributions to their
1653 sig=sig0ij*dsqrt(sigsq)
1654 rij_shift=1.0D0/rij-sig+sig0ij
1655 c for diagnostics; uncomment
1656 c rij_shift=1.2*sig0ij
1657 C I hate to put IF's in the loops, but here don't have another choice!!!!
1658 if (rij_shift.le.0.0D0) then
1660 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1661 cd & restyp(itypi),i,restyp(itypj),j,
1662 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1666 c---------------------------------------------------------------
1667 rij_shift=1.0D0/rij_shift
1668 fac=rij_shift**expon
1669 e1=fac*fac*aa(itypi,itypj)
1670 e2=fac*bb(itypi,itypj)
1671 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1672 eps2der=evdwij*eps3rt
1673 eps3der=evdwij*eps2rt
1674 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1675 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1676 evdwij=evdwij*eps2rt*eps3rt
1678 if (bb(itypi,itypj).gt.0) then
1679 evdw_p=evdw_p+evdwij
1681 evdw_m=evdw_m+evdwij
1687 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1688 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1689 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1690 & restyp(itypi),i,restyp(itypj),j,
1691 & epsi,sigm,chi1,chi2,chip1,chip2,
1692 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1693 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1697 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1700 C Calculate gradient components.
1701 e1=e1*eps1*eps2rt**2*eps3rt**2
1702 fac=-expon*(e1+evdwij)*rij_shift
1706 C Calculate the radial part of the gradient
1710 C Calculate angular part of the gradient.
1712 if (bb(itypi,itypj).gt.0) then
1724 c write (iout,*) "Number of loop steps in EGB:",ind
1725 cccc energy_dec=.false.
1728 C-----------------------------------------------------------------------------
1729 subroutine egbv(evdw,evdw_p,evdw_m)
1731 C This subroutine calculates the interaction energy of nonbonded side chains
1732 C assuming the Gay-Berne-Vorobjev potential of interaction.
1734 implicit real*8 (a-h,o-z)
1735 include 'DIMENSIONS'
1736 include 'COMMON.GEO'
1737 include 'COMMON.VAR'
1738 include 'COMMON.LOCAL'
1739 include 'COMMON.CHAIN'
1740 include 'COMMON.DERIV'
1741 include 'COMMON.NAMES'
1742 include 'COMMON.INTERACT'
1743 include 'COMMON.IOUNITS'
1744 include 'COMMON.CALC'
1745 common /srutu/ icall
1748 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1751 c if (icall.eq.0) lprn=.true.
1753 do i=iatsc_s,iatsc_e
1759 dxi=dc_norm(1,nres+i)
1760 dyi=dc_norm(2,nres+i)
1761 dzi=dc_norm(3,nres+i)
1762 c dsci_inv=dsc_inv(itypi)
1763 dsci_inv=vbld_inv(i+nres)
1765 C Calculate SC interaction energy.
1767 do iint=1,nint_gr(i)
1768 do j=istart(i,iint),iend(i,iint)
1771 c dscj_inv=dsc_inv(itypj)
1772 dscj_inv=vbld_inv(j+nres)
1773 sig0ij=sigma(itypi,itypj)
1774 r0ij=r0(itypi,itypj)
1775 chi1=chi(itypi,itypj)
1776 chi2=chi(itypj,itypi)
1783 alf12=0.5D0*(alf1+alf2)
1784 C For diagnostics only!!!
1797 dxj=dc_norm(1,nres+j)
1798 dyj=dc_norm(2,nres+j)
1799 dzj=dc_norm(3,nres+j)
1800 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1802 C Calculate angle-dependent terms of energy and contributions to their
1806 sig=sig0ij*dsqrt(sigsq)
1807 rij_shift=1.0D0/rij-sig+r0ij
1808 C I hate to put IF's in the loops, but here don't have another choice!!!!
1809 if (rij_shift.le.0.0D0) then
1814 c---------------------------------------------------------------
1815 rij_shift=1.0D0/rij_shift
1816 fac=rij_shift**expon
1817 e1=fac*fac*aa(itypi,itypj)
1818 e2=fac*bb(itypi,itypj)
1819 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1820 eps2der=evdwij*eps3rt
1821 eps3der=evdwij*eps2rt
1822 fac_augm=rrij**expon
1823 e_augm=augm(itypi,itypj)*fac_augm
1824 evdwij=evdwij*eps2rt*eps3rt
1826 if (bb(itypi,itypj).gt.0) then
1827 evdw_p=evdw_p+evdwij+e_augm
1829 evdw_m=evdw_m+evdwij+e_augm
1832 evdw=evdw+evdwij+e_augm
1835 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1836 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1837 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1838 & restyp(itypi),i,restyp(itypj),j,
1839 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1840 & chi1,chi2,chip1,chip2,
1841 & eps1,eps2rt**2,eps3rt**2,
1842 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1845 C Calculate gradient components.
1846 e1=e1*eps1*eps2rt**2*eps3rt**2
1847 fac=-expon*(e1+evdwij)*rij_shift
1849 fac=rij*fac-2*expon*rrij*e_augm
1850 C Calculate the radial part of the gradient
1854 C Calculate angular part of the gradient.
1856 if (bb(itypi,itypj).gt.0) then
1868 C-----------------------------------------------------------------------------
1869 subroutine sc_angular
1870 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1871 C om12. Called by ebp, egb, and egbv.
1873 include 'COMMON.CALC'
1874 include 'COMMON.IOUNITS'
1878 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1879 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1880 om12=dxi*dxj+dyi*dyj+dzi*dzj
1882 C Calculate eps1(om12) and its derivative in om12
1883 faceps1=1.0D0-om12*chiom12
1884 faceps1_inv=1.0D0/faceps1
1885 eps1=dsqrt(faceps1_inv)
1886 C Following variable is eps1*deps1/dom12
1887 eps1_om12=faceps1_inv*chiom12
1892 c write (iout,*) "om12",om12," eps1",eps1
1893 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1898 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1899 sigsq=1.0D0-facsig*faceps1_inv
1900 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1901 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1902 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1908 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1909 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1911 C Calculate eps2 and its derivatives in om1, om2, and om12.
1914 chipom12=chip12*om12
1915 facp=1.0D0-om12*chipom12
1917 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1918 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1919 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1920 C Following variable is the square root of eps2
1921 eps2rt=1.0D0-facp1*facp_inv
1922 C Following three variables are the derivatives of the square root of eps
1923 C in om1, om2, and om12.
1924 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1925 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1926 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1927 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1928 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1929 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1930 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1931 c & " eps2rt_om12",eps2rt_om12
1932 C Calculate whole angle-dependent part of epsilon and contributions
1933 C to its derivatives
1937 C----------------------------------------------------------------------------
1938 subroutine sc_grad_T
1939 implicit real*8 (a-h,o-z)
1940 include 'DIMENSIONS'
1941 include 'COMMON.CHAIN'
1942 include 'COMMON.DERIV'
1943 include 'COMMON.CALC'
1944 include 'COMMON.IOUNITS'
1945 double precision dcosom1(3),dcosom2(3)
1946 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1947 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1948 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1949 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1953 c eom12=evdwij*eps1_om12
1955 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1956 c & " sigder",sigder
1957 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1958 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1960 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1961 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1964 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1966 c write (iout,*) "gg",(gg(k),k=1,3)
1968 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1969 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1970 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1971 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1972 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1973 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1974 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1975 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1977 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1980 C Calculate the components of the gradient in DC and X
1984 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1988 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1989 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1994 C----------------------------------------------------------------------------
1996 implicit real*8 (a-h,o-z)
1997 include 'DIMENSIONS'
1998 include 'COMMON.CHAIN'
1999 include 'COMMON.DERIV'
2000 include 'COMMON.CALC'
2001 include 'COMMON.IOUNITS'
2002 double precision dcosom1(3),dcosom2(3)
2003 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2004 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2005 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2006 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2010 c eom12=evdwij*eps1_om12
2012 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2013 c & " sigder",sigder
2014 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2015 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2017 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2018 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2021 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2023 c write (iout,*) "gg",(gg(k),k=1,3)
2025 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2026 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2027 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2028 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2029 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2030 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2031 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2032 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2033 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2034 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2037 C Calculate the components of the gradient in DC and X
2041 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2045 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2046 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2050 C-----------------------------------------------------------------------
2051 subroutine e_softsphere(evdw)
2053 C This subroutine calculates the interaction energy of nonbonded side chains
2054 C assuming the LJ potential of interaction.
2056 implicit real*8 (a-h,o-z)
2057 include 'DIMENSIONS'
2058 parameter (accur=1.0d-10)
2059 include 'COMMON.GEO'
2060 include 'COMMON.VAR'
2061 include 'COMMON.LOCAL'
2062 include 'COMMON.CHAIN'
2063 include 'COMMON.DERIV'
2064 include 'COMMON.INTERACT'
2065 include 'COMMON.TORSION'
2066 include 'COMMON.SBRIDGE'
2067 include 'COMMON.NAMES'
2068 include 'COMMON.IOUNITS'
2069 include 'COMMON.CONTACTS'
2071 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2073 do i=iatsc_s,iatsc_e
2080 C Calculate SC interaction energy.
2082 do iint=1,nint_gr(i)
2083 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2084 cd & 'iend=',iend(i,iint)
2085 do j=istart(i,iint),iend(i,iint)
2090 rij=xj*xj+yj*yj+zj*zj
2091 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2092 r0ij=r0(itypi,itypj)
2094 c print *,i,j,r0ij,dsqrt(rij)
2095 if (rij.lt.r0ijsq) then
2096 evdwij=0.25d0*(rij-r0ijsq)**2
2104 C Calculate the components of the gradient in DC and X
2110 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2111 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2112 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2113 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2117 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2125 C--------------------------------------------------------------------------
2126 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2129 C Soft-sphere potential of p-p interaction
2131 implicit real*8 (a-h,o-z)
2132 include 'DIMENSIONS'
2133 include 'COMMON.CONTROL'
2134 include 'COMMON.IOUNITS'
2135 include 'COMMON.GEO'
2136 include 'COMMON.VAR'
2137 include 'COMMON.LOCAL'
2138 include 'COMMON.CHAIN'
2139 include 'COMMON.DERIV'
2140 include 'COMMON.INTERACT'
2141 include 'COMMON.CONTACTS'
2142 include 'COMMON.TORSION'
2143 include 'COMMON.VECTORS'
2144 include 'COMMON.FFIELD'
2146 cd write(iout,*) 'In EELEC_soft_sphere'
2153 do i=iatel_s,iatel_e
2157 xmedi=c(1,i)+0.5d0*dxi
2158 ymedi=c(2,i)+0.5d0*dyi
2159 zmedi=c(3,i)+0.5d0*dzi
2161 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2162 do j=ielstart(i),ielend(i)
2166 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2167 r0ij=rpp(iteli,itelj)
2172 xj=c(1,j)+0.5D0*dxj-xmedi
2173 yj=c(2,j)+0.5D0*dyj-ymedi
2174 zj=c(3,j)+0.5D0*dzj-zmedi
2175 rij=xj*xj+yj*yj+zj*zj
2176 if (rij.lt.r0ijsq) then
2177 evdw1ij=0.25d0*(rij-r0ijsq)**2
2185 C Calculate contributions to the Cartesian gradient.
2191 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2192 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2195 * Loop over residues i+1 thru j-1.
2199 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2204 cgrad do i=nnt,nct-1
2206 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2208 cgrad do j=i+1,nct-1
2210 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2216 c------------------------------------------------------------------------------
2217 subroutine vec_and_deriv
2218 implicit real*8 (a-h,o-z)
2219 include 'DIMENSIONS'
2223 include 'COMMON.IOUNITS'
2224 include 'COMMON.GEO'
2225 include 'COMMON.VAR'
2226 include 'COMMON.LOCAL'
2227 include 'COMMON.CHAIN'
2228 include 'COMMON.VECTORS'
2229 include 'COMMON.SETUP'
2230 include 'COMMON.TIME1'
2231 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2232 C Compute the local reference systems. For reference system (i), the
2233 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2234 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2236 do i=ivec_start,ivec_end
2240 if (i.eq.nres-1) then
2241 C Case of the last full residue
2242 C Compute the Z-axis
2243 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2244 costh=dcos(pi-theta(nres))
2245 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2249 C Compute the derivatives of uz
2251 uzder(2,1,1)=-dc_norm(3,i-1)
2252 uzder(3,1,1)= dc_norm(2,i-1)
2253 uzder(1,2,1)= dc_norm(3,i-1)
2255 uzder(3,2,1)=-dc_norm(1,i-1)
2256 uzder(1,3,1)=-dc_norm(2,i-1)
2257 uzder(2,3,1)= dc_norm(1,i-1)
2260 uzder(2,1,2)= dc_norm(3,i)
2261 uzder(3,1,2)=-dc_norm(2,i)
2262 uzder(1,2,2)=-dc_norm(3,i)
2264 uzder(3,2,2)= dc_norm(1,i)
2265 uzder(1,3,2)= dc_norm(2,i)
2266 uzder(2,3,2)=-dc_norm(1,i)
2268 C Compute the Y-axis
2271 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2273 C Compute the derivatives of uy
2276 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2277 & -dc_norm(k,i)*dc_norm(j,i-1)
2278 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2280 uyder(j,j,1)=uyder(j,j,1)-costh
2281 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2286 uygrad(l,k,j,i)=uyder(l,k,j)
2287 uzgrad(l,k,j,i)=uzder(l,k,j)
2291 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2292 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2293 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2294 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2297 C Compute the Z-axis
2298 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2299 costh=dcos(pi-theta(i+2))
2300 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2304 C Compute the derivatives of uz
2306 uzder(2,1,1)=-dc_norm(3,i+1)
2307 uzder(3,1,1)= dc_norm(2,i+1)
2308 uzder(1,2,1)= dc_norm(3,i+1)
2310 uzder(3,2,1)=-dc_norm(1,i+1)
2311 uzder(1,3,1)=-dc_norm(2,i+1)
2312 uzder(2,3,1)= dc_norm(1,i+1)
2315 uzder(2,1,2)= dc_norm(3,i)
2316 uzder(3,1,2)=-dc_norm(2,i)
2317 uzder(1,2,2)=-dc_norm(3,i)
2319 uzder(3,2,2)= dc_norm(1,i)
2320 uzder(1,3,2)= dc_norm(2,i)
2321 uzder(2,3,2)=-dc_norm(1,i)
2323 C Compute the Y-axis
2326 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2328 C Compute the derivatives of uy
2331 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2332 & -dc_norm(k,i)*dc_norm(j,i+1)
2333 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2335 uyder(j,j,1)=uyder(j,j,1)-costh
2336 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2341 uygrad(l,k,j,i)=uyder(l,k,j)
2342 uzgrad(l,k,j,i)=uzder(l,k,j)
2346 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2347 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2348 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2349 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2353 vbld_inv_temp(1)=vbld_inv(i+1)
2354 if (i.lt.nres-1) then
2355 vbld_inv_temp(2)=vbld_inv(i+2)
2357 vbld_inv_temp(2)=vbld_inv(i)
2362 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2363 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2368 #if defined(PARVEC) && defined(MPI)
2369 if (nfgtasks1.gt.1) then
2371 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2372 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2373 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2374 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2375 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2377 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2378 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2380 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2381 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2382 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2383 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2384 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2385 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2386 time_gather=time_gather+MPI_Wtime()-time00
2388 c if (fg_rank.eq.0) then
2389 c write (iout,*) "Arrays UY and UZ"
2391 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2398 C-----------------------------------------------------------------------------
2399 subroutine check_vecgrad
2400 implicit real*8 (a-h,o-z)
2401 include 'DIMENSIONS'
2402 include 'COMMON.IOUNITS'
2403 include 'COMMON.GEO'
2404 include 'COMMON.VAR'
2405 include 'COMMON.LOCAL'
2406 include 'COMMON.CHAIN'
2407 include 'COMMON.VECTORS'
2408 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2409 dimension uyt(3,maxres),uzt(3,maxres)
2410 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2411 double precision delta /1.0d-7/
2414 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2415 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2416 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2417 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2418 cd & (dc_norm(if90,i),if90=1,3)
2419 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2420 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2421 cd write(iout,'(a)')
2427 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2428 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2441 cd write (iout,*) 'i=',i
2443 erij(k)=dc_norm(k,i)
2447 dc_norm(k,i)=erij(k)
2449 dc_norm(j,i)=dc_norm(j,i)+delta
2450 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2452 c dc_norm(k,i)=dc_norm(k,i)/fac
2454 c write (iout,*) (dc_norm(k,i),k=1,3)
2455 c write (iout,*) (erij(k),k=1,3)
2458 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2459 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2460 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2461 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2463 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2464 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2465 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2468 dc_norm(k,i)=erij(k)
2471 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2472 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2473 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2474 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2475 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2476 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2477 cd write (iout,'(a)')
2482 C--------------------------------------------------------------------------
2483 subroutine set_matrices
2484 implicit real*8 (a-h,o-z)
2485 include 'DIMENSIONS'
2488 include "COMMON.SETUP"
2490 integer status(MPI_STATUS_SIZE)
2492 include 'COMMON.IOUNITS'
2493 include 'COMMON.GEO'
2494 include 'COMMON.VAR'
2495 include 'COMMON.LOCAL'
2496 include 'COMMON.CHAIN'
2497 include 'COMMON.DERIV'
2498 include 'COMMON.INTERACT'
2499 include 'COMMON.CONTACTS'
2500 include 'COMMON.TORSION'
2501 include 'COMMON.VECTORS'
2502 include 'COMMON.FFIELD'
2503 double precision auxvec(2),auxmat(2,2)
2505 C Compute the virtual-bond-torsional-angle dependent quantities needed
2506 C to calculate the el-loc multibody terms of various order.
2509 do i=ivec_start+2,ivec_end+2
2513 if (i .lt. nres+1) then
2550 if (i .gt. 3 .and. i .lt. nres+1) then
2551 obrot_der(1,i-2)=-sin1
2552 obrot_der(2,i-2)= cos1
2553 Ugder(1,1,i-2)= sin1
2554 Ugder(1,2,i-2)=-cos1
2555 Ugder(2,1,i-2)=-cos1
2556 Ugder(2,2,i-2)=-sin1
2559 obrot2_der(1,i-2)=-dwasin2
2560 obrot2_der(2,i-2)= dwacos2
2561 Ug2der(1,1,i-2)= dwasin2
2562 Ug2der(1,2,i-2)=-dwacos2
2563 Ug2der(2,1,i-2)=-dwacos2
2564 Ug2der(2,2,i-2)=-dwasin2
2566 obrot_der(1,i-2)=0.0d0
2567 obrot_der(2,i-2)=0.0d0
2568 Ugder(1,1,i-2)=0.0d0
2569 Ugder(1,2,i-2)=0.0d0
2570 Ugder(2,1,i-2)=0.0d0
2571 Ugder(2,2,i-2)=0.0d0
2572 obrot2_der(1,i-2)=0.0d0
2573 obrot2_der(2,i-2)=0.0d0
2574 Ug2der(1,1,i-2)=0.0d0
2575 Ug2der(1,2,i-2)=0.0d0
2576 Ug2der(2,1,i-2)=0.0d0
2577 Ug2der(2,2,i-2)=0.0d0
2579 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2580 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2581 iti = itortyp(itype(i-2))
2585 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2586 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2587 iti1 = itortyp(itype(i-1))
2591 cd write (iout,*) '*******i',i,' iti1',iti
2592 cd write (iout,*) 'b1',b1(:,iti)
2593 cd write (iout,*) 'b2',b2(:,iti)
2594 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2595 c if (i .gt. iatel_s+2) then
2596 if (i .gt. nnt+2) then
2597 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2598 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2599 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2601 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2602 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2603 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2604 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2605 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2616 DtUg2(l,k,i-2)=0.0d0
2620 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2621 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2623 muder(k,i-2)=Ub2der(k,i-2)
2625 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2626 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2627 iti1 = itortyp(itype(i-1))
2632 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2634 cd write (iout,*) 'mu ',mu(:,i-2)
2635 cd write (iout,*) 'mu1',mu1(:,i-2)
2636 cd write (iout,*) 'mu2',mu2(:,i-2)
2637 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2639 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2640 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2641 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2642 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2643 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2644 C Vectors and matrices dependent on a single virtual-bond dihedral.
2645 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2646 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2647 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2648 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2649 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2650 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2651 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2652 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2653 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2656 C Matrices dependent on two consecutive virtual-bond dihedrals.
2657 C The order of matrices is from left to right.
2658 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2660 c do i=max0(ivec_start,2),ivec_end
2662 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2663 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2664 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2665 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2666 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2667 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2668 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2669 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2672 #if defined(MPI) && defined(PARMAT)
2674 c if (fg_rank.eq.0) then
2675 write (iout,*) "Arrays UG and UGDER before GATHER"
2677 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2678 & ((ug(l,k,i),l=1,2),k=1,2),
2679 & ((ugder(l,k,i),l=1,2),k=1,2)
2681 write (iout,*) "Arrays UG2 and UG2DER"
2683 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2684 & ((ug2(l,k,i),l=1,2),k=1,2),
2685 & ((ug2der(l,k,i),l=1,2),k=1,2)
2687 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2689 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2690 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2691 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2693 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2695 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2696 & costab(i),sintab(i),costab2(i),sintab2(i)
2698 write (iout,*) "Array MUDER"
2700 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2704 if (nfgtasks.gt.1) then
2706 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2707 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2708 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2710 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2713 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2714 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2716 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2717 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2719 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2722 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2729 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2730 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2731 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2732 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2733 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2734 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2735 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2736 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2737 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2738 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2739 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2740 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2742 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2745 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2746 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2748 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2749 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2751 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2752 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2754 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2755 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2757 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2758 & ivec_count(fg_rank1),
2759 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2761 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2762 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2764 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2765 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2767 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2768 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2770 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2771 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2773 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2774 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2776 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2777 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2779 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2780 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2782 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2783 & ivec_count(fg_rank1),
2784 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2786 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2787 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2789 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2790 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2792 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2793 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2795 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2796 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2798 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2799 & ivec_count(fg_rank1),
2800 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2802 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2803 & ivec_count(fg_rank1),
2804 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2806 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2807 & ivec_count(fg_rank1),
2808 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2809 & MPI_MAT2,FG_COMM1,IERR)
2810 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2811 & ivec_count(fg_rank1),
2812 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2813 & MPI_MAT2,FG_COMM1,IERR)
2816 c Passes matrix info through the ring
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 if (inext.ge.nfgtasks1) inext=0
2824 c write (iout,*) "isend",isend," irecv",irecv
2826 lensend=lentyp(isend)
2827 lenrecv=lentyp(irecv)
2828 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2829 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2830 c & MPI_ROTAT1(lensend),inext,2200+isend,
2831 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2832 c & iprev,2200+irecv,FG_COMM,status,IERR)
2833 c write (iout,*) "Gather ROTAT1"
2835 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2836 c & MPI_ROTAT2(lensend),inext,3300+isend,
2837 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2838 c & iprev,3300+irecv,FG_COMM,status,IERR)
2839 c write (iout,*) "Gather ROTAT2"
2841 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2842 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2843 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2844 & iprev,4400+irecv,FG_COMM,status,IERR)
2845 c write (iout,*) "Gather ROTAT_OLD"
2847 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2848 & MPI_PRECOMP11(lensend),inext,5500+isend,
2849 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2850 & iprev,5500+irecv,FG_COMM,status,IERR)
2851 c write (iout,*) "Gather PRECOMP11"
2853 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2854 & MPI_PRECOMP12(lensend),inext,6600+isend,
2855 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2856 & iprev,6600+irecv,FG_COMM,status,IERR)
2857 c write (iout,*) "Gather PRECOMP12"
2859 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2861 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2862 & MPI_ROTAT2(lensend),inext,7700+isend,
2863 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2864 & iprev,7700+irecv,FG_COMM,status,IERR)
2865 c write (iout,*) "Gather PRECOMP21"
2867 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2868 & MPI_PRECOMP22(lensend),inext,8800+isend,
2869 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2870 & iprev,8800+irecv,FG_COMM,status,IERR)
2871 c write (iout,*) "Gather PRECOMP22"
2873 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2874 & MPI_PRECOMP23(lensend),inext,9900+isend,
2875 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2876 & MPI_PRECOMP23(lenrecv),
2877 & iprev,9900+irecv,FG_COMM,status,IERR)
2878 c write (iout,*) "Gather PRECOMP23"
2883 if (irecv.lt.0) irecv=nfgtasks1-1
2886 time_gather=time_gather+MPI_Wtime()-time00
2889 c if (fg_rank.eq.0) then
2890 write (iout,*) "Arrays UG and UGDER"
2892 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2893 & ((ug(l,k,i),l=1,2),k=1,2),
2894 & ((ugder(l,k,i),l=1,2),k=1,2)
2896 write (iout,*) "Arrays UG2 and UG2DER"
2898 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2899 & ((ug2(l,k,i),l=1,2),k=1,2),
2900 & ((ug2der(l,k,i),l=1,2),k=1,2)
2902 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2904 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2905 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2906 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2908 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2910 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2911 & costab(i),sintab(i),costab2(i),sintab2(i)
2913 write (iout,*) "Array MUDER"
2915 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2921 cd iti = itortyp(itype(i))
2924 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2925 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2930 C--------------------------------------------------------------------------
2931 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2933 C This subroutine calculates the average interaction energy and its gradient
2934 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2935 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2936 C The potential depends both on the distance of peptide-group centers and on
2937 C the orientation of the CA-CA virtual bonds.
2939 implicit real*8 (a-h,o-z)
2943 include 'DIMENSIONS'
2944 include 'COMMON.CONTROL'
2945 include 'COMMON.SETUP'
2946 include 'COMMON.IOUNITS'
2947 include 'COMMON.GEO'
2948 include 'COMMON.VAR'
2949 include 'COMMON.LOCAL'
2950 include 'COMMON.CHAIN'
2951 include 'COMMON.DERIV'
2952 include 'COMMON.INTERACT'
2953 include 'COMMON.CONTACTS'
2954 include 'COMMON.TORSION'
2955 include 'COMMON.VECTORS'
2956 include 'COMMON.FFIELD'
2957 include 'COMMON.TIME1'
2958 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2959 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2960 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2961 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2962 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2963 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2965 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2967 double precision scal_el /1.0d0/
2969 double precision scal_el /0.5d0/
2972 C 13-go grudnia roku pamietnego...
2973 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2974 & 0.0d0,1.0d0,0.0d0,
2975 & 0.0d0,0.0d0,1.0d0/
2976 cd write(iout,*) 'In EELEC'
2978 cd write(iout,*) 'Type',i
2979 cd write(iout,*) 'B1',B1(:,i)
2980 cd write(iout,*) 'B2',B2(:,i)
2981 cd write(iout,*) 'CC',CC(:,:,i)
2982 cd write(iout,*) 'DD',DD(:,:,i)
2983 cd write(iout,*) 'EE',EE(:,:,i)
2985 cd call check_vecgrad
2987 if (icheckgrad.eq.1) then
2989 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2991 dc_norm(k,i)=dc(k,i)*fac
2993 c write (iout,*) 'i',i,' fac',fac
2996 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2997 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2998 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2999 c call vec_and_deriv
3005 time_mat=time_mat+MPI_Wtime()-time01
3009 cd write (iout,*) 'i=',i
3011 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3014 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3015 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3028 cd print '(a)','Enter EELEC'
3029 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3031 gel_loc_loc(i)=0.0d0
3036 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3038 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3040 do i=iturn3_start,iturn3_end
3044 dx_normi=dc_norm(1,i)
3045 dy_normi=dc_norm(2,i)
3046 dz_normi=dc_norm(3,i)
3047 xmedi=c(1,i)+0.5d0*dxi
3048 ymedi=c(2,i)+0.5d0*dyi
3049 zmedi=c(3,i)+0.5d0*dzi
3051 call eelecij(i,i+2,ees,evdw1,eel_loc)
3052 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3053 num_cont_hb(i)=num_conti
3055 do i=iturn4_start,iturn4_end
3059 dx_normi=dc_norm(1,i)
3060 dy_normi=dc_norm(2,i)
3061 dz_normi=dc_norm(3,i)
3062 xmedi=c(1,i)+0.5d0*dxi
3063 ymedi=c(2,i)+0.5d0*dyi
3064 zmedi=c(3,i)+0.5d0*dzi
3065 num_conti=num_cont_hb(i)
3066 call eelecij(i,i+3,ees,evdw1,eel_loc)
3067 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3068 num_cont_hb(i)=num_conti
3071 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3073 do i=iatel_s,iatel_e
3077 dx_normi=dc_norm(1,i)
3078 dy_normi=dc_norm(2,i)
3079 dz_normi=dc_norm(3,i)
3080 xmedi=c(1,i)+0.5d0*dxi
3081 ymedi=c(2,i)+0.5d0*dyi
3082 zmedi=c(3,i)+0.5d0*dzi
3083 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3084 num_conti=num_cont_hb(i)
3085 do j=ielstart(i),ielend(i)
3086 call eelecij(i,j,ees,evdw1,eel_loc)
3088 num_cont_hb(i)=num_conti
3090 c write (iout,*) "Number of loop steps in EELEC:",ind
3092 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3093 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3095 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3096 ccc eel_loc=eel_loc+eello_turn3
3097 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3100 C-------------------------------------------------------------------------------
3101 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3102 implicit real*8 (a-h,o-z)
3103 include 'DIMENSIONS'
3107 include 'COMMON.CONTROL'
3108 include 'COMMON.IOUNITS'
3109 include 'COMMON.GEO'
3110 include 'COMMON.VAR'
3111 include 'COMMON.LOCAL'
3112 include 'COMMON.CHAIN'
3113 include 'COMMON.DERIV'
3114 include 'COMMON.INTERACT'
3115 include 'COMMON.CONTACTS'
3116 include 'COMMON.TORSION'
3117 include 'COMMON.VECTORS'
3118 include 'COMMON.FFIELD'
3119 include 'COMMON.TIME1'
3120 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3121 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3122 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3123 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3124 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3125 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3127 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3129 double precision scal_el /1.0d0/
3131 double precision scal_el /0.5d0/
3134 C 13-go grudnia roku pamietnego...
3135 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3136 & 0.0d0,1.0d0,0.0d0,
3137 & 0.0d0,0.0d0,1.0d0/
3138 c time00=MPI_Wtime()
3139 cd write (iout,*) "eelecij",i,j
3143 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3144 aaa=app(iteli,itelj)
3145 bbb=bpp(iteli,itelj)
3146 ael6i=ael6(iteli,itelj)
3147 ael3i=ael3(iteli,itelj)
3151 dx_normj=dc_norm(1,j)
3152 dy_normj=dc_norm(2,j)
3153 dz_normj=dc_norm(3,j)
3154 xj=c(1,j)+0.5D0*dxj-xmedi
3155 yj=c(2,j)+0.5D0*dyj-ymedi
3156 zj=c(3,j)+0.5D0*dzj-zmedi
3157 rij=xj*xj+yj*yj+zj*zj
3163 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3164 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3165 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3166 fac=cosa-3.0D0*cosb*cosg
3168 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3169 if (j.eq.i+2) ev1=scal_el*ev1
3174 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3177 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3178 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3181 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3182 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3183 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3184 cd & xmedi,ymedi,zmedi,xj,yj,zj
3186 if (energy_dec) then
3187 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3188 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3192 C Calculate contributions to the Cartesian gradient.
3195 facvdw=-6*rrmij*(ev1+evdwij)
3196 facel=-3*rrmij*(el1+eesij)
3202 * Radial derivatives. First process both termini of the fragment (i,j)
3208 c ghalf=0.5D0*ggg(k)
3209 c gelc(k,i)=gelc(k,i)+ghalf
3210 c gelc(k,j)=gelc(k,j)+ghalf
3212 c 9/28/08 AL Gradient compotents will be summed only at the end
3214 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3215 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3218 * Loop over residues i+1 thru j-1.
3222 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3229 c ghalf=0.5D0*ggg(k)
3230 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3231 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3233 c 9/28/08 AL Gradient compotents will be summed only at the end
3235 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3236 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3239 * Loop over residues i+1 thru j-1.
3243 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3250 fac=-3*rrmij*(facvdw+facvdw+facel)
3255 * Radial derivatives. First process both termini of the fragment (i,j)
3261 c ghalf=0.5D0*ggg(k)
3262 c gelc(k,i)=gelc(k,i)+ghalf
3263 c gelc(k,j)=gelc(k,j)+ghalf
3265 c 9/28/08 AL Gradient compotents will be summed only at the end
3267 gelc_long(k,j)=gelc(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc(k,i)-ggg(k)
3271 * Loop over residues i+1 thru j-1.
3275 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3278 c 9/28/08 AL Gradient compotents will be summed only at the end
3283 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3284 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3290 ecosa=2.0D0*fac3*fac1+fac4
3293 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3294 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3296 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3297 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3299 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3300 cd & (dcosg(k),k=1,3)
3302 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3305 c ghalf=0.5D0*ggg(k)
3306 c gelc(k,i)=gelc(k,i)+ghalf
3307 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3308 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3309 c gelc(k,j)=gelc(k,j)+ghalf
3310 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3311 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3315 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3320 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3321 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3323 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3324 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3325 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3326 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3328 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3329 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3330 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3332 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3333 C energy of a peptide unit is assumed in the form of a second-order
3334 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3335 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3336 C are computed for EVERY pair of non-contiguous peptide groups.
3338 if (j.lt.nres-1) then
3349 muij(kkk)=mu(k,i)*mu(l,j)
3352 cd write (iout,*) 'EELEC: i',i,' j',j
3353 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3354 cd write(iout,*) 'muij',muij
3355 ury=scalar(uy(1,i),erij)
3356 urz=scalar(uz(1,i),erij)
3357 vry=scalar(uy(1,j),erij)
3358 vrz=scalar(uz(1,j),erij)
3359 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3360 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3361 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3362 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3363 fac=dsqrt(-ael6i)*r3ij
3368 cd write (iout,'(4i5,4f10.5)')
3369 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3370 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3371 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3372 cd & uy(:,j),uz(:,j)
3373 cd write (iout,'(4f10.5)')
3374 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3375 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3376 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3377 cd write (iout,'(9f10.5/)')
3378 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3379 C Derivatives of the elements of A in virtual-bond vectors
3380 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3382 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3383 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3384 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3385 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3386 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3387 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3388 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3389 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3390 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3391 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3392 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3393 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3395 C Compute radial contributions to the gradient
3413 C Add the contributions coming from er
3416 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3417 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3418 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3419 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3422 C Derivatives in DC(i)
3423 cgrad ghalf1=0.5d0*agg(k,1)
3424 cgrad ghalf2=0.5d0*agg(k,2)
3425 cgrad ghalf3=0.5d0*agg(k,3)
3426 cgrad ghalf4=0.5d0*agg(k,4)
3427 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3428 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3429 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3430 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3431 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3432 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3433 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3434 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3435 C Derivatives in DC(i+1)
3436 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3437 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3438 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3439 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3440 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3441 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3442 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3443 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3444 C Derivatives in DC(j)
3445 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3446 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3447 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3448 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3449 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3450 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3451 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3452 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3453 C Derivatives in DC(j+1) or DC(nres-1)
3454 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3455 & -3.0d0*vryg(k,3)*ury)
3456 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3457 & -3.0d0*vrzg(k,3)*ury)
3458 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3459 & -3.0d0*vryg(k,3)*urz)
3460 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3461 & -3.0d0*vrzg(k,3)*urz)
3462 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3464 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3477 aggi(k,l)=-aggi(k,l)
3478 aggi1(k,l)=-aggi1(k,l)
3479 aggj(k,l)=-aggj(k,l)
3480 aggj1(k,l)=-aggj1(k,l)
3483 if (j.lt.nres-1) then
3489 aggi(k,l)=-aggi(k,l)
3490 aggi1(k,l)=-aggi1(k,l)
3491 aggj(k,l)=-aggj(k,l)
3492 aggj1(k,l)=-aggj1(k,l)
3503 aggi(k,l)=-aggi(k,l)
3504 aggi1(k,l)=-aggi1(k,l)
3505 aggj(k,l)=-aggj(k,l)
3506 aggj1(k,l)=-aggj1(k,l)
3511 IF (wel_loc.gt.0.0d0) THEN
3512 C Contribution to the local-electrostatic energy coming from the i-j pair
3513 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3515 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3517 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3518 & 'eelloc',i,j,eel_loc_ij
3520 eel_loc=eel_loc+eel_loc_ij
3521 C Partial derivatives in virtual-bond dihedral angles gamma
3523 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3524 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3525 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3526 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3527 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3528 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3529 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3531 ggg(l)=agg(l,1)*muij(1)+
3532 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3533 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3534 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3535 cgrad ghalf=0.5d0*ggg(l)
3536 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3537 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3541 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3544 C Remaining derivatives of eello
3546 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3547 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3548 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3549 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3550 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3551 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3552 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3553 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3556 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3557 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3558 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3559 & .and. num_conti.le.maxconts) then
3560 c write (iout,*) i,j," entered corr"
3562 C Calculate the contact function. The ith column of the array JCONT will
3563 C contain the numbers of atoms that make contacts with the atom I (of numbers
3564 C greater than I). The arrays FACONT and GACONT will contain the values of
3565 C the contact function and its derivative.
3566 c r0ij=1.02D0*rpp(iteli,itelj)
3567 c r0ij=1.11D0*rpp(iteli,itelj)
3568 r0ij=2.20D0*rpp(iteli,itelj)
3569 c r0ij=1.55D0*rpp(iteli,itelj)
3570 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3571 if (fcont.gt.0.0D0) then
3572 num_conti=num_conti+1
3573 if (num_conti.gt.maxconts) then
3574 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3575 & ' will skip next contacts for this conf.'
3577 jcont_hb(num_conti,i)=j
3578 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3579 cd & " jcont_hb",jcont_hb(num_conti,i)
3580 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3581 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3582 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3584 d_cont(num_conti,i)=rij
3585 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3586 C --- Electrostatic-interaction matrix ---
3587 a_chuj(1,1,num_conti,i)=a22
3588 a_chuj(1,2,num_conti,i)=a23
3589 a_chuj(2,1,num_conti,i)=a32
3590 a_chuj(2,2,num_conti,i)=a33
3591 C --- Gradient of rij
3593 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3600 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3601 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3602 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3603 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3604 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3609 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3610 C Calculate contact energies
3612 wij=cosa-3.0D0*cosb*cosg
3615 c fac3=dsqrt(-ael6i)/r0ij**3
3616 fac3=dsqrt(-ael6i)*r3ij
3617 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3618 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3619 if (ees0tmp.gt.0) then
3620 ees0pij=dsqrt(ees0tmp)
3624 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3625 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3626 if (ees0tmp.gt.0) then
3627 ees0mij=dsqrt(ees0tmp)
3632 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3633 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3634 C Diagnostics. Comment out or remove after debugging!
3635 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3636 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3637 c ees0m(num_conti,i)=0.0D0
3639 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3640 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3641 C Angular derivatives of the contact function
3642 ees0pij1=fac3/ees0pij
3643 ees0mij1=fac3/ees0mij
3644 fac3p=-3.0D0*fac3*rrmij
3645 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3646 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3648 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3649 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3650 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3651 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3652 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3653 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3654 ecosap=ecosa1+ecosa2
3655 ecosbp=ecosb1+ecosb2
3656 ecosgp=ecosg1+ecosg2
3657 ecosam=ecosa1-ecosa2
3658 ecosbm=ecosb1-ecosb2
3659 ecosgm=ecosg1-ecosg2
3668 facont_hb(num_conti,i)=fcont
3669 fprimcont=fprimcont/rij
3670 cd facont_hb(num_conti,i)=1.0D0
3671 C Following line is for diagnostics.
3674 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3675 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3678 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3679 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3681 gggp(1)=gggp(1)+ees0pijp*xj
3682 gggp(2)=gggp(2)+ees0pijp*yj
3683 gggp(3)=gggp(3)+ees0pijp*zj
3684 gggm(1)=gggm(1)+ees0mijp*xj
3685 gggm(2)=gggm(2)+ees0mijp*yj
3686 gggm(3)=gggm(3)+ees0mijp*zj
3687 C Derivatives due to the contact function
3688 gacont_hbr(1,num_conti,i)=fprimcont*xj
3689 gacont_hbr(2,num_conti,i)=fprimcont*yj
3690 gacont_hbr(3,num_conti,i)=fprimcont*zj
3693 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3694 c following the change of gradient-summation algorithm.
3696 cgrad ghalfp=0.5D0*gggp(k)
3697 cgrad ghalfm=0.5D0*gggm(k)
3698 gacontp_hb1(k,num_conti,i)=!ghalfp
3699 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3700 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3701 gacontp_hb2(k,num_conti,i)=!ghalfp
3702 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3703 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3704 gacontp_hb3(k,num_conti,i)=gggp(k)
3705 gacontm_hb1(k,num_conti,i)=!ghalfm
3706 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3707 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3708 gacontm_hb2(k,num_conti,i)=!ghalfm
3709 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3710 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3711 gacontm_hb3(k,num_conti,i)=gggm(k)
3713 C Diagnostics. Comment out or remove after debugging!
3715 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3716 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3717 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3718 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3719 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3720 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3723 endif ! num_conti.le.maxconts
3726 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3729 ghalf=0.5d0*agg(l,k)
3730 aggi(l,k)=aggi(l,k)+ghalf
3731 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3732 aggj(l,k)=aggj(l,k)+ghalf
3735 if (j.eq.nres-1 .and. i.lt.j-2) then
3738 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3743 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3746 C-----------------------------------------------------------------------------
3747 subroutine eturn3(i,eello_turn3)
3748 C Third- and fourth-order contributions from turns
3749 implicit real*8 (a-h,o-z)
3750 include 'DIMENSIONS'
3751 include 'COMMON.IOUNITS'
3752 include 'COMMON.GEO'
3753 include 'COMMON.VAR'
3754 include 'COMMON.LOCAL'
3755 include 'COMMON.CHAIN'
3756 include 'COMMON.DERIV'
3757 include 'COMMON.INTERACT'
3758 include 'COMMON.CONTACTS'
3759 include 'COMMON.TORSION'
3760 include 'COMMON.VECTORS'
3761 include 'COMMON.FFIELD'
3762 include 'COMMON.CONTROL'
3764 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3765 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3766 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3767 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3768 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3769 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3770 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3773 c write (iout,*) "eturn3",i,j,j1,j2
3778 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3780 C Third-order contributions
3787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3788 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3789 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3790 call transpose2(auxmat(1,1),auxmat1(1,1))
3791 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3792 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3793 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3794 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3795 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3796 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3797 cd & ' eello_turn3_num',4*eello_turn3_num
3798 C Derivatives in gamma(i)
3799 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3800 call transpose2(auxmat2(1,1),auxmat3(1,1))
3801 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3802 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3803 C Derivatives in gamma(i+1)
3804 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3805 call transpose2(auxmat2(1,1),auxmat3(1,1))
3806 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3807 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3808 & +0.5d0*(pizda(1,1)+pizda(2,2))
3809 C Cartesian derivatives
3811 c ghalf1=0.5d0*agg(l,1)
3812 c ghalf2=0.5d0*agg(l,2)
3813 c ghalf3=0.5d0*agg(l,3)
3814 c ghalf4=0.5d0*agg(l,4)
3815 a_temp(1,1)=aggi(l,1)!+ghalf1
3816 a_temp(1,2)=aggi(l,2)!+ghalf2
3817 a_temp(2,1)=aggi(l,3)!+ghalf3
3818 a_temp(2,2)=aggi(l,4)!+ghalf4
3819 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3820 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3821 & +0.5d0*(pizda(1,1)+pizda(2,2))
3822 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3823 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3824 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3825 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3826 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3827 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3828 & +0.5d0*(pizda(1,1)+pizda(2,2))
3829 a_temp(1,1)=aggj(l,1)!+ghalf1
3830 a_temp(1,2)=aggj(l,2)!+ghalf2
3831 a_temp(2,1)=aggj(l,3)!+ghalf3
3832 a_temp(2,2)=aggj(l,4)!+ghalf4
3833 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3834 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3835 & +0.5d0*(pizda(1,1)+pizda(2,2))
3836 a_temp(1,1)=aggj1(l,1)
3837 a_temp(1,2)=aggj1(l,2)
3838 a_temp(2,1)=aggj1(l,3)
3839 a_temp(2,2)=aggj1(l,4)
3840 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3841 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3842 & +0.5d0*(pizda(1,1)+pizda(2,2))
3846 C-------------------------------------------------------------------------------
3847 subroutine eturn4(i,eello_turn4)
3848 C Third- and fourth-order contributions from turns
3849 implicit real*8 (a-h,o-z)
3850 include 'DIMENSIONS'
3851 include 'COMMON.IOUNITS'
3852 include 'COMMON.GEO'
3853 include 'COMMON.VAR'
3854 include 'COMMON.LOCAL'
3855 include 'COMMON.CHAIN'
3856 include 'COMMON.DERIV'
3857 include 'COMMON.INTERACT'
3858 include 'COMMON.CONTACTS'
3859 include 'COMMON.TORSION'
3860 include 'COMMON.VECTORS'
3861 include 'COMMON.FFIELD'
3862 include 'COMMON.CONTROL'
3864 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3865 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3866 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3867 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3868 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3869 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3870 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3873 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3875 C Fourth-order contributions
3883 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3884 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3885 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3890 iti1=itortyp(itype(i+1))
3891 iti2=itortyp(itype(i+2))
3892 iti3=itortyp(itype(i+3))
3893 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3894 call transpose2(EUg(1,1,i+1),e1t(1,1))
3895 call transpose2(Eug(1,1,i+2),e2t(1,1))
3896 call transpose2(Eug(1,1,i+3),e3t(1,1))
3897 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3898 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3899 s1=scalar2(b1(1,iti2),auxvec(1))
3900 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3901 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3902 s2=scalar2(b1(1,iti1),auxvec(1))
3903 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3904 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3905 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3906 eello_turn4=eello_turn4-(s1+s2+s3)
3907 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3908 & 'eturn4',i,j,-(s1+s2+s3)
3909 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3910 cd & ' eello_turn4_num',8*eello_turn4_num
3911 C Derivatives in gamma(i)
3912 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3913 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3914 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3917 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3918 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3919 C Derivatives in gamma(i+1)
3920 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3921 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3922 s2=scalar2(b1(1,iti1),auxvec(1))
3923 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3924 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3925 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3926 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3927 C Derivatives in gamma(i+2)
3928 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3929 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3930 s1=scalar2(b1(1,iti2),auxvec(1))
3931 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3932 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3933 s2=scalar2(b1(1,iti1),auxvec(1))
3934 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3935 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3936 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3937 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3938 C Cartesian derivatives
3939 C Derivatives of this turn contributions in DC(i+2)
3940 if (j.lt.nres-1) then
3942 a_temp(1,1)=agg(l,1)
3943 a_temp(1,2)=agg(l,2)
3944 a_temp(2,1)=agg(l,3)
3945 a_temp(2,2)=agg(l,4)
3946 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3947 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3948 s1=scalar2(b1(1,iti2),auxvec(1))
3949 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3950 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3951 s2=scalar2(b1(1,iti1),auxvec(1))
3952 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3953 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3954 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3956 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3959 C Remaining derivatives of this turn contribution
3961 a_temp(1,1)=aggi(l,1)
3962 a_temp(1,2)=aggi(l,2)
3963 a_temp(2,1)=aggi(l,3)
3964 a_temp(2,2)=aggi(l,4)
3965 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3966 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3967 s1=scalar2(b1(1,iti2),auxvec(1))
3968 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3969 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3970 s2=scalar2(b1(1,iti1),auxvec(1))
3971 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3972 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3973 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3974 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3975 a_temp(1,1)=aggi1(l,1)
3976 a_temp(1,2)=aggi1(l,2)
3977 a_temp(2,1)=aggi1(l,3)
3978 a_temp(2,2)=aggi1(l,4)
3979 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3980 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,iti2),auxvec(1))
3982 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3983 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3984 s2=scalar2(b1(1,iti1),auxvec(1))
3985 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3986 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3988 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3989 a_temp(1,1)=aggj(l,1)
3990 a_temp(1,2)=aggj(l,2)
3991 a_temp(2,1)=aggj(l,3)
3992 a_temp(2,2)=aggj(l,4)
3993 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3994 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3995 s1=scalar2(b1(1,iti2),auxvec(1))
3996 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3997 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3998 s2=scalar2(b1(1,iti1),auxvec(1))
3999 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4000 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4001 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4002 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4003 a_temp(1,1)=aggj1(l,1)
4004 a_temp(1,2)=aggj1(l,2)
4005 a_temp(2,1)=aggj1(l,3)
4006 a_temp(2,2)=aggj1(l,4)
4007 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4008 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4009 s1=scalar2(b1(1,iti2),auxvec(1))
4010 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4011 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4012 s2=scalar2(b1(1,iti1),auxvec(1))
4013 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4014 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4015 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4016 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4017 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4021 C-----------------------------------------------------------------------------
4022 subroutine vecpr(u,v,w)
4023 implicit real*8(a-h,o-z)
4024 dimension u(3),v(3),w(3)
4025 w(1)=u(2)*v(3)-u(3)*v(2)
4026 w(2)=-u(1)*v(3)+u(3)*v(1)
4027 w(3)=u(1)*v(2)-u(2)*v(1)
4030 C-----------------------------------------------------------------------------
4031 subroutine unormderiv(u,ugrad,unorm,ungrad)
4032 C This subroutine computes the derivatives of a normalized vector u, given
4033 C the derivatives computed without normalization conditions, ugrad. Returns
4036 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4037 double precision vec(3)
4038 double precision scalar
4040 c write (2,*) 'ugrad',ugrad
4043 vec(i)=scalar(ugrad(1,i),u(1))
4045 c write (2,*) 'vec',vec
4048 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4051 c write (2,*) 'ungrad',ungrad
4054 C-----------------------------------------------------------------------------
4055 subroutine escp_soft_sphere(evdw2,evdw2_14)
4057 C This subroutine calculates the excluded-volume interaction energy between
4058 C peptide-group centers and side chains and its gradient in virtual-bond and
4059 C side-chain vectors.
4061 implicit real*8 (a-h,o-z)
4062 include 'DIMENSIONS'
4063 include 'COMMON.GEO'
4064 include 'COMMON.VAR'
4065 include 'COMMON.LOCAL'
4066 include 'COMMON.CHAIN'
4067 include 'COMMON.DERIV'
4068 include 'COMMON.INTERACT'
4069 include 'COMMON.FFIELD'
4070 include 'COMMON.IOUNITS'
4071 include 'COMMON.CONTROL'
4076 cd print '(a)','Enter ESCP'
4077 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4078 do i=iatscp_s,iatscp_e
4080 xi=0.5D0*(c(1,i)+c(1,i+1))
4081 yi=0.5D0*(c(2,i)+c(2,i+1))
4082 zi=0.5D0*(c(3,i)+c(3,i+1))
4084 do iint=1,nscp_gr(i)
4086 do j=iscpstart(i,iint),iscpend(i,iint)
4088 C Uncomment following three lines for SC-p interactions
4092 C Uncomment following three lines for Ca-p interactions
4096 rij=xj*xj+yj*yj+zj*zj
4099 if (rij.lt.r0ijsq) then
4100 evdwij=0.25d0*(rij-r0ijsq)**2
4108 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4113 cgrad if (j.lt.i) then
4114 cd write (iout,*) 'j<i'
4115 C Uncomment following three lines for SC-p interactions
4117 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4120 cd write (iout,*) 'j>i'
4122 cgrad ggg(k)=-ggg(k)
4123 C Uncomment following line for SC-p interactions
4124 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4128 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4130 cgrad kstart=min0(i+1,j)
4131 cgrad kend=max0(i-1,j-1)
4132 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4133 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4134 cgrad do k=kstart,kend
4136 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4140 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4141 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4149 C-----------------------------------------------------------------------------
4150 subroutine escp(evdw2,evdw2_14)
4152 C This subroutine calculates the excluded-volume interaction energy between
4153 C peptide-group centers and side chains and its gradient in virtual-bond and
4154 C side-chain vectors.
4156 implicit real*8 (a-h,o-z)
4157 include 'DIMENSIONS'
4158 include 'COMMON.GEO'
4159 include 'COMMON.VAR'
4160 include 'COMMON.LOCAL'
4161 include 'COMMON.CHAIN'
4162 include 'COMMON.DERIV'
4163 include 'COMMON.INTERACT'
4164 include 'COMMON.FFIELD'
4165 include 'COMMON.IOUNITS'
4166 include 'COMMON.CONTROL'
4170 cd print '(a)','Enter ESCP'
4171 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4172 do i=iatscp_s,iatscp_e
4174 xi=0.5D0*(c(1,i)+c(1,i+1))
4175 yi=0.5D0*(c(2,i)+c(2,i+1))
4176 zi=0.5D0*(c(3,i)+c(3,i+1))
4178 do iint=1,nscp_gr(i)
4180 do j=iscpstart(i,iint),iscpend(i,iint)
4182 C Uncomment following three lines for SC-p interactions
4186 C Uncomment following three lines for Ca-p interactions
4190 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4192 e1=fac*fac*aad(itypj,iteli)
4193 e2=fac*bad(itypj,iteli)
4194 if (iabs(j-i) .le. 2) then
4197 evdw2_14=evdw2_14+e1+e2
4201 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4202 & 'evdw2',i,j,evdwij
4204 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4206 fac=-(evdwij+e1)*rrij
4210 cgrad if (j.lt.i) then
4211 cd write (iout,*) 'j<i'
4212 C Uncomment following three lines for SC-p interactions
4214 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4217 cd write (iout,*) 'j>i'
4219 cgrad ggg(k)=-ggg(k)
4220 C Uncomment following line for SC-p interactions
4221 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4222 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4226 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4228 cgrad kstart=min0(i+1,j)
4229 cgrad kend=max0(i-1,j-1)
4230 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4231 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4232 cgrad do k=kstart,kend
4234 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4238 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4239 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4247 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4248 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4249 gradx_scp(j,i)=expon*gradx_scp(j,i)
4252 C******************************************************************************
4256 C To save time the factor EXPON has been extracted from ALL components
4257 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4260 C******************************************************************************
4263 C--------------------------------------------------------------------------
4264 subroutine edis(ehpb)
4266 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4268 implicit real*8 (a-h,o-z)
4269 include 'DIMENSIONS'
4270 include 'COMMON.SBRIDGE'
4271 include 'COMMON.CHAIN'
4272 include 'COMMON.DERIV'
4273 include 'COMMON.VAR'
4274 include 'COMMON.INTERACT'
4275 include 'COMMON.IOUNITS'
4278 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4279 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4280 if (link_end.eq.0) return
4281 do i=link_start,link_end
4282 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4283 C CA-CA distance used in regularization of structure.
4286 C iii and jjj point to the residues for which the distance is assigned.
4287 if (ii.gt.nres) then
4294 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4295 c & dhpb(i),dhpb1(i),forcon(i)
4296 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4297 C distance and angle dependent SS bond potential.
4298 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4299 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4300 if (.not.dyn_ss .and. i.le.nss) then
4301 C 15/02/13 CC dynamic SSbond - additional check
4303 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4304 call ssbond_ene(iii,jjj,eij)
4307 cd write (iout,*) "eij",eij
4308 else if (ii.gt.nres .and. jj.gt.nres) then
4309 c Restraints from contact prediction
4311 if (dhpb1(i).gt.0.0d0) then
4312 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4313 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4314 c write (iout,*) "beta nmr",
4315 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4319 C Get the force constant corresponding to this distance.
4321 C Calculate the contribution to energy.
4322 ehpb=ehpb+waga*rdis*rdis
4323 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4325 C Evaluate gradient.
4330 ggg(j)=fac*(c(j,jj)-c(j,ii))
4333 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4334 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4337 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4338 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4341 C Calculate the distance between the two points and its difference from the
4344 if (dhpb1(i).gt.0.0d0) then
4345 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4346 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4347 c write (iout,*) "alph nmr",
4348 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4351 C Get the force constant corresponding to this distance.
4353 C Calculate the contribution to energy.
4354 ehpb=ehpb+waga*rdis*rdis
4355 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4357 C Evaluate gradient.
4361 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4362 cd & ' waga=',waga,' fac=',fac
4364 ggg(j)=fac*(c(j,jj)-c(j,ii))
4366 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4367 C If this is a SC-SC distance, we need to calculate the contributions to the
4368 C Cartesian gradient in the SC vectors (ghpbx).
4371 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4372 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4375 cgrad do j=iii,jjj-1
4377 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4381 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4382 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4389 C--------------------------------------------------------------------------
4390 subroutine ssbond_ene(i,j,eij)
4392 C Calculate the distance and angle dependent SS-bond potential energy
4393 C using a free-energy function derived based on RHF/6-31G** ab initio
4394 C calculations of diethyl disulfide.
4396 C A. Liwo and U. Kozlowska, 11/24/03
4398 implicit real*8 (a-h,o-z)
4399 include 'DIMENSIONS'
4400 include 'COMMON.SBRIDGE'
4401 include 'COMMON.CHAIN'
4402 include 'COMMON.DERIV'
4403 include 'COMMON.LOCAL'
4404 include 'COMMON.INTERACT'
4405 include 'COMMON.VAR'
4406 include 'COMMON.IOUNITS'
4407 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4412 dxi=dc_norm(1,nres+i)
4413 dyi=dc_norm(2,nres+i)
4414 dzi=dc_norm(3,nres+i)
4415 c dsci_inv=dsc_inv(itypi)
4416 dsci_inv=vbld_inv(nres+i)
4418 c dscj_inv=dsc_inv(itypj)
4419 dscj_inv=vbld_inv(nres+j)
4423 dxj=dc_norm(1,nres+j)
4424 dyj=dc_norm(2,nres+j)
4425 dzj=dc_norm(3,nres+j)
4426 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4431 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4432 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4433 om12=dxi*dxj+dyi*dyj+dzi*dzj
4435 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4436 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4442 deltat12=om2-om1+2.0d0
4444 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4445 & +akct*deltad*deltat12+ebr
4446 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4447 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4448 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4449 c & " deltat12",deltat12," eij",eij
4450 ed=2*akcm*deltad+akct*deltat12
4452 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4453 eom1=-2*akth*deltat1-pom1-om2*pom2
4454 eom2= 2*akth*deltat2+pom1-om1*pom2
4457 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4458 ghpbx(k,i)=ghpbx(k,i)-ggk
4459 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4460 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4461 ghpbx(k,j)=ghpbx(k,j)+ggk
4462 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4463 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4464 ghpbc(k,i)=ghpbc(k,i)-ggk
4465 ghpbc(k,j)=ghpbc(k,j)+ggk
4468 C Calculate the components of the gradient in DC and X
4472 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4477 C--------------------------------------------------------------------------
4478 subroutine ebond(estr)
4480 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4482 implicit real*8 (a-h,o-z)
4483 include 'DIMENSIONS'
4484 include 'COMMON.LOCAL'
4485 include 'COMMON.GEO'
4486 include 'COMMON.INTERACT'
4487 include 'COMMON.DERIV'
4488 include 'COMMON.VAR'
4489 include 'COMMON.CHAIN'
4490 include 'COMMON.IOUNITS'
4491 include 'COMMON.NAMES'
4492 include 'COMMON.FFIELD'
4493 include 'COMMON.CONTROL'
4494 include 'COMMON.SETUP'
4495 double precision u(3),ud(3)
4497 do i=ibondp_start,ibondp_end
4498 diff = vbld(i)-vbldp0
4499 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4502 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4504 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4508 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4510 do i=ibond_start,ibond_end
4515 diff=vbld(i+nres)-vbldsc0(1,iti)
4516 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4517 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4518 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4520 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4524 diff=vbld(i+nres)-vbldsc0(j,iti)
4525 ud(j)=aksc(j,iti)*diff
4526 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4540 uprod2=uprod2*u(k)*u(k)
4544 usumsqder=usumsqder+ud(j)*uprod2
4546 estr=estr+uprod/usum
4548 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4556 C--------------------------------------------------------------------------
4557 subroutine ebend(etheta)
4559 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4560 C angles gamma and its derivatives in consecutive thetas and gammas.
4562 implicit real*8 (a-h,o-z)
4563 include 'DIMENSIONS'
4564 include 'COMMON.LOCAL'
4565 include 'COMMON.GEO'
4566 include 'COMMON.INTERACT'
4567 include 'COMMON.DERIV'
4568 include 'COMMON.VAR'
4569 include 'COMMON.CHAIN'
4570 include 'COMMON.IOUNITS'
4571 include 'COMMON.NAMES'
4572 include 'COMMON.FFIELD'
4573 include 'COMMON.CONTROL'
4574 common /calcthet/ term1,term2,termm,diffak,ratak,
4575 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4576 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4577 double precision y(2),z(2)
4579 c time11=dexp(-2*time)
4582 c write (*,'(a,i2)') 'EBEND ICG=',icg
4583 do i=ithet_start,ithet_end
4584 C Zero the energy function and its derivative at 0 or pi.
4585 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4590 if (phii.ne.phii) phii=150.0
4603 if (phii1.ne.phii1) phii1=150.0
4615 C Calculate the "mean" value of theta from the part of the distribution
4616 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4617 C In following comments this theta will be referred to as t_c.
4618 thet_pred_mean=0.0d0
4622 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4624 dthett=thet_pred_mean*ssd
4625 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4626 C Derivatives of the "mean" values in gamma1 and gamma2.
4627 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4628 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4629 if (theta(i).gt.pi-delta) then
4630 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4632 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4633 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4634 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4636 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4638 else if (theta(i).lt.delta) then
4639 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4640 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4641 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4643 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4644 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4647 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4650 etheta=etheta+ethetai
4651 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4653 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4654 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4655 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4657 C Ufff.... We've done all this!!!
4660 C---------------------------------------------------------------------------
4661 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4663 implicit real*8 (a-h,o-z)
4664 include 'DIMENSIONS'
4665 include 'COMMON.LOCAL'
4666 include 'COMMON.IOUNITS'
4667 common /calcthet/ term1,term2,termm,diffak,ratak,
4668 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4669 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4670 C Calculate the contributions to both Gaussian lobes.
4671 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4672 C The "polynomial part" of the "standard deviation" of this part of
4676 sig=sig*thet_pred_mean+polthet(j,it)
4678 C Derivative of the "interior part" of the "standard deviation of the"
4679 C gamma-dependent Gaussian lobe in t_c.
4680 sigtc=3*polthet(3,it)
4682 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4685 C Set the parameters of both Gaussian lobes of the distribution.
4686 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4687 fac=sig*sig+sigc0(it)
4690 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4691 sigsqtc=-4.0D0*sigcsq*sigtc
4692 c print *,i,sig,sigtc,sigsqtc
4693 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4694 sigtc=-sigtc/(fac*fac)
4695 C Following variable is sigma(t_c)**(-2)
4696 sigcsq=sigcsq*sigcsq
4698 sig0inv=1.0D0/sig0i**2
4699 delthec=thetai-thet_pred_mean
4700 delthe0=thetai-theta0i
4701 term1=-0.5D0*sigcsq*delthec*delthec
4702 term2=-0.5D0*sig0inv*delthe0*delthe0
4703 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4704 C NaNs in taking the logarithm. We extract the largest exponent which is added
4705 C to the energy (this being the log of the distribution) at the end of energy
4706 C term evaluation for this virtual-bond angle.
4707 if (term1.gt.term2) then
4709 term2=dexp(term2-termm)
4713 term1=dexp(term1-termm)
4716 C The ratio between the gamma-independent and gamma-dependent lobes of
4717 C the distribution is a Gaussian function of thet_pred_mean too.
4718 diffak=gthet(2,it)-thet_pred_mean
4719 ratak=diffak/gthet(3,it)**2
4720 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4721 C Let's differentiate it in thet_pred_mean NOW.
4723 C Now put together the distribution terms to make complete distribution.
4724 termexp=term1+ak*term2
4725 termpre=sigc+ak*sig0i
4726 C Contribution of the bending energy from this theta is just the -log of
4727 C the sum of the contributions from the two lobes and the pre-exponential
4728 C factor. Simple enough, isn't it?
4729 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4730 C NOW the derivatives!!!
4731 C 6/6/97 Take into account the deformation.
4732 E_theta=(delthec*sigcsq*term1
4733 & +ak*delthe0*sig0inv*term2)/termexp
4734 E_tc=((sigtc+aktc*sig0i)/termpre
4735 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4736 & aktc*term2)/termexp)
4739 c-----------------------------------------------------------------------------
4740 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4741 implicit real*8 (a-h,o-z)
4742 include 'DIMENSIONS'
4743 include 'COMMON.LOCAL'
4744 include 'COMMON.IOUNITS'
4745 common /calcthet/ term1,term2,termm,diffak,ratak,
4746 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4747 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4748 delthec=thetai-thet_pred_mean
4749 delthe0=thetai-theta0i
4750 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4751 t3 = thetai-thet_pred_mean
4755 t14 = t12+t6*sigsqtc
4757 t21 = thetai-theta0i
4763 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4764 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4765 & *(-t12*t9-ak*sig0inv*t27)
4769 C--------------------------------------------------------------------------
4770 subroutine ebend(etheta)
4772 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4773 C angles gamma and its derivatives in consecutive thetas and gammas.
4774 C ab initio-derived potentials from
4775 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4777 implicit real*8 (a-h,o-z)
4778 include 'DIMENSIONS'
4779 include 'COMMON.LOCAL'
4780 include 'COMMON.GEO'
4781 include 'COMMON.INTERACT'
4782 include 'COMMON.DERIV'
4783 include 'COMMON.VAR'
4784 include 'COMMON.CHAIN'
4785 include 'COMMON.IOUNITS'
4786 include 'COMMON.NAMES'
4787 include 'COMMON.FFIELD'
4788 include 'COMMON.CONTROL'
4789 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4790 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4791 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4792 & sinph1ph2(maxdouble,maxdouble)
4793 logical lprn /.false./, lprn1 /.false./
4795 do i=ithet_start,ithet_end
4799 theti2=0.5d0*theta(i)
4800 ityp2=ithetyp(itype(i-1))
4802 coskt(k)=dcos(k*theti2)
4803 sinkt(k)=dsin(k*theti2)
4808 if (phii.ne.phii) phii=150.0
4812 ityp1=ithetyp(itype(i-2))
4814 cosph1(k)=dcos(k*phii)
4815 sinph1(k)=dsin(k*phii)
4828 if (phii1.ne.phii1) phii1=150.0
4833 ityp3=ithetyp(itype(i))
4835 cosph2(k)=dcos(k*phii1)
4836 sinph2(k)=dsin(k*phii1)
4846 ethetai=aa0thet(ityp1,ityp2,ityp3)
4849 ccl=cosph1(l)*cosph2(k-l)
4850 ssl=sinph1(l)*sinph2(k-l)
4851 scl=sinph1(l)*cosph2(k-l)
4852 csl=cosph1(l)*sinph2(k-l)
4853 cosph1ph2(l,k)=ccl-ssl
4854 cosph1ph2(k,l)=ccl+ssl
4855 sinph1ph2(l,k)=scl+csl
4856 sinph1ph2(k,l)=scl-csl
4860 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4861 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4862 write (iout,*) "coskt and sinkt"
4864 write (iout,*) k,coskt(k),sinkt(k)
4868 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4869 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4872 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4873 & " ethetai",ethetai
4876 write (iout,*) "cosph and sinph"
4878 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4880 write (iout,*) "cosph1ph2 and sinph2ph2"
4883 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4884 & sinph1ph2(l,k),sinph1ph2(k,l)
4887 write(iout,*) "ethetai",ethetai
4891 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4892 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4893 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4894 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4895 ethetai=ethetai+sinkt(m)*aux
4896 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4897 dephii=dephii+k*sinkt(m)*(
4898 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4899 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4900 dephii1=dephii1+k*sinkt(m)*(
4901 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4902 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4904 & write (iout,*) "m",m," k",k," bbthet",
4905 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4906 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4907 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4908 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4912 & write(iout,*) "ethetai",ethetai
4916 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4917 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4918 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4919 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4920 ethetai=ethetai+sinkt(m)*aux
4921 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4922 dephii=dephii+l*sinkt(m)*(
4923 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4924 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4925 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4926 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4927 dephii1=dephii1+(k-l)*sinkt(m)*(
4928 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4929 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4930 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4931 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4933 write (iout,*) "m",m," k",k," l",l," ffthet",
4934 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4935 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4936 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4937 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4938 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4939 & cosph1ph2(k,l)*sinkt(m),
4940 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4947 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
4948 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
4949 & phii1*rad2deg,ethetai
4951 etheta=etheta+ethetai
4952 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4953 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4954 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4960 c-----------------------------------------------------------------------------
4961 subroutine esc(escloc)
4962 C Calculate the local energy of a side chain and its derivatives in the
4963 C corresponding virtual-bond valence angles THETA and the spherical angles
4965 implicit real*8 (a-h,o-z)
4966 include 'DIMENSIONS'
4967 include 'COMMON.GEO'
4968 include 'COMMON.LOCAL'
4969 include 'COMMON.VAR'
4970 include 'COMMON.INTERACT'
4971 include 'COMMON.DERIV'
4972 include 'COMMON.CHAIN'
4973 include 'COMMON.IOUNITS'
4974 include 'COMMON.NAMES'
4975 include 'COMMON.FFIELD'
4976 include 'COMMON.CONTROL'
4977 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4978 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4979 common /sccalc/ time11,time12,time112,theti,it,nlobit
4982 c write (iout,'(a)') 'ESC'
4983 do i=loc_start,loc_end
4985 if (it.eq.10) goto 1
4987 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4988 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4989 theti=theta(i+1)-pipol
4994 if (x(2).gt.pi-delta) then
4998 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5000 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5001 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5003 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5004 & ddersc0(1),dersc(1))
5005 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5006 & ddersc0(3),dersc(3))
5008 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5010 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5011 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5012 & dersc0(2),esclocbi,dersc02)
5013 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5015 call splinthet(x(2),0.5d0*delta,ss,ssd)
5020 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5022 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5023 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5025 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5027 c write (iout,*) escloci
5028 else if (x(2).lt.delta) then
5032 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5034 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5035 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5037 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5038 & ddersc0(1),dersc(1))
5039 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5040 & ddersc0(3),dersc(3))
5042 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5044 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5045 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5046 & dersc0(2),esclocbi,dersc02)
5047 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5052 call splinthet(x(2),0.5d0*delta,ss,ssd)
5054 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5056 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5057 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5059 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5060 c write (iout,*) escloci
5062 call enesc(x,escloci,dersc,ddummy,.false.)
5065 escloc=escloc+escloci
5066 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5067 & 'escloc',i,escloci
5068 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5070 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5072 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5073 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5078 C---------------------------------------------------------------------------
5079 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5080 implicit real*8 (a-h,o-z)
5081 include 'DIMENSIONS'
5082 include 'COMMON.GEO'
5083 include 'COMMON.LOCAL'
5084 include 'COMMON.IOUNITS'
5085 common /sccalc/ time11,time12,time112,theti,it,nlobit
5086 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5087 double precision contr(maxlob,-1:1)
5089 c write (iout,*) 'it=',it,' nlobit=',nlobit
5093 if (mixed) ddersc(j)=0.0d0
5097 C Because of periodicity of the dependence of the SC energy in omega we have
5098 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5099 C To avoid underflows, first compute & store the exponents.
5107 z(k)=x(k)-censc(k,j,it)
5112 Axk=Axk+gaussc(l,k,j,it)*z(l)
5118 expfac=expfac+Ax(k,j,iii)*z(k)
5126 C As in the case of ebend, we want to avoid underflows in exponentiation and
5127 C subsequent NaNs and INFs in energy calculation.
5128 C Find the largest exponent
5132 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5136 cd print *,'it=',it,' emin=',emin
5138 C Compute the contribution to SC energy and derivatives
5143 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5144 if(adexp.ne.adexp) adexp=1.0
5147 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5149 cd print *,'j=',j,' expfac=',expfac
5150 escloc_i=escloc_i+expfac
5152 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5156 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5157 & +gaussc(k,2,j,it))*expfac
5164 dersc(1)=dersc(1)/cos(theti)**2
5165 ddersc(1)=ddersc(1)/cos(theti)**2
5168 escloci=-(dlog(escloc_i)-emin)
5170 dersc(j)=dersc(j)/escloc_i
5174 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5179 C------------------------------------------------------------------------------
5180 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5181 implicit real*8 (a-h,o-z)
5182 include 'DIMENSIONS'
5183 include 'COMMON.GEO'
5184 include 'COMMON.LOCAL'
5185 include 'COMMON.IOUNITS'
5186 common /sccalc/ time11,time12,time112,theti,it,nlobit
5187 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5188 double precision contr(maxlob)
5199 z(k)=x(k)-censc(k,j,it)
5205 Axk=Axk+gaussc(l,k,j,it)*z(l)
5211 expfac=expfac+Ax(k,j)*z(k)
5216 C As in the case of ebend, we want to avoid underflows in exponentiation and
5217 C subsequent NaNs and INFs in energy calculation.
5218 C Find the largest exponent
5221 if (emin.gt.contr(j)) emin=contr(j)
5225 C Compute the contribution to SC energy and derivatives
5229 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5230 escloc_i=escloc_i+expfac
5232 dersc(k)=dersc(k)+Ax(k,j)*expfac
5234 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5235 & +gaussc(1,2,j,it))*expfac
5239 dersc(1)=dersc(1)/cos(theti)**2
5240 dersc12=dersc12/cos(theti)**2
5241 escloci=-(dlog(escloc_i)-emin)
5243 dersc(j)=dersc(j)/escloc_i
5245 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5249 c----------------------------------------------------------------------------------
5250 subroutine esc(escloc)
5251 C Calculate the local energy of a side chain and its derivatives in the
5252 C corresponding virtual-bond valence angles THETA and the spherical angles
5253 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5254 C added by Urszula Kozlowska. 07/11/2007
5256 implicit real*8 (a-h,o-z)
5257 include 'DIMENSIONS'
5258 include 'COMMON.GEO'
5259 include 'COMMON.LOCAL'
5260 include 'COMMON.VAR'
5261 include 'COMMON.SCROT'
5262 include 'COMMON.INTERACT'
5263 include 'COMMON.DERIV'
5264 include 'COMMON.CHAIN'
5265 include 'COMMON.IOUNITS'
5266 include 'COMMON.NAMES'
5267 include 'COMMON.FFIELD'
5268 include 'COMMON.CONTROL'
5269 include 'COMMON.VECTORS'
5270 double precision x_prime(3),y_prime(3),z_prime(3)
5271 & , sumene,dsc_i,dp2_i,x(65),
5272 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5273 & de_dxx,de_dyy,de_dzz,de_dt
5274 double precision s1_t,s1_6_t,s2_t,s2_6_t
5276 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5277 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5278 & dt_dCi(3),dt_dCi1(3)
5279 common /sccalc/ time11,time12,time112,theti,it,nlobit
5282 do i=loc_start,loc_end
5283 costtab(i+1) =dcos(theta(i+1))
5284 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5285 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5286 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5287 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5288 cosfac=dsqrt(cosfac2)
5289 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5290 sinfac=dsqrt(sinfac2)
5292 if (it.eq.10) goto 1
5294 C Compute the axes of tghe local cartesian coordinates system; store in
5295 c x_prime, y_prime and z_prime
5302 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5303 C & dc_norm(3,i+nres)
5305 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5306 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5309 z_prime(j) = -uz(j,i-1)
5312 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5313 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5314 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5315 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5316 c & " xy",scalar(x_prime(1),y_prime(1)),
5317 c & " xz",scalar(x_prime(1),z_prime(1)),
5318 c & " yy",scalar(y_prime(1),y_prime(1)),
5319 c & " yz",scalar(y_prime(1),z_prime(1)),
5320 c & " zz",scalar(z_prime(1),z_prime(1))
5322 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5323 C to local coordinate system. Store in xx, yy, zz.
5329 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5330 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5331 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5338 C Compute the energy of the ith side cbain
5340 c write (2,*) "xx",xx," yy",yy," zz",zz
5343 x(j) = sc_parmin(j,it)
5346 Cc diagnostics - remove later
5348 yy1 = dsin(alph(2))*dcos(omeg(2))
5349 zz1 = -dsin(alph(2))*dsin(omeg(2))
5350 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5351 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5353 C," --- ", xx_w,yy_w,zz_w
5356 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5357 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5359 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5360 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5362 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5363 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5364 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5365 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5366 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5368 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5369 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5370 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5371 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5372 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5374 dsc_i = 0.743d0+x(61)
5376 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5377 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5378 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5379 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5380 s1=(1+x(63))/(0.1d0 + dscp1)
5381 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5382 s2=(1+x(65))/(0.1d0 + dscp2)
5383 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5384 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5385 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5386 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5388 c & dscp1,dscp2,sumene
5389 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5390 escloc = escloc + sumene
5391 c write (2,*) "i",i," escloc",sumene,escloc
5394 C This section to check the numerical derivatives of the energy of ith side
5395 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5396 C #define DEBUG in the code to turn it on.
5398 write (2,*) "sumene =",sumene
5402 write (2,*) xx,yy,zz
5403 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5404 de_dxx_num=(sumenep-sumene)/aincr
5406 write (2,*) "xx+ sumene from enesc=",sumenep
5409 write (2,*) xx,yy,zz
5410 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5411 de_dyy_num=(sumenep-sumene)/aincr
5413 write (2,*) "yy+ sumene from enesc=",sumenep
5416 write (2,*) xx,yy,zz
5417 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5418 de_dzz_num=(sumenep-sumene)/aincr
5420 write (2,*) "zz+ sumene from enesc=",sumenep
5421 costsave=cost2tab(i+1)
5422 sintsave=sint2tab(i+1)
5423 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5424 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5425 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5426 de_dt_num=(sumenep-sumene)/aincr
5427 write (2,*) " t+ sumene from enesc=",sumenep
5428 cost2tab(i+1)=costsave
5429 sint2tab(i+1)=sintsave
5430 C End of diagnostics section.
5433 C Compute the gradient of esc
5435 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5436 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5437 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5438 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5439 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5440 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5441 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5442 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5443 pom1=(sumene3*sint2tab(i+1)+sumene1)
5444 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5445 pom2=(sumene4*cost2tab(i+1)+sumene2)
5446 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5447 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5448 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5449 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5451 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5452 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5453 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5455 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5456 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5457 & +(pom1+pom2)*pom_dx
5459 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5462 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5463 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5464 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5466 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5467 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5468 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5469 & +x(59)*zz**2 +x(60)*xx*zz
5470 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5471 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5472 & +(pom1-pom2)*pom_dy
5474 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5477 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5478 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5479 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5480 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5481 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5482 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5483 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5484 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5486 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5489 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5490 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5491 & +pom1*pom_dt1+pom2*pom_dt2
5493 write(2,*), "de_dt = ", de_dt,de_dt_num
5497 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5498 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5499 cosfac2xx=cosfac2*xx
5500 sinfac2yy=sinfac2*yy
5502 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5504 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5506 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5507 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5508 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5509 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5510 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5511 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5512 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5513 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5514 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5515 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5519 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5520 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5523 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5524 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5525 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5527 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5528 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5532 dXX_Ctab(k,i)=dXX_Ci(k)
5533 dXX_C1tab(k,i)=dXX_Ci1(k)
5534 dYY_Ctab(k,i)=dYY_Ci(k)
5535 dYY_C1tab(k,i)=dYY_Ci1(k)
5536 dZZ_Ctab(k,i)=dZZ_Ci(k)
5537 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5538 dXX_XYZtab(k,i)=dXX_XYZ(k)
5539 dYY_XYZtab(k,i)=dYY_XYZ(k)
5540 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5544 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5545 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5546 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5547 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5548 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5550 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5551 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5552 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5553 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5554 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5555 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5556 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5557 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5559 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5560 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5562 C to check gradient call subroutine check_grad
5568 c------------------------------------------------------------------------------
5569 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5571 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5572 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5573 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5574 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5576 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5577 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5579 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5580 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5581 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5582 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5583 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5585 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5586 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5587 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5588 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5589 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5591 dsc_i = 0.743d0+x(61)
5593 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5594 & *(xx*cost2+yy*sint2))
5595 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5596 & *(xx*cost2-yy*sint2))
5597 s1=(1+x(63))/(0.1d0 + dscp1)
5598 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5599 s2=(1+x(65))/(0.1d0 + dscp2)
5600 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5601 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5602 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5607 c------------------------------------------------------------------------------
5608 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5610 C This procedure calculates two-body contact function g(rij) and its derivative:
5613 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5616 C where x=(rij-r0ij)/delta
5618 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5621 double precision rij,r0ij,eps0ij,fcont,fprimcont
5622 double precision x,x2,x4,delta
5626 if (x.lt.-1.0D0) then
5629 else if (x.le.1.0D0) then
5632 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5633 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5640 c------------------------------------------------------------------------------
5641 subroutine splinthet(theti,delta,ss,ssder)
5642 implicit real*8 (a-h,o-z)
5643 include 'DIMENSIONS'
5644 include 'COMMON.VAR'
5645 include 'COMMON.GEO'
5648 if (theti.gt.pipol) then
5649 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5651 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5656 c------------------------------------------------------------------------------
5657 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5659 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5660 double precision ksi,ksi2,ksi3,a1,a2,a3
5661 a1=fprim0*delta/(f1-f0)
5667 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5668 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5671 c------------------------------------------------------------------------------
5672 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5674 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5675 double precision ksi,ksi2,ksi3,a1,a2,a3
5680 a2=3*(f1x-f0x)-2*fprim0x*delta
5681 a3=fprim0x*delta-2*(f1x-f0x)
5682 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5685 C-----------------------------------------------------------------------------
5687 C-----------------------------------------------------------------------------
5688 subroutine etor(etors,edihcnstr)
5689 implicit real*8 (a-h,o-z)
5690 include 'DIMENSIONS'
5691 include 'COMMON.VAR'
5692 include 'COMMON.GEO'
5693 include 'COMMON.LOCAL'
5694 include 'COMMON.TORSION'
5695 include 'COMMON.INTERACT'
5696 include 'COMMON.DERIV'
5697 include 'COMMON.CHAIN'
5698 include 'COMMON.NAMES'
5699 include 'COMMON.IOUNITS'
5700 include 'COMMON.FFIELD'
5701 include 'COMMON.TORCNSTR'
5702 include 'COMMON.CONTROL'
5704 C Set lprn=.true. for debugging
5708 do i=iphi_start,iphi_end
5710 itori=itortyp(itype(i-2))
5711 itori1=itortyp(itype(i-1))
5714 C Proline-Proline pair is a special case...
5715 if (itori.eq.3 .and. itori1.eq.3) then
5716 if (phii.gt.-dwapi3) then
5718 fac=1.0D0/(1.0D0-cosphi)
5719 etorsi=v1(1,3,3)*fac
5720 etorsi=etorsi+etorsi
5721 etors=etors+etorsi-v1(1,3,3)
5722 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5723 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5726 v1ij=v1(j+1,itori,itori1)
5727 v2ij=v2(j+1,itori,itori1)
5730 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5731 if (energy_dec) etors_ii=etors_ii+
5732 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5733 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5737 v1ij=v1(j,itori,itori1)
5738 v2ij=v2(j,itori,itori1)
5741 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5742 if (energy_dec) etors_ii=etors_ii+
5743 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5744 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5747 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5750 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5751 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5752 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5753 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5754 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5756 ! 6/20/98 - dihedral angle constraints
5759 itori=idih_constr(i)
5762 if (difi.gt.drange(i)) then
5764 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5765 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5766 else if (difi.lt.-drange(i)) then
5768 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5769 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5771 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5772 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5774 ! write (iout,*) 'edihcnstr',edihcnstr
5777 c------------------------------------------------------------------------------
5778 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5779 subroutine e_modeller(ehomology_constr)
5780 ehomology_constr=0.0
5781 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5784 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5786 c------------------------------------------------------------------------------
5787 subroutine etor_d(etors_d)
5791 c----------------------------------------------------------------------------
5793 subroutine etor(etors,edihcnstr)
5794 implicit real*8 (a-h,o-z)
5795 include 'DIMENSIONS'
5796 include 'COMMON.VAR'
5797 include 'COMMON.GEO'
5798 include 'COMMON.LOCAL'
5799 include 'COMMON.TORSION'
5800 include 'COMMON.INTERACT'
5801 include 'COMMON.DERIV'
5802 include 'COMMON.CHAIN'
5803 include 'COMMON.NAMES'
5804 include 'COMMON.IOUNITS'
5805 include 'COMMON.FFIELD'
5806 include 'COMMON.TORCNSTR'
5807 include 'COMMON.CONTROL'
5809 C Set lprn=.true. for debugging
5813 do i=iphi_start,iphi_end
5815 itori=itortyp(itype(i-2))
5816 itori1=itortyp(itype(i-1))
5819 C Regular cosine and sine terms
5820 do j=1,nterm(itori,itori1)
5821 v1ij=v1(j,itori,itori1)
5822 v2ij=v2(j,itori,itori1)
5825 etors=etors+v1ij*cosphi+v2ij*sinphi
5826 if (energy_dec) etors_ii=etors_ii+
5827 & v1ij*cosphi+v2ij*sinphi
5828 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5832 C E = SUM ----------------------------------- - v1
5833 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5835 cosphi=dcos(0.5d0*phii)
5836 sinphi=dsin(0.5d0*phii)
5837 do j=1,nlor(itori,itori1)
5838 vl1ij=vlor1(j,itori,itori1)
5839 vl2ij=vlor2(j,itori,itori1)
5840 vl3ij=vlor3(j,itori,itori1)
5841 pom=vl2ij*cosphi+vl3ij*sinphi
5842 pom1=1.0d0/(pom*pom+1.0d0)
5843 etors=etors+vl1ij*pom1
5844 if (energy_dec) etors_ii=etors_ii+
5847 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5849 C Subtract the constant term
5850 etors=etors-v0(itori,itori1)
5851 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5852 & 'etor',i,etors_ii-v0(itori,itori1)
5854 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5855 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5856 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5857 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5858 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5860 ! 6/20/98 - dihedral angle constraints
5862 c do i=1,ndih_constr
5863 do i=idihconstr_start,idihconstr_end
5864 itori=idih_constr(i)
5866 difi=pinorm(phii-phi0(i))
5867 if (difi.gt.drange(i)) then
5869 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5870 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5871 else if (difi.lt.-drange(i)) then
5873 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5874 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5878 c write (iout,*) "gloci", gloc(i-3,icg)
5879 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5880 cd & rad2deg*phi0(i), rad2deg*drange(i),
5881 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5883 cd write (iout,*) 'edihcnstr',edihcnstr
5886 c----------------------------------------------------------------------------
5887 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5888 subroutine e_modeller(ehomology_constr)
5889 implicit real*8 (a-h,o-z)
5891 integer nnn, i, j, k, ki, irec, l
5892 integer katy, odleglosci, test7
5893 real*8 odleg, odleg2, odleg3, kat, kat2, kat3
5894 real*8 distance(799,799,19), dih_diff(799,19)
5895 real*8 distancek(19), min_odl(799,799)
5898 include 'DIMENSIONS'
5899 include 'COMMON.SBRIDGE'
5900 include 'COMMON.CHAIN'
5901 include 'COMMON.GEO'
5902 include 'COMMON.DERIV'
5903 include 'COMMON.LOCAL'
5904 include 'COMMON.INTERACT'
5905 include 'COMMON.VAR'
5906 include 'COMMON.IOUNITS'
5908 include 'COMMON.CONTROL'
5912 distancek(i)=9999999.9
5921 c LICZENIE WKLADU DO ENERGI POCHODZACEGO Z WIEZOW NA ODLEGLOSCI
5924 do k=1,constr_homology
5925 distance(i,j,k)=(odl(i,j,k)-dist(i+1,j+1))
5926 distancek(k)=waga_dist*((distance(i,j,k)**2)/
5927 & (2*(sigma_odl(i,j,k))**2))
5930 min_odl(i,j)=minval(distancek)
5932 do k=1,constr_homology
5933 odleg3=-waga_dist*((distance(i,j,k)**2)/
5934 & (2*(sigma_odl(i,j,k))**2))
5935 odleg2=odleg2+dexp(odleg3+min_odl(i,j))
5937 write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
5938 & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
5939 & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
5940 & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
5943 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl(i,j)
5944 write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
5945 & dLOG(odleg2),"-odleg=", -odleg
5951 c LICZENIE WKLADU DO ENERGI POCHODZACEGO Z WIEZOW NA KATY W
5953 do k=1,constr_homology
5954 dih_diff(i,k)=(dih(i,k)-beta(i+1,i+2,i+3,i+4))
5955 if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
5956 & -(6.28318-dih_diff(i,k))
5957 if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
5958 & 6.28318+dih_diff(i,k)
5960 kat3=-waga_angle*((dih_diff(i,k)**2)/
5961 & (2*(sigma_dih(i,k))**2))
5962 c write(iout,*) "w(i,k)=",w(i,k),"beta=",beta(i+1,i+2,i+3,i+4)
5963 kat2=kat2+dexp(kat3)
5964 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
5967 kat=kat-dLOG(kat2/constr_homology)
5969 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
5970 ccc & dLOG(kat2), "-kat=", -kat
5975 write(iout,748) "2odleg=", odleg, "kat=", kat,"suma=",odleg+kat
5979 c ----------------------------------------------------------------------
5980 c LICZENIE GRADIENTU
5981 c ----------------------------------------------------------------------
5986 c GRADIENT DLA ODLEGLOSCI
5989 do k=1,constr_homology
5990 godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
5991 & *waga_dist)+min_odl(i,j))
5992 sgodl=godl*((-((distance(i,j,k))/
5993 & ((sigma_odl(i,j,k))**2)))*waga_dist)
5995 sum_godl=sum_godl+godl
5996 sum_sgodl=sum_sgodl+sgodl
5998 c sgodl2=sgodl2+sgodl
5999 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6000 c write(iout,*) "constr_homology=",constr_homology
6001 c write(iout,*) i, j, k, "TEST K"
6004 grad_odl3=((1/sum_godl)*sum_sgodl)
6010 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6011 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6012 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6014 ccc write(iout,*) godl, sgodl, grad_odl3
6016 c grad_odl=grad_odl+grad_odl3
6019 ggodl=grad_odl3*(c(jik,i+1)-c(jik,j+1))
6020 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6021 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6022 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6023 ghpbc(jik,i+1)=ghpbc(jik,i+1)+ggodl
6024 ghpbc(jik,j+1)=ghpbc(jik,j+1)-ggodl
6025 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6026 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6034 c GRADIENT DLA KATOW
6038 do k=1,constr_homology
6039 gdih=dexp((-(dih_diff(i,k)**2)/(2*(sigma_dih(i,k))**2))
6041 sgdih=gdih*((-((dih_diff(i,k))/
6042 & ((sigma_dih(i,k))**2)))*waga_angle)
6044 sum_gdih=sum_gdih+gdih
6045 sum_sgdih=sum_sgdih+sgdih
6047 grad_dih3=((1.0/sum_gdih)*sum_sgdih)
6051 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6052 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6053 ccc & gloc(nphi+i-3,icg)
6054 gloc(i+1,icg)=gloc(i+1,icg)+grad_dih3
6055 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6056 ccc & gloc(nphi+i-3,icg)
6061 c CALKOWITY WKLAD DO ENERGII WYNIKAJACY Z WIEZOW
6062 ehomology_constr=odleg+kat
6065 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6066 747 format(a12,i4,i4,i4,f8.3,f8.3)
6067 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6068 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6069 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6070 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6073 c------------------------------------------------------------------------------
6078 subroutine etor_d(etors_d)
6079 C 6/23/01 Compute double torsional energy
6080 implicit real*8 (a-h,o-z)
6081 include 'DIMENSIONS'
6082 include 'COMMON.VAR'
6083 include 'COMMON.GEO'
6084 include 'COMMON.LOCAL'
6085 include 'COMMON.TORSION'
6086 include 'COMMON.INTERACT'
6087 include 'COMMON.DERIV'
6088 include 'COMMON.CHAIN'
6089 include 'COMMON.NAMES'
6090 include 'COMMON.IOUNITS'
6091 include 'COMMON.FFIELD'
6092 include 'COMMON.TORCNSTR'
6094 C Set lprn=.true. for debugging
6098 do i=iphid_start,iphid_end
6099 itori=itortyp(itype(i-2))
6100 itori1=itortyp(itype(i-1))
6101 itori2=itortyp(itype(i))
6106 do j=1,ntermd_1(itori,itori1,itori2)
6107 v1cij=v1c(1,j,itori,itori1,itori2)
6108 v1sij=v1s(1,j,itori,itori1,itori2)
6109 v2cij=v1c(2,j,itori,itori1,itori2)
6110 v2sij=v1s(2,j,itori,itori1,itori2)
6111 cosphi1=dcos(j*phii)
6112 sinphi1=dsin(j*phii)
6113 cosphi2=dcos(j*phii1)
6114 sinphi2=dsin(j*phii1)
6115 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6116 & v2cij*cosphi2+v2sij*sinphi2
6117 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6118 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6120 do k=2,ntermd_2(itori,itori1,itori2)
6122 v1cdij = v2c(k,l,itori,itori1,itori2)
6123 v2cdij = v2c(l,k,itori,itori1,itori2)
6124 v1sdij = v2s(k,l,itori,itori1,itori2)
6125 v2sdij = v2s(l,k,itori,itori1,itori2)
6126 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6127 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6128 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6129 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6130 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6131 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6132 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6133 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6134 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6135 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6138 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6139 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6140 c write (iout,*) "gloci", gloc(i-3,icg)
6145 c------------------------------------------------------------------------------
6146 subroutine eback_sc_corr(esccor)
6147 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6148 c conformational states; temporarily implemented as differences
6149 c between UNRES torsional potentials (dependent on three types of
6150 c residues) and the torsional potentials dependent on all 20 types
6151 c of residues computed from AM1 energy surfaces of terminally-blocked
6152 c amino-acid residues.
6153 implicit real*8 (a-h,o-z)
6154 include 'DIMENSIONS'
6155 include 'COMMON.VAR'
6156 include 'COMMON.GEO'
6157 include 'COMMON.LOCAL'
6158 include 'COMMON.TORSION'
6159 include 'COMMON.SCCOR'
6160 include 'COMMON.INTERACT'
6161 include 'COMMON.DERIV'
6162 include 'COMMON.CHAIN'
6163 include 'COMMON.NAMES'
6164 include 'COMMON.IOUNITS'
6165 include 'COMMON.FFIELD'
6166 include 'COMMON.CONTROL'
6168 C Set lprn=.true. for debugging
6171 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6173 do i=itau_start,itau_end
6175 isccori=isccortyp(itype(i-2))
6176 isccori1=isccortyp(itype(i-1))
6178 cccc Added 9 May 2012
6179 cc Tauangle is torsional engle depending on the value of first digit
6180 c(see comment below)
6181 cc Omicron is flat angle depending on the value of first digit
6182 c(see comment below)
6185 do intertyp=1,3 !intertyp
6186 cc Added 09 May 2012 (Adasko)
6187 cc Intertyp means interaction type of backbone mainchain correlation:
6188 c 1 = SC...Ca...Ca...Ca
6189 c 2 = Ca...Ca...Ca...SC
6190 c 3 = SC...Ca...Ca...SCi
6192 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6193 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6194 & (itype(i-1).eq.21)))
6195 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6196 & .or.(itype(i-2).eq.21)))
6197 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6198 & (itype(i-1).eq.21)))) cycle
6199 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6200 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6202 do j=1,nterm_sccor(isccori,isccori1)
6203 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6204 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6205 cosphi=dcos(j*tauangle(intertyp,i))
6206 sinphi=dsin(j*tauangle(intertyp,i))
6207 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6208 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6210 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6211 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6212 c &gloc_sc(intertyp,i-3,icg)
6214 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6215 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6216 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6217 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6218 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6222 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6226 c----------------------------------------------------------------------------
6227 subroutine multibody(ecorr)
6228 C This subroutine calculates multi-body contributions to energy following
6229 C the idea of Skolnick et al. If side chains I and J make a contact and
6230 C at the same time side chains I+1 and J+1 make a contact, an extra
6231 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6232 implicit real*8 (a-h,o-z)
6233 include 'DIMENSIONS'
6234 include 'COMMON.IOUNITS'
6235 include 'COMMON.DERIV'
6236 include 'COMMON.INTERACT'
6237 include 'COMMON.CONTACTS'
6238 double precision gx(3),gx1(3)
6241 C Set lprn=.true. for debugging
6245 write (iout,'(a)') 'Contact function values:'
6247 write (iout,'(i2,20(1x,i2,f10.5))')
6248 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6263 num_conti=num_cont(i)
6264 num_conti1=num_cont(i1)
6269 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6270 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6271 cd & ' ishift=',ishift
6272 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6273 C The system gains extra energy.
6274 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6275 endif ! j1==j+-ishift
6284 c------------------------------------------------------------------------------
6285 double precision function esccorr(i,j,k,l,jj,kk)
6286 implicit real*8 (a-h,o-z)
6287 include 'DIMENSIONS'
6288 include 'COMMON.IOUNITS'
6289 include 'COMMON.DERIV'
6290 include 'COMMON.INTERACT'
6291 include 'COMMON.CONTACTS'
6292 double precision gx(3),gx1(3)
6297 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6298 C Calculate the multi-body contribution to energy.
6299 C Calculate multi-body contributions to the gradient.
6300 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6301 cd & k,l,(gacont(m,kk,k),m=1,3)
6303 gx(m) =ekl*gacont(m,jj,i)
6304 gx1(m)=eij*gacont(m,kk,k)
6305 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6306 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6307 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6308 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6312 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6317 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6323 c------------------------------------------------------------------------------
6324 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6325 C This subroutine calculates multi-body contributions to hydrogen-bonding
6326 implicit real*8 (a-h,o-z)
6327 include 'DIMENSIONS'
6328 include 'COMMON.IOUNITS'
6331 parameter (max_cont=maxconts)
6332 parameter (max_dim=26)
6333 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6334 double precision zapas(max_dim,maxconts,max_fg_procs),
6335 & zapas_recv(max_dim,maxconts,max_fg_procs)
6336 common /przechowalnia/ zapas
6337 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6338 & status_array(MPI_STATUS_SIZE,maxconts*2)
6340 include 'COMMON.SETUP'
6341 include 'COMMON.FFIELD'
6342 include 'COMMON.DERIV'
6343 include 'COMMON.INTERACT'
6344 include 'COMMON.CONTACTS'
6345 include 'COMMON.CONTROL'
6346 include 'COMMON.LOCAL'
6347 double precision gx(3),gx1(3),time00
6350 C Set lprn=.true. for debugging
6355 if (nfgtasks.le.1) goto 30
6357 write (iout,'(a)') 'Contact function values before RECEIVE:'
6359 write (iout,'(2i3,50(1x,i2,f5.2))')
6360 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6361 & j=1,num_cont_hb(i))
6365 do i=1,ntask_cont_from
6368 do i=1,ntask_cont_to
6371 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6373 C Make the list of contacts to send to send to other procesors
6374 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6376 do i=iturn3_start,iturn3_end
6377 c write (iout,*) "make contact list turn3",i," num_cont",
6379 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6381 do i=iturn4_start,iturn4_end
6382 c write (iout,*) "make contact list turn4",i," num_cont",
6384 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6388 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6390 do j=1,num_cont_hb(i)
6393 iproc=iint_sent_local(k,jjc,ii)
6394 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6395 if (iproc.gt.0) then
6396 ncont_sent(iproc)=ncont_sent(iproc)+1
6397 nn=ncont_sent(iproc)
6399 zapas(2,nn,iproc)=jjc
6400 zapas(3,nn,iproc)=facont_hb(j,i)
6401 zapas(4,nn,iproc)=ees0p(j,i)
6402 zapas(5,nn,iproc)=ees0m(j,i)
6403 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6404 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6405 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6406 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6407 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6408 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6409 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6410 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6411 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6412 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6413 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6414 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6415 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6416 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6417 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6418 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6419 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6420 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6421 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6422 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6423 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6430 & "Numbers of contacts to be sent to other processors",
6431 & (ncont_sent(i),i=1,ntask_cont_to)
6432 write (iout,*) "Contacts sent"
6433 do ii=1,ntask_cont_to
6435 iproc=itask_cont_to(ii)
6436 write (iout,*) nn," contacts to processor",iproc,
6437 & " of CONT_TO_COMM group"
6439 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6447 CorrelID1=nfgtasks+fg_rank+1
6449 C Receive the numbers of needed contacts from other processors
6450 do ii=1,ntask_cont_from
6451 iproc=itask_cont_from(ii)
6453 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6454 & FG_COMM,req(ireq),IERR)
6456 c write (iout,*) "IRECV ended"
6458 C Send the number of contacts needed by other processors
6459 do ii=1,ntask_cont_to
6460 iproc=itask_cont_to(ii)
6462 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6463 & FG_COMM,req(ireq),IERR)
6465 c write (iout,*) "ISEND ended"
6466 c write (iout,*) "number of requests (nn)",ireq
6469 & call MPI_Waitall(ireq,req,status_array,ierr)
6471 c & "Numbers of contacts to be received from other processors",
6472 c & (ncont_recv(i),i=1,ntask_cont_from)
6476 do ii=1,ntask_cont_from
6477 iproc=itask_cont_from(ii)
6479 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6480 c & " of CONT_TO_COMM group"
6484 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6485 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6486 c write (iout,*) "ireq,req",ireq,req(ireq)
6489 C Send the contacts to processors that need them
6490 do ii=1,ntask_cont_to
6491 iproc=itask_cont_to(ii)
6493 c write (iout,*) nn," contacts to processor",iproc,
6494 c & " of CONT_TO_COMM group"
6497 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6498 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6499 c write (iout,*) "ireq,req",ireq,req(ireq)
6501 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6505 c write (iout,*) "number of requests (contacts)",ireq
6506 c write (iout,*) "req",(req(i),i=1,4)
6509 & call MPI_Waitall(ireq,req,status_array,ierr)
6510 do iii=1,ntask_cont_from
6511 iproc=itask_cont_from(iii)
6514 write (iout,*) "Received",nn," contacts from processor",iproc,
6515 & " of CONT_FROM_COMM group"
6518 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6523 ii=zapas_recv(1,i,iii)
6524 c Flag the received contacts to prevent double-counting
6525 jj=-zapas_recv(2,i,iii)
6526 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6528 nnn=num_cont_hb(ii)+1
6531 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6532 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6533 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6534 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6535 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6536 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6537 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6538 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6539 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6540 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6541 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6542 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6543 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6544 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6545 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6546 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6547 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6548 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6549 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6550 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6551 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6552 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6553 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6554 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6559 write (iout,'(a)') 'Contact function values after receive:'
6561 write (iout,'(2i3,50(1x,i3,f5.2))')
6562 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6563 & j=1,num_cont_hb(i))
6570 write (iout,'(a)') 'Contact function values:'
6572 write (iout,'(2i3,50(1x,i3,f5.2))')
6573 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6574 & j=1,num_cont_hb(i))
6578 C Remove the loop below after debugging !!!
6585 C Calculate the local-electrostatic correlation terms
6586 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6588 num_conti=num_cont_hb(i)
6589 num_conti1=num_cont_hb(i+1)
6596 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6597 c & ' jj=',jj,' kk=',kk
6598 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6599 & .or. j.lt.0 .and. j1.gt.0) .and.
6600 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6601 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6602 C The system gains extra energy.
6603 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6604 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6605 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6607 else if (j1.eq.j) then
6608 C Contacts I-J and I-(J+1) occur simultaneously.
6609 C The system loses extra energy.
6610 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6615 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6616 c & ' jj=',jj,' kk=',kk
6618 C Contacts I-J and (I+1)-J occur simultaneously.
6619 C The system loses extra energy.
6620 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6627 c------------------------------------------------------------------------------
6628 subroutine add_hb_contact(ii,jj,itask)
6629 implicit real*8 (a-h,o-z)
6630 include "DIMENSIONS"
6631 include "COMMON.IOUNITS"
6634 parameter (max_cont=maxconts)
6635 parameter (max_dim=26)
6636 include "COMMON.CONTACTS"
6637 double precision zapas(max_dim,maxconts,max_fg_procs),
6638 & zapas_recv(max_dim,maxconts,max_fg_procs)
6639 common /przechowalnia/ zapas
6640 integer i,j,ii,jj,iproc,itask(4),nn
6641 c write (iout,*) "itask",itask
6644 if (iproc.gt.0) then
6645 do j=1,num_cont_hb(ii)
6647 c write (iout,*) "i",ii," j",jj," jjc",jjc
6649 ncont_sent(iproc)=ncont_sent(iproc)+1
6650 nn=ncont_sent(iproc)
6651 zapas(1,nn,iproc)=ii
6652 zapas(2,nn,iproc)=jjc
6653 zapas(3,nn,iproc)=facont_hb(j,ii)
6654 zapas(4,nn,iproc)=ees0p(j,ii)
6655 zapas(5,nn,iproc)=ees0m(j,ii)
6656 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6657 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6658 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6659 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6660 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6661 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6662 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6663 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6664 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6665 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6666 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6667 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6668 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6669 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6670 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6671 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6672 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6673 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6674 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6675 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6676 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6684 c------------------------------------------------------------------------------
6685 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6687 C This subroutine calculates multi-body contributions to hydrogen-bonding
6688 implicit real*8 (a-h,o-z)
6689 include 'DIMENSIONS'
6690 include 'COMMON.IOUNITS'
6693 parameter (max_cont=maxconts)
6694 parameter (max_dim=70)
6695 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6696 double precision zapas(max_dim,maxconts,max_fg_procs),
6697 & zapas_recv(max_dim,maxconts,max_fg_procs)
6698 common /przechowalnia/ zapas
6699 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6700 & status_array(MPI_STATUS_SIZE,maxconts*2)
6702 include 'COMMON.SETUP'
6703 include 'COMMON.FFIELD'
6704 include 'COMMON.DERIV'
6705 include 'COMMON.LOCAL'
6706 include 'COMMON.INTERACT'
6707 include 'COMMON.CONTACTS'
6708 include 'COMMON.CHAIN'
6709 include 'COMMON.CONTROL'
6710 double precision gx(3),gx1(3)
6711 integer num_cont_hb_old(maxres)
6713 double precision eello4,eello5,eelo6,eello_turn6
6714 external eello4,eello5,eello6,eello_turn6
6715 C Set lprn=.true. for debugging
6720 num_cont_hb_old(i)=num_cont_hb(i)
6724 if (nfgtasks.le.1) goto 30
6726 write (iout,'(a)') 'Contact function values before RECEIVE:'
6728 write (iout,'(2i3,50(1x,i2,f5.2))')
6729 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6730 & j=1,num_cont_hb(i))
6734 do i=1,ntask_cont_from
6737 do i=1,ntask_cont_to
6740 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6742 C Make the list of contacts to send to send to other procesors
6743 do i=iturn3_start,iturn3_end
6744 c write (iout,*) "make contact list turn3",i," num_cont",
6746 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6748 do i=iturn4_start,iturn4_end
6749 c write (iout,*) "make contact list turn4",i," num_cont",
6751 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6755 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6757 do j=1,num_cont_hb(i)
6760 iproc=iint_sent_local(k,jjc,ii)
6761 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6762 if (iproc.ne.0) then
6763 ncont_sent(iproc)=ncont_sent(iproc)+1
6764 nn=ncont_sent(iproc)
6766 zapas(2,nn,iproc)=jjc
6767 zapas(3,nn,iproc)=d_cont(j,i)
6771 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6776 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6784 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6795 & "Numbers of contacts to be sent to other processors",
6796 & (ncont_sent(i),i=1,ntask_cont_to)
6797 write (iout,*) "Contacts sent"
6798 do ii=1,ntask_cont_to
6800 iproc=itask_cont_to(ii)
6801 write (iout,*) nn," contacts to processor",iproc,
6802 & " of CONT_TO_COMM group"
6804 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6812 CorrelID1=nfgtasks+fg_rank+1
6814 C Receive the numbers of needed contacts from other processors
6815 do ii=1,ntask_cont_from
6816 iproc=itask_cont_from(ii)
6818 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6819 & FG_COMM,req(ireq),IERR)
6821 c write (iout,*) "IRECV ended"
6823 C Send the number of contacts needed by other processors
6824 do ii=1,ntask_cont_to
6825 iproc=itask_cont_to(ii)
6827 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6828 & FG_COMM,req(ireq),IERR)
6830 c write (iout,*) "ISEND ended"
6831 c write (iout,*) "number of requests (nn)",ireq
6834 & call MPI_Waitall(ireq,req,status_array,ierr)
6836 c & "Numbers of contacts to be received from other processors",
6837 c & (ncont_recv(i),i=1,ntask_cont_from)
6841 do ii=1,ntask_cont_from
6842 iproc=itask_cont_from(ii)
6844 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6845 c & " of CONT_TO_COMM group"
6849 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6850 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6851 c write (iout,*) "ireq,req",ireq,req(ireq)
6854 C Send the contacts to processors that need them
6855 do ii=1,ntask_cont_to
6856 iproc=itask_cont_to(ii)
6858 c write (iout,*) nn," contacts to processor",iproc,
6859 c & " of CONT_TO_COMM group"
6862 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6863 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6864 c write (iout,*) "ireq,req",ireq,req(ireq)
6866 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6870 c write (iout,*) "number of requests (contacts)",ireq
6871 c write (iout,*) "req",(req(i),i=1,4)
6874 & call MPI_Waitall(ireq,req,status_array,ierr)
6875 do iii=1,ntask_cont_from
6876 iproc=itask_cont_from(iii)
6879 write (iout,*) "Received",nn," contacts from processor",iproc,
6880 & " of CONT_FROM_COMM group"
6883 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6888 ii=zapas_recv(1,i,iii)
6889 c Flag the received contacts to prevent double-counting
6890 jj=-zapas_recv(2,i,iii)
6891 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6893 nnn=num_cont_hb(ii)+1
6896 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6900 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6905 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6913 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6922 write (iout,'(a)') 'Contact function values after receive:'
6924 write (iout,'(2i3,50(1x,i3,5f6.3))')
6925 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6926 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6933 write (iout,'(a)') 'Contact function values:'
6935 write (iout,'(2i3,50(1x,i2,5f6.3))')
6936 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6937 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6943 C Remove the loop below after debugging !!!
6950 C Calculate the dipole-dipole interaction energies
6951 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6952 do i=iatel_s,iatel_e+1
6953 num_conti=num_cont_hb(i)
6962 C Calculate the local-electrostatic correlation terms
6963 c write (iout,*) "gradcorr5 in eello5 before loop"
6965 c write (iout,'(i5,3f10.5)')
6966 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6968 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6969 c write (iout,*) "corr loop i",i
6971 num_conti=num_cont_hb(i)
6972 num_conti1=num_cont_hb(i+1)
6979 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6980 c & ' jj=',jj,' kk=',kk
6981 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6982 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6983 & .or. j.lt.0 .and. j1.gt.0) .and.
6984 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6985 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6986 C The system gains extra energy.
6988 sqd1=dsqrt(d_cont(jj,i))
6989 sqd2=dsqrt(d_cont(kk,i1))
6990 sred_geom = sqd1*sqd2
6991 IF (sred_geom.lt.cutoff_corr) THEN
6992 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6994 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6995 cd & ' jj=',jj,' kk=',kk
6996 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6997 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6999 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7000 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7003 cd write (iout,*) 'sred_geom=',sred_geom,
7004 cd & ' ekont=',ekont,' fprim=',fprimcont,
7005 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7006 cd write (iout,*) "g_contij",g_contij
7007 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7008 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7009 call calc_eello(i,jp,i+1,jp1,jj,kk)
7010 if (wcorr4.gt.0.0d0)
7011 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7012 if (energy_dec.and.wcorr4.gt.0.0d0)
7013 1 write (iout,'(a6,4i5,0pf7.3)')
7014 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7015 c write (iout,*) "gradcorr5 before eello5"
7017 c write (iout,'(i5,3f10.5)')
7018 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7020 if (wcorr5.gt.0.0d0)
7021 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7022 c write (iout,*) "gradcorr5 after eello5"
7024 c write (iout,'(i5,3f10.5)')
7025 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7027 if (energy_dec.and.wcorr5.gt.0.0d0)
7028 1 write (iout,'(a6,4i5,0pf7.3)')
7029 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7030 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7031 cd write(2,*)'ijkl',i,jp,i+1,jp1
7032 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7033 & .or. wturn6.eq.0.0d0))then
7034 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7035 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7036 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7037 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7038 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7039 cd & 'ecorr6=',ecorr6
7040 cd write (iout,'(4e15.5)') sred_geom,
7041 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7042 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7043 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7044 else if (wturn6.gt.0.0d0
7045 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7046 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7047 eturn6=eturn6+eello_turn6(i,jj,kk)
7048 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7049 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7050 cd write (2,*) 'multibody_eello:eturn6',eturn6
7059 num_cont_hb(i)=num_cont_hb_old(i)
7061 c write (iout,*) "gradcorr5 in eello5"
7063 c write (iout,'(i5,3f10.5)')
7064 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7068 c------------------------------------------------------------------------------
7069 subroutine add_hb_contact_eello(ii,jj,itask)
7070 implicit real*8 (a-h,o-z)
7071 include "DIMENSIONS"
7072 include "COMMON.IOUNITS"
7075 parameter (max_cont=maxconts)
7076 parameter (max_dim=70)
7077 include "COMMON.CONTACTS"
7078 double precision zapas(max_dim,maxconts,max_fg_procs),
7079 & zapas_recv(max_dim,maxconts,max_fg_procs)
7080 common /przechowalnia/ zapas
7081 integer i,j,ii,jj,iproc,itask(4),nn
7082 c write (iout,*) "itask",itask
7085 if (iproc.gt.0) then
7086 do j=1,num_cont_hb(ii)
7088 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7090 ncont_sent(iproc)=ncont_sent(iproc)+1
7091 nn=ncont_sent(iproc)
7092 zapas(1,nn,iproc)=ii
7093 zapas(2,nn,iproc)=jjc
7094 zapas(3,nn,iproc)=d_cont(j,ii)
7098 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7103 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7111 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7123 c------------------------------------------------------------------------------
7124 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7125 implicit real*8 (a-h,o-z)
7126 include 'DIMENSIONS'
7127 include 'COMMON.IOUNITS'
7128 include 'COMMON.DERIV'
7129 include 'COMMON.INTERACT'
7130 include 'COMMON.CONTACTS'
7131 double precision gx(3),gx1(3)
7141 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7142 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7143 C Following 4 lines for diagnostics.
7148 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7149 c & 'Contacts ',i,j,
7150 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7151 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7153 C Calculate the multi-body contribution to energy.
7154 c ecorr=ecorr+ekont*ees
7155 C Calculate multi-body contributions to the gradient.
7156 coeffpees0pij=coeffp*ees0pij
7157 coeffmees0mij=coeffm*ees0mij
7158 coeffpees0pkl=coeffp*ees0pkl
7159 coeffmees0mkl=coeffm*ees0mkl
7161 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7162 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7163 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7164 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7165 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7166 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7167 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7168 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7169 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7170 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7171 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7172 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7173 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7174 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7175 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7176 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7177 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7178 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7179 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7180 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7181 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7182 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7183 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7184 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7185 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7190 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7191 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7192 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7193 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7198 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7199 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7200 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7201 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7204 c write (iout,*) "ehbcorr",ekont*ees
7209 C---------------------------------------------------------------------------
7210 subroutine dipole(i,j,jj)
7211 implicit real*8 (a-h,o-z)
7212 include 'DIMENSIONS'
7213 include 'COMMON.IOUNITS'
7214 include 'COMMON.CHAIN'
7215 include 'COMMON.FFIELD'
7216 include 'COMMON.DERIV'
7217 include 'COMMON.INTERACT'
7218 include 'COMMON.CONTACTS'
7219 include 'COMMON.TORSION'
7220 include 'COMMON.VAR'
7221 include 'COMMON.GEO'
7222 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7224 iti1 = itortyp(itype(i+1))
7225 if (j.lt.nres-1) then
7226 itj1 = itortyp(itype(j+1))
7231 dipi(iii,1)=Ub2(iii,i)
7232 dipderi(iii)=Ub2der(iii,i)
7233 dipi(iii,2)=b1(iii,iti1)
7234 dipj(iii,1)=Ub2(iii,j)
7235 dipderj(iii)=Ub2der(iii,j)
7236 dipj(iii,2)=b1(iii,itj1)
7240 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7243 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7250 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7254 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7259 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7260 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7262 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7264 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7266 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7271 C---------------------------------------------------------------------------
7272 subroutine calc_eello(i,j,k,l,jj,kk)
7274 C This subroutine computes matrices and vectors needed to calculate
7275 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7277 implicit real*8 (a-h,o-z)
7278 include 'DIMENSIONS'
7279 include 'COMMON.IOUNITS'
7280 include 'COMMON.CHAIN'
7281 include 'COMMON.DERIV'
7282 include 'COMMON.INTERACT'
7283 include 'COMMON.CONTACTS'
7284 include 'COMMON.TORSION'
7285 include 'COMMON.VAR'
7286 include 'COMMON.GEO'
7287 include 'COMMON.FFIELD'
7288 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7289 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7292 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7293 cd & ' jj=',jj,' kk=',kk
7294 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7295 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7296 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7299 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7300 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7303 call transpose2(aa1(1,1),aa1t(1,1))
7304 call transpose2(aa2(1,1),aa2t(1,1))
7307 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7308 & aa1tder(1,1,lll,kkk))
7309 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7310 & aa2tder(1,1,lll,kkk))
7314 C parallel orientation of the two CA-CA-CA frames.
7316 iti=itortyp(itype(i))
7320 itk1=itortyp(itype(k+1))
7321 itj=itortyp(itype(j))
7322 if (l.lt.nres-1) then
7323 itl1=itortyp(itype(l+1))
7327 C A1 kernel(j+1) A2T
7329 cd write (iout,'(3f10.5,5x,3f10.5)')
7330 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7332 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7333 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7334 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7335 C Following matrices are needed only for 6-th order cumulants
7336 IF (wcorr6.gt.0.0d0) THEN
7337 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7338 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7339 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7340 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7341 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7342 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7343 & ADtEAderx(1,1,1,1,1,1))
7345 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7346 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7347 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7348 & ADtEA1derx(1,1,1,1,1,1))
7350 C End 6-th order cumulants
7353 cd write (2,*) 'In calc_eello6'
7355 cd write (2,*) 'iii=',iii
7357 cd write (2,*) 'kkk=',kkk
7359 cd write (2,'(3(2f10.5),5x)')
7360 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7365 call transpose2(EUgder(1,1,k),auxmat(1,1))
7366 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7367 call transpose2(EUg(1,1,k),auxmat(1,1))
7368 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7369 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7373 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7374 & EAEAderx(1,1,lll,kkk,iii,1))
7378 C A1T kernel(i+1) A2
7379 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7380 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7381 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7382 C Following matrices are needed only for 6-th order cumulants
7383 IF (wcorr6.gt.0.0d0) THEN
7384 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7385 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7386 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7387 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7388 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7389 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7390 & ADtEAderx(1,1,1,1,1,2))
7391 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7392 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7393 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7394 & ADtEA1derx(1,1,1,1,1,2))
7396 C End 6-th order cumulants
7397 call transpose2(EUgder(1,1,l),auxmat(1,1))
7398 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7399 call transpose2(EUg(1,1,l),auxmat(1,1))
7400 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7401 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7405 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7406 & EAEAderx(1,1,lll,kkk,iii,2))
7411 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7412 C They are needed only when the fifth- or the sixth-order cumulants are
7414 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7415 call transpose2(AEA(1,1,1),auxmat(1,1))
7416 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7417 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7418 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7419 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7420 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7421 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7422 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7423 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7424 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7425 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7426 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7427 call transpose2(AEA(1,1,2),auxmat(1,1))
7428 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7429 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7430 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7431 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7432 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7433 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7434 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7435 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7436 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7437 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7438 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7439 C Calculate the Cartesian derivatives of the vectors.
7443 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7444 call matvec2(auxmat(1,1),b1(1,iti),
7445 & AEAb1derx(1,lll,kkk,iii,1,1))
7446 call matvec2(auxmat(1,1),Ub2(1,i),
7447 & AEAb2derx(1,lll,kkk,iii,1,1))
7448 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7449 & AEAb1derx(1,lll,kkk,iii,2,1))
7450 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7451 & AEAb2derx(1,lll,kkk,iii,2,1))
7452 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7453 call matvec2(auxmat(1,1),b1(1,itj),
7454 & AEAb1derx(1,lll,kkk,iii,1,2))
7455 call matvec2(auxmat(1,1),Ub2(1,j),
7456 & AEAb2derx(1,lll,kkk,iii,1,2))
7457 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7458 & AEAb1derx(1,lll,kkk,iii,2,2))
7459 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7460 & AEAb2derx(1,lll,kkk,iii,2,2))
7467 C Antiparallel orientation of the two CA-CA-CA frames.
7469 iti=itortyp(itype(i))
7473 itk1=itortyp(itype(k+1))
7474 itl=itortyp(itype(l))
7475 itj=itortyp(itype(j))
7476 if (j.lt.nres-1) then
7477 itj1=itortyp(itype(j+1))
7481 C A2 kernel(j-1)T A1T
7482 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7483 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7484 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7485 C Following matrices are needed only for 6-th order cumulants
7486 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7487 & j.eq.i+4 .and. l.eq.i+3)) THEN
7488 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7489 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7490 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7491 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7492 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7493 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7494 & ADtEAderx(1,1,1,1,1,1))
7495 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7496 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7497 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7498 & ADtEA1derx(1,1,1,1,1,1))
7500 C End 6-th order cumulants
7501 call transpose2(EUgder(1,1,k),auxmat(1,1))
7502 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7503 call transpose2(EUg(1,1,k),auxmat(1,1))
7504 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7505 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7509 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7510 & EAEAderx(1,1,lll,kkk,iii,1))
7514 C A2T kernel(i+1)T A1
7515 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7516 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7517 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7518 C Following matrices are needed only for 6-th order cumulants
7519 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7520 & j.eq.i+4 .and. l.eq.i+3)) THEN
7521 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7522 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7523 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7524 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7525 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7526 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7527 & ADtEAderx(1,1,1,1,1,2))
7528 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7529 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7530 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7531 & ADtEA1derx(1,1,1,1,1,2))
7533 C End 6-th order cumulants
7534 call transpose2(EUgder(1,1,j),auxmat(1,1))
7535 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7536 call transpose2(EUg(1,1,j),auxmat(1,1))
7537 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7538 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7542 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7543 & EAEAderx(1,1,lll,kkk,iii,2))
7548 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7549 C They are needed only when the fifth- or the sixth-order cumulants are
7551 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7552 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7553 call transpose2(AEA(1,1,1),auxmat(1,1))
7554 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7555 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7556 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7557 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7558 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7559 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7560 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7561 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7562 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7563 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7564 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7565 call transpose2(AEA(1,1,2),auxmat(1,1))
7566 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7567 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7568 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7569 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7570 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7571 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7572 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7573 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7574 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7575 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7576 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7577 C Calculate the Cartesian derivatives of the vectors.
7581 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7582 call matvec2(auxmat(1,1),b1(1,iti),
7583 & AEAb1derx(1,lll,kkk,iii,1,1))
7584 call matvec2(auxmat(1,1),Ub2(1,i),
7585 & AEAb2derx(1,lll,kkk,iii,1,1))
7586 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7587 & AEAb1derx(1,lll,kkk,iii,2,1))
7588 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7589 & AEAb2derx(1,lll,kkk,iii,2,1))
7590 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7591 call matvec2(auxmat(1,1),b1(1,itl),
7592 & AEAb1derx(1,lll,kkk,iii,1,2))
7593 call matvec2(auxmat(1,1),Ub2(1,l),
7594 & AEAb2derx(1,lll,kkk,iii,1,2))
7595 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7596 & AEAb1derx(1,lll,kkk,iii,2,2))
7597 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7598 & AEAb2derx(1,lll,kkk,iii,2,2))
7607 C---------------------------------------------------------------------------
7608 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7609 & KK,KKderg,AKA,AKAderg,AKAderx)
7613 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7614 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7615 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7620 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7622 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7625 cd if (lprn) write (2,*) 'In kernel'
7627 cd if (lprn) write (2,*) 'kkk=',kkk
7629 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7630 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7632 cd write (2,*) 'lll=',lll
7633 cd write (2,*) 'iii=1'
7635 cd write (2,'(3(2f10.5),5x)')
7636 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7639 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7640 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7642 cd write (2,*) 'lll=',lll
7643 cd write (2,*) 'iii=2'
7645 cd write (2,'(3(2f10.5),5x)')
7646 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7653 C---------------------------------------------------------------------------
7654 double precision function eello4(i,j,k,l,jj,kk)
7655 implicit real*8 (a-h,o-z)
7656 include 'DIMENSIONS'
7657 include 'COMMON.IOUNITS'
7658 include 'COMMON.CHAIN'
7659 include 'COMMON.DERIV'
7660 include 'COMMON.INTERACT'
7661 include 'COMMON.CONTACTS'
7662 include 'COMMON.TORSION'
7663 include 'COMMON.VAR'
7664 include 'COMMON.GEO'
7665 double precision pizda(2,2),ggg1(3),ggg2(3)
7666 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7670 cd print *,'eello4:',i,j,k,l,jj,kk
7671 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7672 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7673 cold eij=facont_hb(jj,i)
7674 cold ekl=facont_hb(kk,k)
7676 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7677 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7678 gcorr_loc(k-1)=gcorr_loc(k-1)
7679 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7681 gcorr_loc(l-1)=gcorr_loc(l-1)
7682 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7684 gcorr_loc(j-1)=gcorr_loc(j-1)
7685 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7690 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7691 & -EAEAderx(2,2,lll,kkk,iii,1)
7692 cd derx(lll,kkk,iii)=0.0d0
7696 cd gcorr_loc(l-1)=0.0d0
7697 cd gcorr_loc(j-1)=0.0d0
7698 cd gcorr_loc(k-1)=0.0d0
7700 cd write (iout,*)'Contacts have occurred for peptide groups',
7701 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7702 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7703 if (j.lt.nres-1) then
7710 if (l.lt.nres-1) then
7718 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7719 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7720 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7721 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7722 cgrad ghalf=0.5d0*ggg1(ll)
7723 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7724 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7725 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7726 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7727 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7728 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7729 cgrad ghalf=0.5d0*ggg2(ll)
7730 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7731 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7732 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7733 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7734 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7735 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7739 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7744 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7749 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7754 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7758 cd write (2,*) iii,gcorr_loc(iii)
7761 cd write (2,*) 'ekont',ekont
7762 cd write (iout,*) 'eello4',ekont*eel4
7765 C---------------------------------------------------------------------------
7766 double precision function eello5(i,j,k,l,jj,kk)
7767 implicit real*8 (a-h,o-z)
7768 include 'DIMENSIONS'
7769 include 'COMMON.IOUNITS'
7770 include 'COMMON.CHAIN'
7771 include 'COMMON.DERIV'
7772 include 'COMMON.INTERACT'
7773 include 'COMMON.CONTACTS'
7774 include 'COMMON.TORSION'
7775 include 'COMMON.VAR'
7776 include 'COMMON.GEO'
7777 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7778 double precision ggg1(3),ggg2(3)
7779 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7784 C /l\ / \ \ / \ / \ / C
7785 C / \ / \ \ / \ / \ / C
7786 C j| o |l1 | o | o| o | | o |o C
7787 C \ |/k\| |/ \| / |/ \| |/ \| C
7788 C \i/ \ / \ / / \ / \ C
7790 C (I) (II) (III) (IV) C
7792 C eello5_1 eello5_2 eello5_3 eello5_4 C
7794 C Antiparallel chains C
7797 C /j\ / \ \ / \ / \ / C
7798 C / \ / \ \ / \ / \ / C
7799 C j1| o |l | o | o| o | | o |o C
7800 C \ |/k\| |/ \| / |/ \| |/ \| C
7801 C \i/ \ / \ / / \ / \ C
7803 C (I) (II) (III) (IV) C
7805 C eello5_1 eello5_2 eello5_3 eello5_4 C
7807 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7809 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7810 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7815 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7817 itk=itortyp(itype(k))
7818 itl=itortyp(itype(l))
7819 itj=itortyp(itype(j))
7824 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7825 cd & eel5_3_num,eel5_4_num)
7829 derx(lll,kkk,iii)=0.0d0
7833 cd eij=facont_hb(jj,i)
7834 cd ekl=facont_hb(kk,k)
7836 cd write (iout,*)'Contacts have occurred for peptide groups',
7837 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7839 C Contribution from the graph I.
7840 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7841 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7842 call transpose2(EUg(1,1,k),auxmat(1,1))
7843 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7844 vv(1)=pizda(1,1)-pizda(2,2)
7845 vv(2)=pizda(1,2)+pizda(2,1)
7846 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7847 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7848 C Explicit gradient in virtual-dihedral angles.
7849 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7850 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7851 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7852 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7853 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7854 vv(1)=pizda(1,1)-pizda(2,2)
7855 vv(2)=pizda(1,2)+pizda(2,1)
7856 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7857 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7858 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7859 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7860 vv(1)=pizda(1,1)-pizda(2,2)
7861 vv(2)=pizda(1,2)+pizda(2,1)
7863 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7864 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7865 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7867 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7868 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7869 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7871 C Cartesian gradient
7875 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7877 vv(1)=pizda(1,1)-pizda(2,2)
7878 vv(2)=pizda(1,2)+pizda(2,1)
7879 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7880 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7881 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7887 C Contribution from graph II
7888 call transpose2(EE(1,1,itk),auxmat(1,1))
7889 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7890 vv(1)=pizda(1,1)+pizda(2,2)
7891 vv(2)=pizda(2,1)-pizda(1,2)
7892 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7893 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7894 C Explicit gradient in virtual-dihedral angles.
7895 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7896 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7897 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7898 vv(1)=pizda(1,1)+pizda(2,2)
7899 vv(2)=pizda(2,1)-pizda(1,2)
7901 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7902 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7903 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7905 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7906 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7907 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7909 C Cartesian gradient
7913 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7915 vv(1)=pizda(1,1)+pizda(2,2)
7916 vv(2)=pizda(2,1)-pizda(1,2)
7917 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7918 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7919 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7927 C Parallel orientation
7928 C Contribution from graph III
7929 call transpose2(EUg(1,1,l),auxmat(1,1))
7930 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7931 vv(1)=pizda(1,1)-pizda(2,2)
7932 vv(2)=pizda(1,2)+pizda(2,1)
7933 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7934 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7935 C Explicit gradient in virtual-dihedral angles.
7936 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7937 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7938 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7939 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7940 vv(1)=pizda(1,1)-pizda(2,2)
7941 vv(2)=pizda(1,2)+pizda(2,1)
7942 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7943 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7944 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7945 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7946 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7947 vv(1)=pizda(1,1)-pizda(2,2)
7948 vv(2)=pizda(1,2)+pizda(2,1)
7949 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7950 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7951 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7952 C Cartesian gradient
7956 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7958 vv(1)=pizda(1,1)-pizda(2,2)
7959 vv(2)=pizda(1,2)+pizda(2,1)
7960 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7961 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7962 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7967 C Contribution from graph IV
7969 call transpose2(EE(1,1,itl),auxmat(1,1))
7970 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7971 vv(1)=pizda(1,1)+pizda(2,2)
7972 vv(2)=pizda(2,1)-pizda(1,2)
7973 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7974 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7975 C Explicit gradient in virtual-dihedral angles.
7976 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7977 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7978 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7979 vv(1)=pizda(1,1)+pizda(2,2)
7980 vv(2)=pizda(2,1)-pizda(1,2)
7981 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7982 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7983 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7984 C Cartesian gradient
7988 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7990 vv(1)=pizda(1,1)+pizda(2,2)
7991 vv(2)=pizda(2,1)-pizda(1,2)
7992 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7993 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7994 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7999 C Antiparallel orientation
8000 C Contribution from graph III
8002 call transpose2(EUg(1,1,j),auxmat(1,1))
8003 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8004 vv(1)=pizda(1,1)-pizda(2,2)
8005 vv(2)=pizda(1,2)+pizda(2,1)
8006 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8007 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8008 C Explicit gradient in virtual-dihedral angles.
8009 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8010 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8011 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8012 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8013 vv(1)=pizda(1,1)-pizda(2,2)
8014 vv(2)=pizda(1,2)+pizda(2,1)
8015 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8016 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8017 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8018 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8019 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8020 vv(1)=pizda(1,1)-pizda(2,2)
8021 vv(2)=pizda(1,2)+pizda(2,1)
8022 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8023 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8024 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8025 C Cartesian gradient
8029 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8031 vv(1)=pizda(1,1)-pizda(2,2)
8032 vv(2)=pizda(1,2)+pizda(2,1)
8033 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8034 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8035 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8040 C Contribution from graph IV
8042 call transpose2(EE(1,1,itj),auxmat(1,1))
8043 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8044 vv(1)=pizda(1,1)+pizda(2,2)
8045 vv(2)=pizda(2,1)-pizda(1,2)
8046 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8047 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8048 C Explicit gradient in virtual-dihedral angles.
8049 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8050 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8051 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8052 vv(1)=pizda(1,1)+pizda(2,2)
8053 vv(2)=pizda(2,1)-pizda(1,2)
8054 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8055 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8056 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8057 C Cartesian gradient
8061 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8063 vv(1)=pizda(1,1)+pizda(2,2)
8064 vv(2)=pizda(2,1)-pizda(1,2)
8065 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8066 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8067 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8073 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8074 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8075 cd write (2,*) 'ijkl',i,j,k,l
8076 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8077 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8079 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8080 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8081 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8082 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8083 if (j.lt.nres-1) then
8090 if (l.lt.nres-1) then
8100 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8101 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8102 C summed up outside the subrouine as for the other subroutines
8103 C handling long-range interactions. The old code is commented out
8104 C with "cgrad" to keep track of changes.
8106 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8107 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8108 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8109 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8110 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8111 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8112 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8113 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8114 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8115 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8117 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8118 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8119 cgrad ghalf=0.5d0*ggg1(ll)
8121 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8122 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8123 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8124 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8125 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8126 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8127 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8128 cgrad ghalf=0.5d0*ggg2(ll)
8130 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8131 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8132 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8133 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8134 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8135 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8140 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8141 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8146 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8147 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8153 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8158 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8162 cd write (2,*) iii,g_corr5_loc(iii)
8165 cd write (2,*) 'ekont',ekont
8166 cd write (iout,*) 'eello5',ekont*eel5
8169 c--------------------------------------------------------------------------
8170 double precision function eello6(i,j,k,l,jj,kk)
8171 implicit real*8 (a-h,o-z)
8172 include 'DIMENSIONS'
8173 include 'COMMON.IOUNITS'
8174 include 'COMMON.CHAIN'
8175 include 'COMMON.DERIV'
8176 include 'COMMON.INTERACT'
8177 include 'COMMON.CONTACTS'
8178 include 'COMMON.TORSION'
8179 include 'COMMON.VAR'
8180 include 'COMMON.GEO'
8181 include 'COMMON.FFIELD'
8182 double precision ggg1(3),ggg2(3)
8183 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8188 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8196 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8197 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8201 derx(lll,kkk,iii)=0.0d0
8205 cd eij=facont_hb(jj,i)
8206 cd ekl=facont_hb(kk,k)
8212 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8213 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8214 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8215 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8216 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8217 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8219 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8220 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8221 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8222 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8223 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8224 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8228 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8230 C If turn contributions are considered, they will be handled separately.
8231 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8232 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8233 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8234 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8235 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8236 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8237 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8239 if (j.lt.nres-1) then
8246 if (l.lt.nres-1) then
8254 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8255 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8256 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8257 cgrad ghalf=0.5d0*ggg1(ll)
8259 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8260 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8261 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8262 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8263 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8264 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8265 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8266 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8267 cgrad ghalf=0.5d0*ggg2(ll)
8268 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8270 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8271 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8272 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8273 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8274 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8275 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8280 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8281 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8286 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8287 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8293 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8298 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8302 cd write (2,*) iii,g_corr6_loc(iii)
8305 cd write (2,*) 'ekont',ekont
8306 cd write (iout,*) 'eello6',ekont*eel6
8309 c--------------------------------------------------------------------------
8310 double precision function eello6_graph1(i,j,k,l,imat,swap)
8311 implicit real*8 (a-h,o-z)
8312 include 'DIMENSIONS'
8313 include 'COMMON.IOUNITS'
8314 include 'COMMON.CHAIN'
8315 include 'COMMON.DERIV'
8316 include 'COMMON.INTERACT'
8317 include 'COMMON.CONTACTS'
8318 include 'COMMON.TORSION'
8319 include 'COMMON.VAR'
8320 include 'COMMON.GEO'
8321 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8325 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8327 C Parallel Antiparallel
8333 C \ j|/k\| / \ |/k\|l /
8338 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8339 itk=itortyp(itype(k))
8340 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8341 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8342 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8343 call transpose2(EUgC(1,1,k),auxmat(1,1))
8344 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8345 vv1(1)=pizda1(1,1)-pizda1(2,2)
8346 vv1(2)=pizda1(1,2)+pizda1(2,1)
8347 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8348 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8349 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8350 s5=scalar2(vv(1),Dtobr2(1,i))
8351 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8352 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8353 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8354 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8355 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8356 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8357 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8358 & +scalar2(vv(1),Dtobr2der(1,i)))
8359 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8360 vv1(1)=pizda1(1,1)-pizda1(2,2)
8361 vv1(2)=pizda1(1,2)+pizda1(2,1)
8362 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8363 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8365 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8366 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8367 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8368 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8369 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8371 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8372 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8373 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8374 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8375 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8377 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8378 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8379 vv1(1)=pizda1(1,1)-pizda1(2,2)
8380 vv1(2)=pizda1(1,2)+pizda1(2,1)
8381 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8382 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8383 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8384 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8393 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8394 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8395 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8396 call transpose2(EUgC(1,1,k),auxmat(1,1))
8397 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8399 vv1(1)=pizda1(1,1)-pizda1(2,2)
8400 vv1(2)=pizda1(1,2)+pizda1(2,1)
8401 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8402 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8403 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8404 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8405 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8406 s5=scalar2(vv(1),Dtobr2(1,i))
8407 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8413 c----------------------------------------------------------------------------
8414 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8415 implicit real*8 (a-h,o-z)
8416 include 'DIMENSIONS'
8417 include 'COMMON.IOUNITS'
8418 include 'COMMON.CHAIN'
8419 include 'COMMON.DERIV'
8420 include 'COMMON.INTERACT'
8421 include 'COMMON.CONTACTS'
8422 include 'COMMON.TORSION'
8423 include 'COMMON.VAR'
8424 include 'COMMON.GEO'
8426 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8427 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8430 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8432 C Parallel Antiparallel C
8438 C \ j|/k\| \ |/k\|l C
8443 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8444 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8445 C AL 7/4/01 s1 would occur in the sixth-order moment,
8446 C but not in a cluster cumulant
8448 s1=dip(1,jj,i)*dip(1,kk,k)
8450 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8451 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8452 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8453 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8454 call transpose2(EUg(1,1,k),auxmat(1,1))
8455 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8456 vv(1)=pizda(1,1)-pizda(2,2)
8457 vv(2)=pizda(1,2)+pizda(2,1)
8458 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8459 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8461 eello6_graph2=-(s1+s2+s3+s4)
8463 eello6_graph2=-(s2+s3+s4)
8466 C Derivatives in gamma(i-1)
8469 s1=dipderg(1,jj,i)*dip(1,kk,k)
8471 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8472 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8473 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8474 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8476 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8478 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8480 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8482 C Derivatives in gamma(k-1)
8484 s1=dip(1,jj,i)*dipderg(1,kk,k)
8486 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8487 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8488 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8489 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8490 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8491 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8492 vv(1)=pizda(1,1)-pizda(2,2)
8493 vv(2)=pizda(1,2)+pizda(2,1)
8494 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8496 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8498 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8500 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8501 C Derivatives in gamma(j-1) or gamma(l-1)
8504 s1=dipderg(3,jj,i)*dip(1,kk,k)
8506 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8507 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8508 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8509 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8510 vv(1)=pizda(1,1)-pizda(2,2)
8511 vv(2)=pizda(1,2)+pizda(2,1)
8512 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8515 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8517 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8520 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8521 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8523 C Derivatives in gamma(l-1) or gamma(j-1)
8526 s1=dip(1,jj,i)*dipderg(3,kk,k)
8528 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8529 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8530 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8531 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8532 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8533 vv(1)=pizda(1,1)-pizda(2,2)
8534 vv(2)=pizda(1,2)+pizda(2,1)
8535 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8538 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8540 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8543 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8544 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8546 C Cartesian derivatives.
8548 write (2,*) 'In eello6_graph2'
8550 write (2,*) 'iii=',iii
8552 write (2,*) 'kkk=',kkk
8554 write (2,'(3(2f10.5),5x)')
8555 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8565 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8567 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8570 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8572 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8573 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8575 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8576 call transpose2(EUg(1,1,k),auxmat(1,1))
8577 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8579 vv(1)=pizda(1,1)-pizda(2,2)
8580 vv(2)=pizda(1,2)+pizda(2,1)
8581 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8582 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8584 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8586 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8589 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8591 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8598 c----------------------------------------------------------------------------
8599 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8600 implicit real*8 (a-h,o-z)
8601 include 'DIMENSIONS'
8602 include 'COMMON.IOUNITS'
8603 include 'COMMON.CHAIN'
8604 include 'COMMON.DERIV'
8605 include 'COMMON.INTERACT'
8606 include 'COMMON.CONTACTS'
8607 include 'COMMON.TORSION'
8608 include 'COMMON.VAR'
8609 include 'COMMON.GEO'
8610 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8612 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8614 C Parallel Antiparallel C
8620 C j|/k\| / |/k\|l / C
8625 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8627 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8628 C energy moment and not to the cluster cumulant.
8629 iti=itortyp(itype(i))
8630 if (j.lt.nres-1) then
8631 itj1=itortyp(itype(j+1))
8635 itk=itortyp(itype(k))
8636 itk1=itortyp(itype(k+1))
8637 if (l.lt.nres-1) then
8638 itl1=itortyp(itype(l+1))
8643 s1=dip(4,jj,i)*dip(4,kk,k)
8645 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8646 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8647 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8648 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8649 call transpose2(EE(1,1,itk),auxmat(1,1))
8650 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8651 vv(1)=pizda(1,1)+pizda(2,2)
8652 vv(2)=pizda(2,1)-pizda(1,2)
8653 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8654 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8655 cd & "sum",-(s2+s3+s4)
8657 eello6_graph3=-(s1+s2+s3+s4)
8659 eello6_graph3=-(s2+s3+s4)
8662 C Derivatives in gamma(k-1)
8663 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8664 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8665 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8666 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8667 C Derivatives in gamma(l-1)
8668 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8669 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8670 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8671 vv(1)=pizda(1,1)+pizda(2,2)
8672 vv(2)=pizda(2,1)-pizda(1,2)
8673 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8674 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8675 C Cartesian derivatives.
8681 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8683 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8686 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8688 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8689 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8691 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8692 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8694 vv(1)=pizda(1,1)+pizda(2,2)
8695 vv(2)=pizda(2,1)-pizda(1,2)
8696 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8698 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8700 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8703 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8705 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8707 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8713 c----------------------------------------------------------------------------
8714 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8715 implicit real*8 (a-h,o-z)
8716 include 'DIMENSIONS'
8717 include 'COMMON.IOUNITS'
8718 include 'COMMON.CHAIN'
8719 include 'COMMON.DERIV'
8720 include 'COMMON.INTERACT'
8721 include 'COMMON.CONTACTS'
8722 include 'COMMON.TORSION'
8723 include 'COMMON.VAR'
8724 include 'COMMON.GEO'
8725 include 'COMMON.FFIELD'
8726 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8727 & auxvec1(2),auxmat1(2,2)
8729 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8731 C Parallel Antiparallel C
8737 C \ j|/k\| \ |/k\|l C
8742 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8744 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8745 C energy moment and not to the cluster cumulant.
8746 cd write (2,*) 'eello_graph4: wturn6',wturn6
8747 iti=itortyp(itype(i))
8748 itj=itortyp(itype(j))
8749 if (j.lt.nres-1) then
8750 itj1=itortyp(itype(j+1))
8754 itk=itortyp(itype(k))
8755 if (k.lt.nres-1) then
8756 itk1=itortyp(itype(k+1))
8760 itl=itortyp(itype(l))
8761 if (l.lt.nres-1) then
8762 itl1=itortyp(itype(l+1))
8766 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8767 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8768 cd & ' itl',itl,' itl1',itl1
8771 s1=dip(3,jj,i)*dip(3,kk,k)
8773 s1=dip(2,jj,j)*dip(2,kk,l)
8776 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8777 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8779 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8780 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8782 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8783 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8785 call transpose2(EUg(1,1,k),auxmat(1,1))
8786 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8787 vv(1)=pizda(1,1)-pizda(2,2)
8788 vv(2)=pizda(2,1)+pizda(1,2)
8789 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8790 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8792 eello6_graph4=-(s1+s2+s3+s4)
8794 eello6_graph4=-(s2+s3+s4)
8796 C Derivatives in gamma(i-1)
8800 s1=dipderg(2,jj,i)*dip(3,kk,k)
8802 s1=dipderg(4,jj,j)*dip(2,kk,l)
8805 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8807 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8808 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8810 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8811 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8813 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8814 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8815 cd write (2,*) 'turn6 derivatives'
8817 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8819 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8823 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8825 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8829 C Derivatives in gamma(k-1)
8832 s1=dip(3,jj,i)*dipderg(2,kk,k)
8834 s1=dip(2,jj,j)*dipderg(4,kk,l)
8837 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8838 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8840 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8841 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8843 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8844 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8846 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8847 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8848 vv(1)=pizda(1,1)-pizda(2,2)
8849 vv(2)=pizda(2,1)+pizda(1,2)
8850 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8851 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8853 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8855 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8859 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8861 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8864 C Derivatives in gamma(j-1) or gamma(l-1)
8865 if (l.eq.j+1 .and. l.gt.1) then
8866 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8867 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8868 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8869 vv(1)=pizda(1,1)-pizda(2,2)
8870 vv(2)=pizda(2,1)+pizda(1,2)
8871 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8872 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8873 else if (j.gt.1) then
8874 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8875 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8876 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8877 vv(1)=pizda(1,1)-pizda(2,2)
8878 vv(2)=pizda(2,1)+pizda(1,2)
8879 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8880 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8881 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8883 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8886 C Cartesian derivatives.
8893 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8895 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8899 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8901 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8905 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8907 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8909 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8910 & b1(1,itj1),auxvec(1))
8911 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8913 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8914 & b1(1,itl1),auxvec(1))
8915 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8917 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8919 vv(1)=pizda(1,1)-pizda(2,2)
8920 vv(2)=pizda(2,1)+pizda(1,2)
8921 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8923 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8925 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8928 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8931 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8934 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8936 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8938 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8942 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8944 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8947 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8949 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8957 c----------------------------------------------------------------------------
8958 double precision function eello_turn6(i,jj,kk)
8959 implicit real*8 (a-h,o-z)
8960 include 'DIMENSIONS'
8961 include 'COMMON.IOUNITS'
8962 include 'COMMON.CHAIN'
8963 include 'COMMON.DERIV'
8964 include 'COMMON.INTERACT'
8965 include 'COMMON.CONTACTS'
8966 include 'COMMON.TORSION'
8967 include 'COMMON.VAR'
8968 include 'COMMON.GEO'
8969 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8970 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8972 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8973 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8974 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8975 C the respective energy moment and not to the cluster cumulant.
8984 iti=itortyp(itype(i))
8985 itk=itortyp(itype(k))
8986 itk1=itortyp(itype(k+1))
8987 itl=itortyp(itype(l))
8988 itj=itortyp(itype(j))
8989 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8990 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8991 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8996 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8998 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9002 derx_turn(lll,kkk,iii)=0.0d0
9009 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9011 cd write (2,*) 'eello6_5',eello6_5
9013 call transpose2(AEA(1,1,1),auxmat(1,1))
9014 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9015 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9016 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9018 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9019 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9020 s2 = scalar2(b1(1,itk),vtemp1(1))
9022 call transpose2(AEA(1,1,2),atemp(1,1))
9023 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9024 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9025 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9027 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9028 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9029 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9031 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9032 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9033 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9034 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9035 ss13 = scalar2(b1(1,itk),vtemp4(1))
9036 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9038 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9044 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9045 C Derivatives in gamma(i+2)
9049 call transpose2(AEA(1,1,1),auxmatd(1,1))
9050 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9051 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9052 call transpose2(AEAderg(1,1,2),atempd(1,1))
9053 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9054 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9056 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9057 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9058 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9064 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9065 C Derivatives in gamma(i+3)
9067 call transpose2(AEA(1,1,1),auxmatd(1,1))
9068 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9069 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9070 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9072 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9073 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9074 s2d = scalar2(b1(1,itk),vtemp1d(1))
9076 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9077 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9079 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9081 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9082 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9083 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9091 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9092 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9094 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9095 & -0.5d0*ekont*(s2d+s12d)
9097 C Derivatives in gamma(i+4)
9098 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9099 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9100 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9102 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9103 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9104 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9112 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9114 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9116 C Derivatives in gamma(i+5)
9118 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9119 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9120 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9122 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9123 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9124 s2d = scalar2(b1(1,itk),vtemp1d(1))
9126 call transpose2(AEA(1,1,2),atempd(1,1))
9127 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9128 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9130 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9131 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9133 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9134 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9135 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9143 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9144 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9146 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9147 & -0.5d0*ekont*(s2d+s12d)
9149 C Cartesian derivatives
9154 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9155 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9156 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9158 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9159 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9161 s2d = scalar2(b1(1,itk),vtemp1d(1))
9163 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9164 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9165 s8d = -(atempd(1,1)+atempd(2,2))*
9166 & scalar2(cc(1,1,itl),vtemp2(1))
9168 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9170 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9171 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9178 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9181 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9185 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9186 & - 0.5d0*(s8d+s12d)
9188 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9197 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9199 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9200 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9201 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9202 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9203 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9205 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9206 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9207 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9211 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9212 cd & 16*eel_turn6_num
9214 if (j.lt.nres-1) then
9221 if (l.lt.nres-1) then
9229 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9230 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9231 cgrad ghalf=0.5d0*ggg1(ll)
9233 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9234 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9235 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9236 & +ekont*derx_turn(ll,2,1)
9237 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9238 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9239 & +ekont*derx_turn(ll,4,1)
9240 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9241 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9242 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9243 cgrad ghalf=0.5d0*ggg2(ll)
9245 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9246 & +ekont*derx_turn(ll,2,2)
9247 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9248 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9249 & +ekont*derx_turn(ll,4,2)
9250 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9251 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9252 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9257 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9262 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9268 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9273 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9277 cd write (2,*) iii,g_corr6_loc(iii)
9279 eello_turn6=ekont*eel_turn6
9280 cd write (2,*) 'ekont',ekont
9281 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9285 C-----------------------------------------------------------------------------
9286 double precision function scalar(u,v)
9287 !DIR$ INLINEALWAYS scalar
9289 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9292 double precision u(3),v(3)
9293 cd double precision sc
9301 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9304 crc-------------------------------------------------
9305 SUBROUTINE MATVEC2(A1,V1,V2)
9306 !DIR$ INLINEALWAYS MATVEC2
9308 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9310 implicit real*8 (a-h,o-z)
9311 include 'DIMENSIONS'
9312 DIMENSION A1(2,2),V1(2),V2(2)
9316 c 3 VI=VI+A1(I,K)*V1(K)
9320 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9321 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9326 C---------------------------------------
9327 SUBROUTINE MATMAT2(A1,A2,A3)
9329 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9331 implicit real*8 (a-h,o-z)
9332 include 'DIMENSIONS'
9333 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9334 c DIMENSION AI3(2,2)
9338 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9344 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9345 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9346 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9347 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9355 c-------------------------------------------------------------------------
9356 double precision function scalar2(u,v)
9357 !DIR$ INLINEALWAYS scalar2
9359 double precision u(2),v(2)
9362 scalar2=u(1)*v(1)+u(2)*v(2)
9366 C-----------------------------------------------------------------------------
9368 subroutine transpose2(a,at)
9369 !DIR$ INLINEALWAYS transpose2
9371 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9374 double precision a(2,2),at(2,2)
9381 c--------------------------------------------------------------------------
9382 subroutine transpose(n,a,at)
9385 double precision a(n,n),at(n,n)
9393 C---------------------------------------------------------------------------
9394 subroutine prodmat3(a1,a2,kk,transp,prod)
9395 !DIR$ INLINEALWAYS prodmat3
9397 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9401 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9403 crc double precision auxmat(2,2),prod_(2,2)
9406 crc call transpose2(kk(1,1),auxmat(1,1))
9407 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9408 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9410 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9411 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9412 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9413 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9414 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9415 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9416 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9417 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9420 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9421 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9423 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9424 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9425 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9426 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9427 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9428 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9429 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9430 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9433 c call transpose2(a2(1,1),a2t(1,1))
9436 crc print *,((prod_(i,j),i=1,2),j=1,2)
9437 crc print *,((prod(i,j),i=1,2),j=1,2)