1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
37 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
38 if (fg_rank.eq.0) then
39 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
40 c print *,"Processor",myrank," BROADCAST iorder"
41 C FG master sets up the WEIGHTS_ array which will be broadcast to the
42 C FG slaves as WEIGHTS array.
63 C FG Master broadcasts the WEIGHTS_ array
64 call MPI_Bcast(weights_(1),n_ene,
65 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
67 C FG slaves receive the WEIGHTS array
68 call MPI_Bcast(weights(1),n_ene,
69 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
91 time_Bcast=time_Bcast+MPI_Wtime()-time00
92 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
93 c call chainbuild_cart
95 c write(iout,*) 'Processor',myrank,' calling etotal ipot=',ipot
96 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
98 c if (modecalc.eq.12.or.modecalc.eq.14) then
99 c call int_from_cart1(.false.)
110 C Compute the side-chain and electrostatic interaction energy
112 goto (101,102,103,104,105,106) ipot
113 C Lennard-Jones potential.
114 101 call elj(evdw,evdw_p,evdw_m)
115 cd print '(a)','Exit ELJ'
117 C Lennard-Jones-Kihara potential (shifted).
118 102 call eljk(evdw,evdw_p,evdw_m)
120 C Berne-Pechukas potential (dilated LJ, angular dependence).
121 103 call ebp(evdw,evdw_p,evdw_m)
123 C Gay-Berne potential (shifted LJ, angular dependence).
124 104 call egb(evdw,evdw_p,evdw_m)
126 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
127 105 call egbv(evdw,evdw_p,evdw_m)
129 C Soft-sphere potential
130 106 call e_softsphere(evdw)
132 C Calculate electrostatic (H-bonding) energy of the main chain.
135 C BARTEK for dfa test!
136 if (wdfa_dist.gt.0) then
141 c print*, 'edfad is finished!', edfadis
142 if (wdfa_tor.gt.0) then
147 c print*, 'edfat is finished!', edfator
148 if (wdfa_nei.gt.0) then
153 c print*, 'edfan is finished!', edfanei
154 if (wdfa_beta.gt.0) then
159 c print*, 'edfab is finished!', edfabet
161 cmc Sep-06: egb takes care of dynamic ss bonds too
163 c if (dyn_ss) call dyn_set_nss
165 c print *,"Processor",myrank," computed USCSC"
176 time_vec=time_vec+MPI_Wtime()-time01
178 time_vec=time_vec+tcpu()-time01
181 c print *,"Processor",myrank," left VEC_AND_DERIV"
184 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
185 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
186 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
187 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
189 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
190 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
191 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
192 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
194 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
203 c write (iout,*) "Soft-spheer ELEC potential"
204 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
207 c print *,"Processor",myrank," computed UELEC"
209 C Calculate excluded-volume interaction energy between peptide groups
214 call escp(evdw2,evdw2_14)
220 c write (iout,*) "Soft-sphere SCP potential"
221 call escp_soft_sphere(evdw2,evdw2_14)
224 c Calculate the bond-stretching energy
228 C Calculate the disulfide-bridge and other energy and the contributions
229 C from other distance constraints.
230 cd print *,'Calling EHPB'
232 cd print *,'EHPB exitted succesfully.'
234 C Calculate the virtual-bond-angle energy.
236 if (wang.gt.0d0) then
241 c print *,"Processor",myrank," computed UB"
243 C Calculate the SC local energy.
246 c print *,"Processor",myrank," computed USC"
248 C Calculate the virtual-bond torsional energy.
250 cd print *,'nterm=',nterm
252 call etor(etors,edihcnstr)
258 if (constr_homology.ge.1) then
259 call e_modeller(ehomology_constr)
260 c print *,'iset=',iset,'me=',me,ehomology_constr,
261 c & 'Processor',fg_rank,' CG group',kolor,
262 c & ' absolute rank',MyRank
264 ehomology_constr=0.0d0
268 c write(iout,*) ehomology_constr
269 c print *,"Processor",myrank," computed Utor"
271 C 6/23/01 Calculate double-torsional energy
273 if (wtor_d.gt.0) then
278 c print *,"Processor",myrank," computed Utord"
280 C 21/5/07 Calculate local sicdechain correlation energy
282 if (wsccor.gt.0.0d0) then
283 call eback_sc_corr(esccor)
287 c print *,"Processor",myrank," computed Usccorr"
289 C 12/1/95 Multi-body terms
293 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
294 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
295 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
296 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
297 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
304 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
305 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
306 cd write (iout,*) "multibody_hb ecorr",ecorr
308 c print *,"Processor",myrank," computed Ucorr"
310 C If performing constraint dynamics, call the constraint energy
311 C after the equilibration time
312 if(usampl.and.totT.gt.eq_time) then
313 c write (iout,*) "CALL TO ECONSTR_BACK"
322 time_enecalc=time_enecalc+MPI_Wtime()-time00
324 time_enecalc=time_enecalc+tcpu()-time00
327 c print *,"Processor",myrank," computed Uconstr"
340 energia(2)=evdw2-evdw2_14
357 energia(8)=eello_turn3
358 energia(9)=eello_turn4
365 energia(19)=edihcnstr
367 energia(20)=Uconst+Uconst_back
371 energia(24)=ehomology_constr
376 c print *," Processor",myrank," calls SUM_ENERGY"
377 call sum_energy(energia,.true.)
378 if (dyn_ss) call dyn_set_nss
379 c print *," Processor",myrank," left SUM_ENERGY"
382 time_sumene=time_sumene+MPI_Wtime()-time00
384 time_sumene=time_sumene+tcpu()-time00
389 c-------------------------------------------------------------------------------
390 subroutine sum_energy(energia,reduce)
391 implicit real*8 (a-h,o-z)
396 cMS$ATTRIBUTES C :: proc_proc
402 include 'COMMON.SETUP'
403 include 'COMMON.IOUNITS'
404 double precision energia(0:n_ene),enebuff(0:n_ene+1)
405 include 'COMMON.FFIELD'
406 include 'COMMON.DERIV'
407 include 'COMMON.INTERACT'
408 include 'COMMON.SBRIDGE'
409 include 'COMMON.CHAIN'
411 include 'COMMON.CONTROL'
412 include 'COMMON.TIME1'
415 if (nfgtasks.gt.1 .and. reduce) then
417 write (iout,*) "energies before REDUCE"
418 call enerprint(energia)
422 enebuff(i)=energia(i)
425 call MPI_Barrier(FG_COMM,IERR)
426 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
428 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
429 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
431 write (iout,*) "energies after REDUCE"
432 call enerprint(energia)
435 time_Reduce=time_Reduce+MPI_Wtime()-time00
437 if (fg_rank.eq.0) then
440 evdw=energia(22)+wsct*energia(23)
445 evdw2=energia(2)+energia(18)
461 eello_turn3=energia(8)
462 eello_turn4=energia(9)
469 edihcnstr=energia(19)
473 ehomology_constr=energia(24)
479 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
480 & +wang*ebe+wtor*etors+wscloc*escloc
481 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
482 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
483 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
484 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
485 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
488 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
489 & +wang*ebe+wtor*etors+wscloc*escloc
490 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
491 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
492 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
493 & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
494 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
501 if (isnan(etot).ne.0) energia(0)=1.0d+99
503 if (isnan(etot)) energia(0)=1.0d+99
508 idumm=proc_proc(etot,i)
510 call proc_proc(etot,i)
512 if(i.eq.1)energia(0)=1.0d+99
519 c-------------------------------------------------------------------------------
520 subroutine sum_gradient
521 implicit real*8 (a-h,o-z)
526 cMS$ATTRIBUTES C :: proc_proc
532 double precision gradbufc(3,maxres),gradbufx(3,maxres),
533 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
534 include 'COMMON.SETUP'
535 include 'COMMON.IOUNITS'
536 include 'COMMON.FFIELD'
537 include 'COMMON.DERIV'
538 include 'COMMON.INTERACT'
539 include 'COMMON.SBRIDGE'
540 include 'COMMON.CHAIN'
542 include 'COMMON.CONTROL'
543 include 'COMMON.TIME1'
544 include 'COMMON.MAXGRAD'
545 include 'COMMON.SCCOR'
555 write (iout,*) "sum_gradient gvdwc, gvdwx"
557 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
558 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
559 & (gvdwcT(j,i),j=1,3)
564 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
565 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
566 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
569 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
570 C in virtual-bond-vector coordinates
573 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
575 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
576 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
578 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
580 c write (iout,'(i5,3f10.5,2x,f10.5)')
581 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
583 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
585 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
586 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
595 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
596 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
597 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
598 & wel_loc*gel_loc_long(j,i)+
599 & wcorr*gradcorr_long(j,i)+
600 & wcorr5*gradcorr5_long(j,i)+
601 & wcorr6*gradcorr6_long(j,i)+
602 & wturn6*gcorr6_turn_long(j,i)+
603 & wstrain*ghpbc(j,i)+
604 & wdfa_dist*gdfad(j,i)+
605 & wdfa_tor*gdfat(j,i)+
606 & wdfa_nei*gdfan(j,i)+
607 & wdfa_beta*gdfab(j,i)
613 gradbufc(j,i)=wsc*gvdwc(j,i)+
614 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
615 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
616 & wel_loc*gel_loc_long(j,i)+
617 & wcorr*gradcorr_long(j,i)+
618 & wcorr5*gradcorr5_long(j,i)+
619 & wcorr6*gradcorr6_long(j,i)+
620 & wturn6*gcorr6_turn_long(j,i)+
621 & wstrain*ghpbc(j,i)+
622 & wdfa_dist*gdfad(j,i)+
623 & wdfa_tor*gdfat(j,i)+
624 & wdfa_nei*gdfan(j,i)+
625 & wdfa_beta*gdfab(j,i)
632 gradbufc(j,i)=wsc*gvdwc(j,i)+
633 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
634 & welec*gelc_long(j,i)+
636 & wel_loc*gel_loc_long(j,i)+
637 & wcorr*gradcorr_long(j,i)+
638 & wcorr5*gradcorr5_long(j,i)+
639 & wcorr6*gradcorr6_long(j,i)+
640 & wturn6*gcorr6_turn_long(j,i)+
641 & wstrain*ghpbc(j,i)+
642 & wdfa_dist*gdfad(j,i)+
643 & wdfa_tor*gdfat(j,i)+
644 & wdfa_nei*gdfan(j,i)+
645 & wdfa_beta*gdfab(j,i)
650 if (nfgtasks.gt.1) then
653 write (iout,*) "gradbufc before allreduce"
655 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
661 gradbufc_sum(j,i)=gradbufc(j,i)
664 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
665 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
666 c time_reduce=time_reduce+MPI_Wtime()-time00
668 c write (iout,*) "gradbufc_sum after allreduce"
670 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
675 c time_allreduce=time_allreduce+MPI_Wtime()-time00
683 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
684 write (iout,*) (i," jgrad_start",jgrad_start(i),
685 & " jgrad_end ",jgrad_end(i),
686 & i=igrad_start,igrad_end)
689 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
690 c do not parallelize this part.
692 c do i=igrad_start,igrad_end
693 c do j=jgrad_start(i),jgrad_end(i)
695 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
700 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
704 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
708 write (iout,*) "gradbufc after summing"
710 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
717 write (iout,*) "gradbufc"
719 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
725 gradbufc_sum(j,i)=gradbufc(j,i)
730 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
734 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
739 c gradbufc(k,i)=0.0d0
743 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
748 write (iout,*) "gradbufc after summing"
750 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
758 gradbufc(k,nres)=0.0d0
763 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
764 & wel_loc*gel_loc(j,i)+
765 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
766 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
767 & wel_loc*gel_loc_long(j,i)+
768 & wcorr*gradcorr_long(j,i)+
769 & wcorr5*gradcorr5_long(j,i)+
770 & wcorr6*gradcorr6_long(j,i)+
771 & wturn6*gcorr6_turn_long(j,i))+
773 & wcorr*gradcorr(j,i)+
774 & wturn3*gcorr3_turn(j,i)+
775 & wturn4*gcorr4_turn(j,i)+
776 & wcorr5*gradcorr5(j,i)+
777 & wcorr6*gradcorr6(j,i)+
778 & wturn6*gcorr6_turn(j,i)+
779 & wsccor*gsccorc(j,i)
780 & +wscloc*gscloc(j,i)
782 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
783 & wel_loc*gel_loc(j,i)+
784 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
785 & welec*gelc_long(j,i)+
786 & wel_loc*gel_loc_long(j,i)+
787 & wcorr*gcorr_long(j,i)+
788 & wcorr5*gradcorr5_long(j,i)+
789 & wcorr6*gradcorr6_long(j,i)+
790 & wturn6*gcorr6_turn_long(j,i))+
792 & wcorr*gradcorr(j,i)+
793 & wturn3*gcorr3_turn(j,i)+
794 & wturn4*gcorr4_turn(j,i)+
795 & wcorr5*gradcorr5(j,i)+
796 & wcorr6*gradcorr6(j,i)+
797 & wturn6*gcorr6_turn(j,i)+
798 & wsccor*gsccorc(j,i)
799 & +wscloc*gscloc(j,i)
802 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
803 & wscp*gradx_scp(j,i)+
805 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
806 & wsccor*gsccorx(j,i)
807 & +wscloc*gsclocx(j,i)
809 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
811 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
812 & wsccor*gsccorx(j,i)
813 & +wscloc*gsclocx(j,i)
817 if (constr_homology.gt.0) then
820 gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i)
821 gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i)
826 write (iout,*) "gloc before adding corr"
828 write (iout,*) i,gloc(i,icg)
832 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
833 & +wcorr5*g_corr5_loc(i)
834 & +wcorr6*g_corr6_loc(i)
835 & +wturn4*gel_loc_turn4(i)
836 & +wturn3*gel_loc_turn3(i)
837 & +wturn6*gel_loc_turn6(i)
838 & +wel_loc*gel_loc_loc(i)
841 write (iout,*) "gloc after adding corr"
843 write (iout,*) i,gloc(i,icg)
847 if (nfgtasks.gt.1) then
850 gradbufc(j,i)=gradc(j,i,icg)
851 gradbufx(j,i)=gradx(j,i,icg)
855 glocbuf(i)=gloc(i,icg)
858 write (iout,*) "gloc_sc before reduce"
861 write (iout,*) i,j,gloc_sc(j,i,icg)
867 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
871 call MPI_Barrier(FG_COMM,IERR)
872 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
874 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
875 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
876 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
877 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
878 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
879 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
880 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
881 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
882 time_reduce=time_reduce+MPI_Wtime()-time00
884 write (iout,*) "gloc_sc after reduce"
887 write (iout,*) i,j,gloc_sc(j,i,icg)
892 write (iout,*) "gloc after reduce"
894 write (iout,*) i,gloc(i,icg)
899 if (gnorm_check) then
901 c Compute the maximum elements of the gradient
911 gcorr3_turn_max=0.0d0
912 gcorr4_turn_max=0.0d0
915 gcorr6_turn_max=0.0d0
925 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
926 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
928 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
929 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
931 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
932 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
933 & gvdwc_scp_max=gvdwc_scp_norm
934 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
935 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
936 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
937 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
938 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
939 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
940 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
941 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
942 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
943 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
944 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
945 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
946 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
948 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
949 & gcorr3_turn_max=gcorr3_turn_norm
950 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
952 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
953 & gcorr4_turn_max=gcorr4_turn_norm
954 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
955 if (gradcorr5_norm.gt.gradcorr5_max)
956 & gradcorr5_max=gradcorr5_norm
957 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
958 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
959 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
961 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
962 & gcorr6_turn_max=gcorr6_turn_norm
963 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
964 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
965 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
966 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
967 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
968 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
970 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
971 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
973 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
974 if (gradx_scp_norm.gt.gradx_scp_max)
975 & gradx_scp_max=gradx_scp_norm
976 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
977 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
978 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
979 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
980 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
981 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
982 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
983 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
987 open(istat,file=statname,position="append")
989 open(istat,file=statname,access="append")
991 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
992 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
993 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
994 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
995 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
996 & gsccorx_max,gsclocx_max
998 if (gvdwc_max.gt.1.0d4) then
999 write (iout,*) "gvdwc gvdwx gradb gradbx"
1001 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
1002 & gradb(j,i),gradbx(j,i),j=1,3)
1004 call pdbout(0.0d0,'cipiszcze',iout)
1010 write (iout,*) "gradc gradx gloc"
1012 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1013 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1018 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1020 time_sumgradient=time_sumgradient+tcpu()-time01
1025 c-------------------------------------------------------------------------------
1026 subroutine rescale_weights(t_bath)
1027 implicit real*8 (a-h,o-z)
1028 include 'DIMENSIONS'
1029 include 'COMMON.IOUNITS'
1030 include 'COMMON.FFIELD'
1031 include 'COMMON.SBRIDGE'
1032 double precision kfac /2.4d0/
1033 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1035 c facT=2*temp0/(t_bath+temp0)
1036 if (rescale_mode.eq.0) then
1042 else if (rescale_mode.eq.1) then
1043 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1044 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1045 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1046 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1047 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1048 else if (rescale_mode.eq.2) then
1054 facT=licznik/dlog(dexp(x)+dexp(-x))
1055 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1056 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1057 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1058 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1060 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1061 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1063 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1067 welec=weights(3)*fact
1068 wcorr=weights(4)*fact3
1069 wcorr5=weights(5)*fact4
1070 wcorr6=weights(6)*fact5
1071 wel_loc=weights(7)*fact2
1072 wturn3=weights(8)*fact2
1073 wturn4=weights(9)*fact3
1074 wturn6=weights(10)*fact5
1075 wtor=weights(13)*fact
1076 wtor_d=weights(14)*fact2
1077 wsccor=weights(21)*fact
1080 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1084 C------------------------------------------------------------------------
1085 subroutine enerprint(energia)
1086 implicit real*8 (a-h,o-z)
1087 include 'DIMENSIONS'
1088 include 'COMMON.IOUNITS'
1089 include 'COMMON.FFIELD'
1090 include 'COMMON.SBRIDGE'
1092 double precision energia(0:n_ene)
1095 evdw=energia(22)+wsct*energia(23)
1101 evdw2=energia(2)+energia(18)
1113 eello_turn3=energia(8)
1114 eello_turn4=energia(9)
1115 eello_turn6=energia(10)
1121 edihcnstr=energia(19)
1125 ehomology_constr=energia(24)
1127 edfadis = energia(25)
1128 edfator = energia(26)
1129 edfanei = energia(27)
1130 edfabet = energia(28)
1133 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1134 & estr,wbond,ebe,wang,
1135 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1137 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1138 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1139 & edihcnstr,ehomology_constr, ebr*nss,
1140 & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
1141 & edfabet,wdfa_beta,etot
1142 10 format (/'Virtual-chain energies:'//
1143 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1144 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1145 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1146 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1147 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1148 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1149 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1150 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1151 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1152 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1153 & ' (SS bridges & dist. cnstr.)'/
1154 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1155 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1156 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1157 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1158 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1159 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1160 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1161 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1162 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1163 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1164 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1165 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1166 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
1167 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
1168 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
1169 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
1170 & 'ETOT= ',1pE16.6,' (total)')
1172 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1173 & estr,wbond,ebe,wang,
1174 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1176 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1177 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1178 & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator,
1179 & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta,
1181 10 format (/'Virtual-chain energies:'//
1182 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1183 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1184 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1185 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1186 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1187 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1188 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1189 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1190 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1191 & ' (SS bridges & dist. cnstr.)'/
1192 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1193 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1194 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1195 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1196 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1197 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1198 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1199 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1200 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1201 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1202 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1203 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1204 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
1205 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
1206 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
1207 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
1208 & 'ETOT= ',1pE16.6,' (total)')
1212 C-----------------------------------------------------------------------
1213 subroutine elj(evdw,evdw_p,evdw_m)
1215 C This subroutine calculates the interaction energy of nonbonded side chains
1216 C assuming the LJ potential of interaction.
1218 implicit real*8 (a-h,o-z)
1219 include 'DIMENSIONS'
1220 parameter (accur=1.0d-10)
1221 include 'COMMON.GEO'
1222 include 'COMMON.VAR'
1223 include 'COMMON.LOCAL'
1224 include 'COMMON.CHAIN'
1225 include 'COMMON.DERIV'
1226 include 'COMMON.INTERACT'
1227 include 'COMMON.TORSION'
1228 include 'COMMON.SBRIDGE'
1229 include 'COMMON.NAMES'
1230 include 'COMMON.IOUNITS'
1231 include 'COMMON.CONTACTS'
1233 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1235 do i=iatsc_s,iatsc_e
1244 C Calculate SC interaction energy.
1246 do iint=1,nint_gr(i)
1247 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1248 cd & 'iend=',iend(i,iint)
1249 do j=istart(i,iint),iend(i,iint)
1254 C Change 12/1/95 to calculate four-body interactions
1255 rij=xj*xj+yj*yj+zj*zj
1257 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1258 eps0ij=eps(itypi,itypj)
1260 e1=fac*fac*aa(itypi,itypj)
1261 e2=fac*bb(itypi,itypj)
1263 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1264 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1265 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1266 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1267 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1268 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1270 if (bb(itypi,itypj).gt.0) then
1271 evdw_p=evdw_p+evdwij
1273 evdw_m=evdw_m+evdwij
1279 C Calculate the components of the gradient in DC and X
1281 fac=-rrij*(e1+evdwij)
1286 if (bb(itypi,itypj).gt.0.0d0) then
1288 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1289 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1290 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1291 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1295 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1296 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1297 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1298 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1303 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1304 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1305 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1306 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1311 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1315 C 12/1/95, revised on 5/20/97
1317 C Calculate the contact function. The ith column of the array JCONT will
1318 C contain the numbers of atoms that make contacts with the atom I (of numbers
1319 C greater than I). The arrays FACONT and GACONT will contain the values of
1320 C the contact function and its derivative.
1322 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1323 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1324 C Uncomment next line, if the correlation interactions are contact function only
1325 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1327 sigij=sigma(itypi,itypj)
1328 r0ij=rs0(itypi,itypj)
1330 C Check whether the SC's are not too far to make a contact.
1333 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1334 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1336 if (fcont.gt.0.0D0) then
1337 C If the SC-SC distance if close to sigma, apply spline.
1338 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1339 cAdam & fcont1,fprimcont1)
1340 cAdam fcont1=1.0d0-fcont1
1341 cAdam if (fcont1.gt.0.0d0) then
1342 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1343 cAdam fcont=fcont*fcont1
1345 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1346 cga eps0ij=1.0d0/dsqrt(eps0ij)
1348 cga gg(k)=gg(k)*eps0ij
1350 cga eps0ij=-evdwij*eps0ij
1351 C Uncomment for AL's type of SC correlation interactions.
1352 cadam eps0ij=-evdwij
1353 num_conti=num_conti+1
1354 jcont(num_conti,i)=j
1355 facont(num_conti,i)=fcont*eps0ij
1356 fprimcont=eps0ij*fprimcont/rij
1358 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1359 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1360 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1361 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1362 gacont(1,num_conti,i)=-fprimcont*xj
1363 gacont(2,num_conti,i)=-fprimcont*yj
1364 gacont(3,num_conti,i)=-fprimcont*zj
1365 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1366 cd write (iout,'(2i3,3f10.5)')
1367 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1373 num_cont(i)=num_conti
1377 gvdwc(j,i)=expon*gvdwc(j,i)
1378 gvdwx(j,i)=expon*gvdwx(j,i)
1381 C******************************************************************************
1385 C To save time, the factor of EXPON has been extracted from ALL components
1386 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1389 C******************************************************************************
1392 C-----------------------------------------------------------------------------
1393 subroutine eljk(evdw,evdw_p,evdw_m)
1395 C This subroutine calculates the interaction energy of nonbonded side chains
1396 C assuming the LJK potential of interaction.
1398 implicit real*8 (a-h,o-z)
1399 include 'DIMENSIONS'
1400 include 'COMMON.GEO'
1401 include 'COMMON.VAR'
1402 include 'COMMON.LOCAL'
1403 include 'COMMON.CHAIN'
1404 include 'COMMON.DERIV'
1405 include 'COMMON.INTERACT'
1406 include 'COMMON.IOUNITS'
1407 include 'COMMON.NAMES'
1410 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1412 do i=iatsc_s,iatsc_e
1419 C Calculate SC interaction energy.
1421 do iint=1,nint_gr(i)
1422 do j=istart(i,iint),iend(i,iint)
1427 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1428 fac_augm=rrij**expon
1429 e_augm=augm(itypi,itypj)*fac_augm
1430 r_inv_ij=dsqrt(rrij)
1432 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1433 fac=r_shift_inv**expon
1434 e1=fac*fac*aa(itypi,itypj)
1435 e2=fac*bb(itypi,itypj)
1437 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1438 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1439 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1440 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1441 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1442 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1443 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1445 if (bb(itypi,itypj).gt.0) then
1446 evdw_p=evdw_p+evdwij
1448 evdw_m=evdw_m+evdwij
1454 C Calculate the components of the gradient in DC and X
1456 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1461 if (bb(itypi,itypj).gt.0.0d0) then
1463 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1464 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1465 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1466 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1470 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1471 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1472 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1473 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1478 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1479 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1480 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1481 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1486 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1494 gvdwc(j,i)=expon*gvdwc(j,i)
1495 gvdwx(j,i)=expon*gvdwx(j,i)
1500 C-----------------------------------------------------------------------------
1501 subroutine ebp(evdw,evdw_p,evdw_m)
1503 C This subroutine calculates the interaction energy of nonbonded side chains
1504 C assuming the Berne-Pechukas potential of interaction.
1506 implicit real*8 (a-h,o-z)
1507 include 'DIMENSIONS'
1508 include 'COMMON.GEO'
1509 include 'COMMON.VAR'
1510 include 'COMMON.LOCAL'
1511 include 'COMMON.CHAIN'
1512 include 'COMMON.DERIV'
1513 include 'COMMON.NAMES'
1514 include 'COMMON.INTERACT'
1515 include 'COMMON.IOUNITS'
1516 include 'COMMON.CALC'
1517 common /srutu/ icall
1518 c double precision rrsave(maxdim)
1521 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1523 c if (icall.eq.0) then
1529 do i=iatsc_s,iatsc_e
1535 dxi=dc_norm(1,nres+i)
1536 dyi=dc_norm(2,nres+i)
1537 dzi=dc_norm(3,nres+i)
1538 c dsci_inv=dsc_inv(itypi)
1539 dsci_inv=vbld_inv(i+nres)
1541 C Calculate SC interaction energy.
1543 do iint=1,nint_gr(i)
1544 do j=istart(i,iint),iend(i,iint)
1547 c dscj_inv=dsc_inv(itypj)
1548 dscj_inv=vbld_inv(j+nres)
1549 chi1=chi(itypi,itypj)
1550 chi2=chi(itypj,itypi)
1557 alf12=0.5D0*(alf1+alf2)
1558 C For diagnostics only!!!
1571 dxj=dc_norm(1,nres+j)
1572 dyj=dc_norm(2,nres+j)
1573 dzj=dc_norm(3,nres+j)
1574 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1575 cd if (icall.eq.0) then
1581 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1583 C Calculate whole angle-dependent part of epsilon and contributions
1584 C to its derivatives
1585 fac=(rrij*sigsq)**expon2
1586 e1=fac*fac*aa(itypi,itypj)
1587 e2=fac*bb(itypi,itypj)
1588 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1589 eps2der=evdwij*eps3rt
1590 eps3der=evdwij*eps2rt
1591 evdwij=evdwij*eps2rt*eps3rt
1593 if (bb(itypi,itypj).gt.0) then
1594 evdw_p=evdw_p+evdwij
1596 evdw_m=evdw_m+evdwij
1602 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1603 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1604 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1605 cd & restyp(itypi),i,restyp(itypj),j,
1606 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1607 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1608 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1611 C Calculate gradient components.
1612 e1=e1*eps1*eps2rt**2*eps3rt**2
1613 fac=-expon*(e1+evdwij)
1616 C Calculate radial part of the gradient
1620 C Calculate the angular part of the gradient and sum add the contributions
1621 C to the appropriate components of the Cartesian gradient.
1623 if (bb(itypi,itypj).gt.0) then
1637 C-----------------------------------------------------------------------------
1638 subroutine egb(evdw,evdw_p,evdw_m)
1640 C This subroutine calculates the interaction energy of nonbonded side chains
1641 C assuming the Gay-Berne potential of interaction.
1643 implicit real*8 (a-h,o-z)
1644 include 'DIMENSIONS'
1645 include 'COMMON.GEO'
1646 include 'COMMON.VAR'
1647 include 'COMMON.LOCAL'
1648 include 'COMMON.CHAIN'
1649 include 'COMMON.DERIV'
1650 include 'COMMON.NAMES'
1651 include 'COMMON.INTERACT'
1652 include 'COMMON.IOUNITS'
1653 include 'COMMON.CALC'
1654 include 'COMMON.CONTROL'
1655 include 'COMMON.SBRIDGE'
1658 ccccc energy_dec=.false.
1659 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1664 c if (icall.eq.0) lprn=.false.
1666 do i=iatsc_s,iatsc_e
1672 dxi=dc_norm(1,nres+i)
1673 dyi=dc_norm(2,nres+i)
1674 dzi=dc_norm(3,nres+i)
1675 c dsci_inv=dsc_inv(itypi)
1676 dsci_inv=vbld_inv(i+nres)
1677 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1678 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1680 C Calculate SC interaction energy.
1682 do iint=1,nint_gr(i)
1683 do j=istart(i,iint),iend(i,iint)
1684 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1685 call dyn_ssbond_ene(i,j,evdwij)
1687 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1688 & 'evdw',i,j,evdwij,' ss'
1692 c dscj_inv=dsc_inv(itypj)
1693 dscj_inv=vbld_inv(j+nres)
1694 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1695 c & 1.0d0/vbld(j+nres)
1696 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1697 sig0ij=sigma(itypi,itypj)
1698 chi1=chi(itypi,itypj)
1699 chi2=chi(itypj,itypi)
1706 alf12=0.5D0*(alf1+alf2)
1707 C For diagnostics only!!!
1720 dxj=dc_norm(1,nres+j)
1721 dyj=dc_norm(2,nres+j)
1722 dzj=dc_norm(3,nres+j)
1723 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1724 c write (iout,*) "j",j," dc_norm",
1725 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1726 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1728 C Calculate angle-dependent terms of energy and contributions to their
1732 sig=sig0ij*dsqrt(sigsq)
1733 rij_shift=1.0D0/rij-sig+sig0ij
1734 c for diagnostics; uncomment
1735 c rij_shift=1.2*sig0ij
1736 C I hate to put IF's in the loops, but here don't have another choice!!!!
1737 if (rij_shift.le.0.0D0) then
1739 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1740 cd & restyp(itypi),i,restyp(itypj),j,
1741 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1745 c---------------------------------------------------------------
1746 rij_shift=1.0D0/rij_shift
1747 fac=rij_shift**expon
1748 e1=fac*fac*aa(itypi,itypj)
1749 e2=fac*bb(itypi,itypj)
1750 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1751 eps2der=evdwij*eps3rt
1752 eps3der=evdwij*eps2rt
1753 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1754 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1755 evdwij=evdwij*eps2rt*eps3rt
1757 if (bb(itypi,itypj).gt.0) then
1758 evdw_p=evdw_p+evdwij
1760 evdw_m=evdw_m+evdwij
1766 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1767 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1768 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1769 & restyp(itypi),i,restyp(itypj),j,
1770 & epsi,sigm,chi1,chi2,chip1,chip2,
1771 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1772 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1776 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1779 C Calculate gradient components.
1780 e1=e1*eps1*eps2rt**2*eps3rt**2
1781 fac=-expon*(e1+evdwij)*rij_shift
1785 C Calculate the radial part of the gradient
1789 C Calculate angular part of the gradient.
1791 if (bb(itypi,itypj).gt.0) then
1803 c write (iout,*) "Number of loop steps in EGB:",ind
1804 cccc energy_dec=.false.
1807 C-----------------------------------------------------------------------------
1808 subroutine egbv(evdw,evdw_p,evdw_m)
1810 C This subroutine calculates the interaction energy of nonbonded side chains
1811 C assuming the Gay-Berne-Vorobjev potential of interaction.
1813 implicit real*8 (a-h,o-z)
1814 include 'DIMENSIONS'
1815 include 'COMMON.GEO'
1816 include 'COMMON.VAR'
1817 include 'COMMON.LOCAL'
1818 include 'COMMON.CHAIN'
1819 include 'COMMON.DERIV'
1820 include 'COMMON.NAMES'
1821 include 'COMMON.INTERACT'
1822 include 'COMMON.IOUNITS'
1823 include 'COMMON.CALC'
1824 common /srutu/ icall
1827 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1830 c if (icall.eq.0) lprn=.true.
1832 do i=iatsc_s,iatsc_e
1838 dxi=dc_norm(1,nres+i)
1839 dyi=dc_norm(2,nres+i)
1840 dzi=dc_norm(3,nres+i)
1841 c dsci_inv=dsc_inv(itypi)
1842 dsci_inv=vbld_inv(i+nres)
1844 C Calculate SC interaction energy.
1846 do iint=1,nint_gr(i)
1847 do j=istart(i,iint),iend(i,iint)
1850 c dscj_inv=dsc_inv(itypj)
1851 dscj_inv=vbld_inv(j+nres)
1852 sig0ij=sigma(itypi,itypj)
1853 r0ij=r0(itypi,itypj)
1854 chi1=chi(itypi,itypj)
1855 chi2=chi(itypj,itypi)
1862 alf12=0.5D0*(alf1+alf2)
1863 C For diagnostics only!!!
1876 dxj=dc_norm(1,nres+j)
1877 dyj=dc_norm(2,nres+j)
1878 dzj=dc_norm(3,nres+j)
1879 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1881 C Calculate angle-dependent terms of energy and contributions to their
1885 sig=sig0ij*dsqrt(sigsq)
1886 rij_shift=1.0D0/rij-sig+r0ij
1887 C I hate to put IF's in the loops, but here don't have another choice!!!!
1888 if (rij_shift.le.0.0D0) then
1893 c---------------------------------------------------------------
1894 rij_shift=1.0D0/rij_shift
1895 fac=rij_shift**expon
1896 e1=fac*fac*aa(itypi,itypj)
1897 e2=fac*bb(itypi,itypj)
1898 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1899 eps2der=evdwij*eps3rt
1900 eps3der=evdwij*eps2rt
1901 fac_augm=rrij**expon
1902 e_augm=augm(itypi,itypj)*fac_augm
1903 evdwij=evdwij*eps2rt*eps3rt
1905 if (bb(itypi,itypj).gt.0) then
1906 evdw_p=evdw_p+evdwij+e_augm
1908 evdw_m=evdw_m+evdwij+e_augm
1911 evdw=evdw+evdwij+e_augm
1914 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1915 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1916 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1917 & restyp(itypi),i,restyp(itypj),j,
1918 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1919 & chi1,chi2,chip1,chip2,
1920 & eps1,eps2rt**2,eps3rt**2,
1921 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1924 C Calculate gradient components.
1925 e1=e1*eps1*eps2rt**2*eps3rt**2
1926 fac=-expon*(e1+evdwij)*rij_shift
1928 fac=rij*fac-2*expon*rrij*e_augm
1929 C Calculate the radial part of the gradient
1933 C Calculate angular part of the gradient.
1935 if (bb(itypi,itypj).gt.0) then
1947 C-----------------------------------------------------------------------------
1948 subroutine sc_angular
1949 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1950 C om12. Called by ebp, egb, and egbv.
1952 include 'COMMON.CALC'
1953 include 'COMMON.IOUNITS'
1957 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1958 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1959 om12=dxi*dxj+dyi*dyj+dzi*dzj
1961 C Calculate eps1(om12) and its derivative in om12
1962 faceps1=1.0D0-om12*chiom12
1963 faceps1_inv=1.0D0/faceps1
1964 eps1=dsqrt(faceps1_inv)
1965 C Following variable is eps1*deps1/dom12
1966 eps1_om12=faceps1_inv*chiom12
1971 c write (iout,*) "om12",om12," eps1",eps1
1972 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1977 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1978 sigsq=1.0D0-facsig*faceps1_inv
1979 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1980 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1981 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1987 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1988 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1990 C Calculate eps2 and its derivatives in om1, om2, and om12.
1993 chipom12=chip12*om12
1994 facp=1.0D0-om12*chipom12
1996 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1997 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1998 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1999 C Following variable is the square root of eps2
2000 eps2rt=1.0D0-facp1*facp_inv
2001 C Following three variables are the derivatives of the square root of eps
2002 C in om1, om2, and om12.
2003 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2004 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2005 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2006 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2007 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2008 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2009 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2010 c & " eps2rt_om12",eps2rt_om12
2011 C Calculate whole angle-dependent part of epsilon and contributions
2012 C to its derivatives
2016 C----------------------------------------------------------------------------
2017 subroutine sc_grad_T
2018 implicit real*8 (a-h,o-z)
2019 include 'DIMENSIONS'
2020 include 'COMMON.CHAIN'
2021 include 'COMMON.DERIV'
2022 include 'COMMON.CALC'
2023 include 'COMMON.IOUNITS'
2024 double precision dcosom1(3),dcosom2(3)
2025 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2026 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2027 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2028 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2032 c eom12=evdwij*eps1_om12
2034 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2035 c & " sigder",sigder
2036 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2037 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2039 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2040 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2043 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2045 c write (iout,*) "gg",(gg(k),k=1,3)
2047 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2048 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2049 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2050 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2051 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2052 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2053 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2054 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2055 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2056 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2059 C Calculate the components of the gradient in DC and X
2063 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2067 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2068 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2073 C----------------------------------------------------------------------------
2075 implicit real*8 (a-h,o-z)
2076 include 'DIMENSIONS'
2077 include 'COMMON.CHAIN'
2078 include 'COMMON.DERIV'
2079 include 'COMMON.CALC'
2080 include 'COMMON.IOUNITS'
2081 double precision dcosom1(3),dcosom2(3)
2082 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2083 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2084 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2085 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2089 c eom12=evdwij*eps1_om12
2091 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2092 c & " sigder",sigder
2093 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2094 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2096 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2097 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2100 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2102 c write (iout,*) "gg",(gg(k),k=1,3)
2104 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2105 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2106 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2107 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2108 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2109 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2110 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2111 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2112 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2113 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2116 C Calculate the components of the gradient in DC and X
2120 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2124 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2125 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2129 C-----------------------------------------------------------------------
2130 subroutine e_softsphere(evdw)
2132 C This subroutine calculates the interaction energy of nonbonded side chains
2133 C assuming the LJ potential of interaction.
2135 implicit real*8 (a-h,o-z)
2136 include 'DIMENSIONS'
2137 parameter (accur=1.0d-10)
2138 include 'COMMON.GEO'
2139 include 'COMMON.VAR'
2140 include 'COMMON.LOCAL'
2141 include 'COMMON.CHAIN'
2142 include 'COMMON.DERIV'
2143 include 'COMMON.INTERACT'
2144 include 'COMMON.TORSION'
2145 include 'COMMON.SBRIDGE'
2146 include 'COMMON.NAMES'
2147 include 'COMMON.IOUNITS'
2148 include 'COMMON.CONTACTS'
2150 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2152 do i=iatsc_s,iatsc_e
2159 C Calculate SC interaction energy.
2161 do iint=1,nint_gr(i)
2162 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2163 cd & 'iend=',iend(i,iint)
2164 do j=istart(i,iint),iend(i,iint)
2169 rij=xj*xj+yj*yj+zj*zj
2170 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2171 r0ij=r0(itypi,itypj)
2173 c print *,i,j,r0ij,dsqrt(rij)
2174 if (rij.lt.r0ijsq) then
2175 evdwij=0.25d0*(rij-r0ijsq)**2
2183 C Calculate the components of the gradient in DC and X
2189 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2190 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2191 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2192 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2196 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2204 C--------------------------------------------------------------------------
2205 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2208 C Soft-sphere potential of p-p interaction
2210 implicit real*8 (a-h,o-z)
2211 include 'DIMENSIONS'
2212 include 'COMMON.CONTROL'
2213 include 'COMMON.IOUNITS'
2214 include 'COMMON.GEO'
2215 include 'COMMON.VAR'
2216 include 'COMMON.LOCAL'
2217 include 'COMMON.CHAIN'
2218 include 'COMMON.DERIV'
2219 include 'COMMON.INTERACT'
2220 include 'COMMON.CONTACTS'
2221 include 'COMMON.TORSION'
2222 include 'COMMON.VECTORS'
2223 include 'COMMON.FFIELD'
2225 cd write(iout,*) 'In EELEC_soft_sphere'
2232 do i=iatel_s,iatel_e
2236 xmedi=c(1,i)+0.5d0*dxi
2237 ymedi=c(2,i)+0.5d0*dyi
2238 zmedi=c(3,i)+0.5d0*dzi
2240 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2241 do j=ielstart(i),ielend(i)
2245 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2246 r0ij=rpp(iteli,itelj)
2251 xj=c(1,j)+0.5D0*dxj-xmedi
2252 yj=c(2,j)+0.5D0*dyj-ymedi
2253 zj=c(3,j)+0.5D0*dzj-zmedi
2254 rij=xj*xj+yj*yj+zj*zj
2255 if (rij.lt.r0ijsq) then
2256 evdw1ij=0.25d0*(rij-r0ijsq)**2
2264 C Calculate contributions to the Cartesian gradient.
2270 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2271 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2274 * Loop over residues i+1 thru j-1.
2278 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2283 cgrad do i=nnt,nct-1
2285 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2287 cgrad do j=i+1,nct-1
2289 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2295 c------------------------------------------------------------------------------
2296 subroutine vec_and_deriv
2297 implicit real*8 (a-h,o-z)
2298 include 'DIMENSIONS'
2302 include 'COMMON.IOUNITS'
2303 include 'COMMON.GEO'
2304 include 'COMMON.VAR'
2305 include 'COMMON.LOCAL'
2306 include 'COMMON.CHAIN'
2307 include 'COMMON.VECTORS'
2308 include 'COMMON.SETUP'
2309 include 'COMMON.TIME1'
2310 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2311 C Compute the local reference systems. For reference system (i), the
2312 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2313 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2315 do i=ivec_start,ivec_end
2319 if (i.eq.nres-1) then
2320 C Case of the last full residue
2321 C Compute the Z-axis
2322 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2323 costh=dcos(pi-theta(nres))
2324 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2328 C Compute the derivatives of uz
2330 uzder(2,1,1)=-dc_norm(3,i-1)
2331 uzder(3,1,1)= dc_norm(2,i-1)
2332 uzder(1,2,1)= dc_norm(3,i-1)
2334 uzder(3,2,1)=-dc_norm(1,i-1)
2335 uzder(1,3,1)=-dc_norm(2,i-1)
2336 uzder(2,3,1)= dc_norm(1,i-1)
2339 uzder(2,1,2)= dc_norm(3,i)
2340 uzder(3,1,2)=-dc_norm(2,i)
2341 uzder(1,2,2)=-dc_norm(3,i)
2343 uzder(3,2,2)= dc_norm(1,i)
2344 uzder(1,3,2)= dc_norm(2,i)
2345 uzder(2,3,2)=-dc_norm(1,i)
2347 C Compute the Y-axis
2350 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2352 C Compute the derivatives of uy
2355 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2356 & -dc_norm(k,i)*dc_norm(j,i-1)
2357 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2359 uyder(j,j,1)=uyder(j,j,1)-costh
2360 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2365 uygrad(l,k,j,i)=uyder(l,k,j)
2366 uzgrad(l,k,j,i)=uzder(l,k,j)
2370 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2371 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2372 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2373 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2376 C Compute the Z-axis
2377 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2378 costh=dcos(pi-theta(i+2))
2379 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2383 C Compute the derivatives of uz
2385 uzder(2,1,1)=-dc_norm(3,i+1)
2386 uzder(3,1,1)= dc_norm(2,i+1)
2387 uzder(1,2,1)= dc_norm(3,i+1)
2389 uzder(3,2,1)=-dc_norm(1,i+1)
2390 uzder(1,3,1)=-dc_norm(2,i+1)
2391 uzder(2,3,1)= dc_norm(1,i+1)
2394 uzder(2,1,2)= dc_norm(3,i)
2395 uzder(3,1,2)=-dc_norm(2,i)
2396 uzder(1,2,2)=-dc_norm(3,i)
2398 uzder(3,2,2)= dc_norm(1,i)
2399 uzder(1,3,2)= dc_norm(2,i)
2400 uzder(2,3,2)=-dc_norm(1,i)
2402 C Compute the Y-axis
2405 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2407 C Compute the derivatives of uy
2410 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2411 & -dc_norm(k,i)*dc_norm(j,i+1)
2412 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2414 uyder(j,j,1)=uyder(j,j,1)-costh
2415 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2420 uygrad(l,k,j,i)=uyder(l,k,j)
2421 uzgrad(l,k,j,i)=uzder(l,k,j)
2425 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2426 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2427 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2428 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2432 vbld_inv_temp(1)=vbld_inv(i+1)
2433 if (i.lt.nres-1) then
2434 vbld_inv_temp(2)=vbld_inv(i+2)
2436 vbld_inv_temp(2)=vbld_inv(i)
2441 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2442 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2447 #if defined(PARVEC) && defined(MPI)
2448 if (nfgtasks1.gt.1) then
2450 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2451 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2452 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2453 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2454 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2456 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2457 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2459 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2460 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2461 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2462 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2463 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2464 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2465 time_gather=time_gather+MPI_Wtime()-time00
2467 c if (fg_rank.eq.0) then
2468 c write (iout,*) "Arrays UY and UZ"
2470 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2477 C-----------------------------------------------------------------------------
2478 subroutine check_vecgrad
2479 implicit real*8 (a-h,o-z)
2480 include 'DIMENSIONS'
2481 include 'COMMON.IOUNITS'
2482 include 'COMMON.GEO'
2483 include 'COMMON.VAR'
2484 include 'COMMON.LOCAL'
2485 include 'COMMON.CHAIN'
2486 include 'COMMON.VECTORS'
2487 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2488 dimension uyt(3,maxres),uzt(3,maxres)
2489 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2490 double precision delta /1.0d-7/
2493 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2494 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2495 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2496 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2497 cd & (dc_norm(if90,i),if90=1,3)
2498 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2499 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2500 cd write(iout,'(a)')
2506 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2507 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2520 cd write (iout,*) 'i=',i
2522 erij(k)=dc_norm(k,i)
2526 dc_norm(k,i)=erij(k)
2528 dc_norm(j,i)=dc_norm(j,i)+delta
2529 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2531 c dc_norm(k,i)=dc_norm(k,i)/fac
2533 c write (iout,*) (dc_norm(k,i),k=1,3)
2534 c write (iout,*) (erij(k),k=1,3)
2537 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2538 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2539 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2540 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2542 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2543 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2544 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2547 dc_norm(k,i)=erij(k)
2550 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2551 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2552 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2553 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2554 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2555 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2556 cd write (iout,'(a)')
2561 C--------------------------------------------------------------------------
2562 subroutine set_matrices
2563 implicit real*8 (a-h,o-z)
2564 include 'DIMENSIONS'
2567 include "COMMON.SETUP"
2569 integer status(MPI_STATUS_SIZE)
2571 include 'COMMON.IOUNITS'
2572 include 'COMMON.GEO'
2573 include 'COMMON.VAR'
2574 include 'COMMON.LOCAL'
2575 include 'COMMON.CHAIN'
2576 include 'COMMON.DERIV'
2577 include 'COMMON.INTERACT'
2578 include 'COMMON.CONTACTS'
2579 include 'COMMON.TORSION'
2580 include 'COMMON.VECTORS'
2581 include 'COMMON.FFIELD'
2582 double precision auxvec(2),auxmat(2,2)
2584 C Compute the virtual-bond-torsional-angle dependent quantities needed
2585 C to calculate the el-loc multibody terms of various order.
2588 do i=ivec_start+2,ivec_end+2
2592 if (i .lt. nres+1) then
2629 if (i .gt. 3 .and. i .lt. nres+1) then
2630 obrot_der(1,i-2)=-sin1
2631 obrot_der(2,i-2)= cos1
2632 Ugder(1,1,i-2)= sin1
2633 Ugder(1,2,i-2)=-cos1
2634 Ugder(2,1,i-2)=-cos1
2635 Ugder(2,2,i-2)=-sin1
2638 obrot2_der(1,i-2)=-dwasin2
2639 obrot2_der(2,i-2)= dwacos2
2640 Ug2der(1,1,i-2)= dwasin2
2641 Ug2der(1,2,i-2)=-dwacos2
2642 Ug2der(2,1,i-2)=-dwacos2
2643 Ug2der(2,2,i-2)=-dwasin2
2645 obrot_der(1,i-2)=0.0d0
2646 obrot_der(2,i-2)=0.0d0
2647 Ugder(1,1,i-2)=0.0d0
2648 Ugder(1,2,i-2)=0.0d0
2649 Ugder(2,1,i-2)=0.0d0
2650 Ugder(2,2,i-2)=0.0d0
2651 obrot2_der(1,i-2)=0.0d0
2652 obrot2_der(2,i-2)=0.0d0
2653 Ug2der(1,1,i-2)=0.0d0
2654 Ug2der(1,2,i-2)=0.0d0
2655 Ug2der(2,1,i-2)=0.0d0
2656 Ug2der(2,2,i-2)=0.0d0
2658 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2659 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2660 iti = itortyp(itype(i-2))
2664 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2665 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2666 iti1 = itortyp(itype(i-1))
2670 cd write (iout,*) '*******i',i,' iti1',iti
2671 cd write (iout,*) 'b1',b1(:,iti)
2672 cd write (iout,*) 'b2',b2(:,iti)
2673 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2674 c if (i .gt. iatel_s+2) then
2675 if (i .gt. nnt+2) then
2676 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2677 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2678 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2680 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2681 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2682 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2683 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2684 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2695 DtUg2(l,k,i-2)=0.0d0
2699 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2700 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2702 muder(k,i-2)=Ub2der(k,i-2)
2704 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2705 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2706 iti1 = itortyp(itype(i-1))
2711 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2713 cd write (iout,*) 'mu ',mu(:,i-2)
2714 cd write (iout,*) 'mu1',mu1(:,i-2)
2715 cd write (iout,*) 'mu2',mu2(:,i-2)
2716 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2718 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2719 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2720 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2721 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2722 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2723 C Vectors and matrices dependent on a single virtual-bond dihedral.
2724 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2725 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2726 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2727 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2728 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2729 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2730 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2731 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2732 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2735 C Matrices dependent on two consecutive virtual-bond dihedrals.
2736 C The order of matrices is from left to right.
2737 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2739 c do i=max0(ivec_start,2),ivec_end
2741 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2742 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2743 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2744 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2745 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2746 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2747 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2748 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2751 #if defined(MPI) && defined(PARMAT)
2753 c if (fg_rank.eq.0) then
2754 write (iout,*) "Arrays UG and UGDER before GATHER"
2756 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2757 & ((ug(l,k,i),l=1,2),k=1,2),
2758 & ((ugder(l,k,i),l=1,2),k=1,2)
2760 write (iout,*) "Arrays UG2 and UG2DER"
2762 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2763 & ((ug2(l,k,i),l=1,2),k=1,2),
2764 & ((ug2der(l,k,i),l=1,2),k=1,2)
2766 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2768 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2769 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2770 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2772 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2774 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2775 & costab(i),sintab(i),costab2(i),sintab2(i)
2777 write (iout,*) "Array MUDER"
2779 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2783 if (nfgtasks.gt.1) then
2785 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2786 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2787 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2789 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2790 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2792 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2793 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2795 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2796 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2798 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2799 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2801 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2802 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2804 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2805 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2807 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2808 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2809 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2810 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2811 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2812 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2813 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2814 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2815 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2816 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2817 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2818 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2819 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2821 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2822 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2824 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2825 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2827 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2828 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2830 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2831 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2833 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2834 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2836 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2837 & ivec_count(fg_rank1),
2838 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2840 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2841 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2843 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2844 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2846 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2847 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2849 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2850 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2852 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2853 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2855 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2856 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2858 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2859 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2861 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2862 & ivec_count(fg_rank1),
2863 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2865 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2866 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2868 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2869 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2871 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2872 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2874 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2875 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2877 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2878 & ivec_count(fg_rank1),
2879 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2881 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2882 & ivec_count(fg_rank1),
2883 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2885 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2886 & ivec_count(fg_rank1),
2887 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2888 & MPI_MAT2,FG_COMM1,IERR)
2889 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2890 & ivec_count(fg_rank1),
2891 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2892 & MPI_MAT2,FG_COMM1,IERR)
2895 c Passes matrix info through the ring
2898 if (irecv.lt.0) irecv=nfgtasks1-1
2901 if (inext.ge.nfgtasks1) inext=0
2903 c write (iout,*) "isend",isend," irecv",irecv
2905 lensend=lentyp(isend)
2906 lenrecv=lentyp(irecv)
2907 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2908 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2909 c & MPI_ROTAT1(lensend),inext,2200+isend,
2910 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2911 c & iprev,2200+irecv,FG_COMM,status,IERR)
2912 c write (iout,*) "Gather ROTAT1"
2914 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2915 c & MPI_ROTAT2(lensend),inext,3300+isend,
2916 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2917 c & iprev,3300+irecv,FG_COMM,status,IERR)
2918 c write (iout,*) "Gather ROTAT2"
2920 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2921 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2922 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2923 & iprev,4400+irecv,FG_COMM,status,IERR)
2924 c write (iout,*) "Gather ROTAT_OLD"
2926 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2927 & MPI_PRECOMP11(lensend),inext,5500+isend,
2928 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2929 & iprev,5500+irecv,FG_COMM,status,IERR)
2930 c write (iout,*) "Gather PRECOMP11"
2932 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2933 & MPI_PRECOMP12(lensend),inext,6600+isend,
2934 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2935 & iprev,6600+irecv,FG_COMM,status,IERR)
2936 c write (iout,*) "Gather PRECOMP12"
2938 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2940 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2941 & MPI_ROTAT2(lensend),inext,7700+isend,
2942 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2943 & iprev,7700+irecv,FG_COMM,status,IERR)
2944 c write (iout,*) "Gather PRECOMP21"
2946 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2947 & MPI_PRECOMP22(lensend),inext,8800+isend,
2948 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2949 & iprev,8800+irecv,FG_COMM,status,IERR)
2950 c write (iout,*) "Gather PRECOMP22"
2952 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2953 & MPI_PRECOMP23(lensend),inext,9900+isend,
2954 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2955 & MPI_PRECOMP23(lenrecv),
2956 & iprev,9900+irecv,FG_COMM,status,IERR)
2957 c write (iout,*) "Gather PRECOMP23"
2962 if (irecv.lt.0) irecv=nfgtasks1-1
2965 time_gather=time_gather+MPI_Wtime()-time00
2968 c if (fg_rank.eq.0) then
2969 write (iout,*) "Arrays UG and UGDER"
2971 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2972 & ((ug(l,k,i),l=1,2),k=1,2),
2973 & ((ugder(l,k,i),l=1,2),k=1,2)
2975 write (iout,*) "Arrays UG2 and UG2DER"
2977 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2978 & ((ug2(l,k,i),l=1,2),k=1,2),
2979 & ((ug2der(l,k,i),l=1,2),k=1,2)
2981 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2983 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2984 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2985 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2987 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2989 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2990 & costab(i),sintab(i),costab2(i),sintab2(i)
2992 write (iout,*) "Array MUDER"
2994 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3000 cd iti = itortyp(itype(i))
3003 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3004 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3009 C--------------------------------------------------------------------------
3010 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3012 C This subroutine calculates the average interaction energy and its gradient
3013 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3014 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3015 C The potential depends both on the distance of peptide-group centers and on
3016 C the orientation of the CA-CA virtual bonds.
3018 implicit real*8 (a-h,o-z)
3022 include 'DIMENSIONS'
3023 include 'COMMON.CONTROL'
3024 include 'COMMON.SETUP'
3025 include 'COMMON.IOUNITS'
3026 include 'COMMON.GEO'
3027 include 'COMMON.VAR'
3028 include 'COMMON.LOCAL'
3029 include 'COMMON.CHAIN'
3030 include 'COMMON.DERIV'
3031 include 'COMMON.INTERACT'
3032 include 'COMMON.CONTACTS'
3033 include 'COMMON.TORSION'
3034 include 'COMMON.VECTORS'
3035 include 'COMMON.FFIELD'
3036 include 'COMMON.TIME1'
3037 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3038 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3039 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3040 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3041 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3042 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3044 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3046 double precision scal_el /1.0d0/
3048 double precision scal_el /0.5d0/
3051 C 13-go grudnia roku pamietnego...
3052 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3053 & 0.0d0,1.0d0,0.0d0,
3054 & 0.0d0,0.0d0,1.0d0/
3055 cd write(iout,*) 'In EELEC'
3057 cd write(iout,*) 'Type',i
3058 cd write(iout,*) 'B1',B1(:,i)
3059 cd write(iout,*) 'B2',B2(:,i)
3060 cd write(iout,*) 'CC',CC(:,:,i)
3061 cd write(iout,*) 'DD',DD(:,:,i)
3062 cd write(iout,*) 'EE',EE(:,:,i)
3064 cd call check_vecgrad
3066 if (icheckgrad.eq.1) then
3068 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3070 dc_norm(k,i)=dc(k,i)*fac
3072 c write (iout,*) 'i',i,' fac',fac
3075 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3076 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3077 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3078 c call vec_and_deriv
3084 time_mat=time_mat+MPI_Wtime()-time01
3088 cd write (iout,*) 'i=',i
3090 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3093 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3094 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3107 cd print '(a)','Enter EELEC'
3108 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3110 gel_loc_loc(i)=0.0d0
3115 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3117 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3119 do i=iturn3_start,iturn3_end
3123 dx_normi=dc_norm(1,i)
3124 dy_normi=dc_norm(2,i)
3125 dz_normi=dc_norm(3,i)
3126 xmedi=c(1,i)+0.5d0*dxi
3127 ymedi=c(2,i)+0.5d0*dyi
3128 zmedi=c(3,i)+0.5d0*dzi
3130 call eelecij(i,i+2,ees,evdw1,eel_loc)
3131 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3132 num_cont_hb(i)=num_conti
3134 do i=iturn4_start,iturn4_end
3138 dx_normi=dc_norm(1,i)
3139 dy_normi=dc_norm(2,i)
3140 dz_normi=dc_norm(3,i)
3141 xmedi=c(1,i)+0.5d0*dxi
3142 ymedi=c(2,i)+0.5d0*dyi
3143 zmedi=c(3,i)+0.5d0*dzi
3144 num_conti=num_cont_hb(i)
3145 call eelecij(i,i+3,ees,evdw1,eel_loc)
3146 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3147 num_cont_hb(i)=num_conti
3150 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3152 do i=iatel_s,iatel_e
3156 dx_normi=dc_norm(1,i)
3157 dy_normi=dc_norm(2,i)
3158 dz_normi=dc_norm(3,i)
3159 xmedi=c(1,i)+0.5d0*dxi
3160 ymedi=c(2,i)+0.5d0*dyi
3161 zmedi=c(3,i)+0.5d0*dzi
3162 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3163 num_conti=num_cont_hb(i)
3164 do j=ielstart(i),ielend(i)
3165 call eelecij(i,j,ees,evdw1,eel_loc)
3167 num_cont_hb(i)=num_conti
3169 c write (iout,*) "Number of loop steps in EELEC:",ind
3171 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3172 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3174 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3175 ccc eel_loc=eel_loc+eello_turn3
3176 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3179 C-------------------------------------------------------------------------------
3180 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3181 implicit real*8 (a-h,o-z)
3182 include 'DIMENSIONS'
3186 include 'COMMON.CONTROL'
3187 include 'COMMON.IOUNITS'
3188 include 'COMMON.GEO'
3189 include 'COMMON.VAR'
3190 include 'COMMON.LOCAL'
3191 include 'COMMON.CHAIN'
3192 include 'COMMON.DERIV'
3193 include 'COMMON.INTERACT'
3194 include 'COMMON.CONTACTS'
3195 include 'COMMON.TORSION'
3196 include 'COMMON.VECTORS'
3197 include 'COMMON.FFIELD'
3198 include 'COMMON.TIME1'
3199 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3200 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3201 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3202 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3203 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3204 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3206 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3208 double precision scal_el /1.0d0/
3210 double precision scal_el /0.5d0/
3213 C 13-go grudnia roku pamietnego...
3214 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3215 & 0.0d0,1.0d0,0.0d0,
3216 & 0.0d0,0.0d0,1.0d0/
3217 c time00=MPI_Wtime()
3218 cd write (iout,*) "eelecij",i,j
3222 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3223 aaa=app(iteli,itelj)
3224 bbb=bpp(iteli,itelj)
3225 ael6i=ael6(iteli,itelj)
3226 ael3i=ael3(iteli,itelj)
3230 dx_normj=dc_norm(1,j)
3231 dy_normj=dc_norm(2,j)
3232 dz_normj=dc_norm(3,j)
3233 xj=c(1,j)+0.5D0*dxj-xmedi
3234 yj=c(2,j)+0.5D0*dyj-ymedi
3235 zj=c(3,j)+0.5D0*dzj-zmedi
3236 rij=xj*xj+yj*yj+zj*zj
3242 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3243 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3244 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3245 fac=cosa-3.0D0*cosb*cosg
3247 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3248 if (j.eq.i+2) ev1=scal_el*ev1
3253 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3256 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3257 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3260 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3261 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3262 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3263 cd & xmedi,ymedi,zmedi,xj,yj,zj
3265 if (energy_dec) then
3266 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3267 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3271 C Calculate contributions to the Cartesian gradient.
3274 facvdw=-6*rrmij*(ev1+evdwij)
3275 facel=-3*rrmij*(el1+eesij)
3281 * Radial derivatives. First process both termini of the fragment (i,j)
3287 c ghalf=0.5D0*ggg(k)
3288 c gelc(k,i)=gelc(k,i)+ghalf
3289 c gelc(k,j)=gelc(k,j)+ghalf
3291 c 9/28/08 AL Gradient compotents will be summed only at the end
3293 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3294 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3297 * Loop over residues i+1 thru j-1.
3301 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3308 c ghalf=0.5D0*ggg(k)
3309 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3310 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3312 c 9/28/08 AL Gradient compotents will be summed only at the end
3314 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3315 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3318 * Loop over residues i+1 thru j-1.
3322 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3329 fac=-3*rrmij*(facvdw+facvdw+facel)
3334 * Radial derivatives. First process both termini of the fragment (i,j)
3340 c ghalf=0.5D0*ggg(k)
3341 c gelc(k,i)=gelc(k,i)+ghalf
3342 c gelc(k,j)=gelc(k,j)+ghalf
3344 c 9/28/08 AL Gradient compotents will be summed only at the end
3346 gelc_long(k,j)=gelc(k,j)+ggg(k)
3347 gelc_long(k,i)=gelc(k,i)-ggg(k)
3350 * Loop over residues i+1 thru j-1.
3354 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3357 c 9/28/08 AL Gradient compotents will be summed only at the end
3362 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3363 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3369 ecosa=2.0D0*fac3*fac1+fac4
3372 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3373 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3375 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3376 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3378 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3379 cd & (dcosg(k),k=1,3)
3381 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3384 c ghalf=0.5D0*ggg(k)
3385 c gelc(k,i)=gelc(k,i)+ghalf
3386 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3387 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3388 c gelc(k,j)=gelc(k,j)+ghalf
3389 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3390 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3394 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3399 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3400 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3402 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3403 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3404 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3405 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3407 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3408 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3409 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3411 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3412 C energy of a peptide unit is assumed in the form of a second-order
3413 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3414 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3415 C are computed for EVERY pair of non-contiguous peptide groups.
3417 if (j.lt.nres-1) then
3428 muij(kkk)=mu(k,i)*mu(l,j)
3431 cd write (iout,*) 'EELEC: i',i,' j',j
3432 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3433 cd write(iout,*) 'muij',muij
3434 ury=scalar(uy(1,i),erij)
3435 urz=scalar(uz(1,i),erij)
3436 vry=scalar(uy(1,j),erij)
3437 vrz=scalar(uz(1,j),erij)
3438 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3439 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3440 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3441 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3442 fac=dsqrt(-ael6i)*r3ij
3447 cd write (iout,'(4i5,4f10.5)')
3448 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3449 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3450 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3451 cd & uy(:,j),uz(:,j)
3452 cd write (iout,'(4f10.5)')
3453 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3454 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3455 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3456 cd write (iout,'(9f10.5/)')
3457 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3458 C Derivatives of the elements of A in virtual-bond vectors
3459 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3461 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3462 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3463 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3464 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3465 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3466 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3467 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3468 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3469 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3470 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3471 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3472 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3474 C Compute radial contributions to the gradient
3492 C Add the contributions coming from er
3495 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3496 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3497 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3498 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3501 C Derivatives in DC(i)
3502 cgrad ghalf1=0.5d0*agg(k,1)
3503 cgrad ghalf2=0.5d0*agg(k,2)
3504 cgrad ghalf3=0.5d0*agg(k,3)
3505 cgrad ghalf4=0.5d0*agg(k,4)
3506 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3507 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3508 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3509 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3510 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3511 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3512 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3513 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3514 C Derivatives in DC(i+1)
3515 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3516 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3517 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3518 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3519 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3520 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3521 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3522 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3523 C Derivatives in DC(j)
3524 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3525 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3526 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3527 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3528 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3529 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3530 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3531 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3532 C Derivatives in DC(j+1) or DC(nres-1)
3533 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3534 & -3.0d0*vryg(k,3)*ury)
3535 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3536 & -3.0d0*vrzg(k,3)*ury)
3537 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3538 & -3.0d0*vryg(k,3)*urz)
3539 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3540 & -3.0d0*vrzg(k,3)*urz)
3541 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3543 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3556 aggi(k,l)=-aggi(k,l)
3557 aggi1(k,l)=-aggi1(k,l)
3558 aggj(k,l)=-aggj(k,l)
3559 aggj1(k,l)=-aggj1(k,l)
3562 if (j.lt.nres-1) then
3568 aggi(k,l)=-aggi(k,l)
3569 aggi1(k,l)=-aggi1(k,l)
3570 aggj(k,l)=-aggj(k,l)
3571 aggj1(k,l)=-aggj1(k,l)
3582 aggi(k,l)=-aggi(k,l)
3583 aggi1(k,l)=-aggi1(k,l)
3584 aggj(k,l)=-aggj(k,l)
3585 aggj1(k,l)=-aggj1(k,l)
3590 IF (wel_loc.gt.0.0d0) THEN
3591 C Contribution to the local-electrostatic energy coming from the i-j pair
3592 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3594 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3596 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3597 & 'eelloc',i,j,eel_loc_ij
3599 eel_loc=eel_loc+eel_loc_ij
3600 C Partial derivatives in virtual-bond dihedral angles gamma
3602 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3603 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3604 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3605 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3606 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3607 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3608 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3610 ggg(l)=agg(l,1)*muij(1)+
3611 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3612 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3613 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3614 cgrad ghalf=0.5d0*ggg(l)
3615 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3616 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3620 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3623 C Remaining derivatives of eello
3625 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3626 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3627 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3628 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3629 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3630 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3631 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3632 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3635 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3636 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3637 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3638 & .and. num_conti.le.maxconts) then
3639 c write (iout,*) i,j," entered corr"
3641 C Calculate the contact function. The ith column of the array JCONT will
3642 C contain the numbers of atoms that make contacts with the atom I (of numbers
3643 C greater than I). The arrays FACONT and GACONT will contain the values of
3644 C the contact function and its derivative.
3645 c r0ij=1.02D0*rpp(iteli,itelj)
3646 c r0ij=1.11D0*rpp(iteli,itelj)
3647 r0ij=2.20D0*rpp(iteli,itelj)
3648 c r0ij=1.55D0*rpp(iteli,itelj)
3649 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3650 if (fcont.gt.0.0D0) then
3651 num_conti=num_conti+1
3652 if (num_conti.gt.maxconts) then
3653 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3654 & ' will skip next contacts for this conf.'
3656 jcont_hb(num_conti,i)=j
3657 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3658 cd & " jcont_hb",jcont_hb(num_conti,i)
3659 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3660 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3661 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3663 d_cont(num_conti,i)=rij
3664 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3665 C --- Electrostatic-interaction matrix ---
3666 a_chuj(1,1,num_conti,i)=a22
3667 a_chuj(1,2,num_conti,i)=a23
3668 a_chuj(2,1,num_conti,i)=a32
3669 a_chuj(2,2,num_conti,i)=a33
3670 C --- Gradient of rij
3672 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3679 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3680 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3681 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3682 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3683 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3688 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3689 C Calculate contact energies
3691 wij=cosa-3.0D0*cosb*cosg
3694 c fac3=dsqrt(-ael6i)/r0ij**3
3695 fac3=dsqrt(-ael6i)*r3ij
3696 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3697 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3698 if (ees0tmp.gt.0) then
3699 ees0pij=dsqrt(ees0tmp)
3703 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3704 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3705 if (ees0tmp.gt.0) then
3706 ees0mij=dsqrt(ees0tmp)
3711 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3712 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3713 C Diagnostics. Comment out or remove after debugging!
3714 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3715 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3716 c ees0m(num_conti,i)=0.0D0
3718 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3719 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3720 C Angular derivatives of the contact function
3721 ees0pij1=fac3/ees0pij
3722 ees0mij1=fac3/ees0mij
3723 fac3p=-3.0D0*fac3*rrmij
3724 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3725 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3727 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3728 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3729 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3730 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3731 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3732 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3733 ecosap=ecosa1+ecosa2
3734 ecosbp=ecosb1+ecosb2
3735 ecosgp=ecosg1+ecosg2
3736 ecosam=ecosa1-ecosa2
3737 ecosbm=ecosb1-ecosb2
3738 ecosgm=ecosg1-ecosg2
3747 facont_hb(num_conti,i)=fcont
3748 fprimcont=fprimcont/rij
3749 cd facont_hb(num_conti,i)=1.0D0
3750 C Following line is for diagnostics.
3753 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3754 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3757 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3758 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3760 gggp(1)=gggp(1)+ees0pijp*xj
3761 gggp(2)=gggp(2)+ees0pijp*yj
3762 gggp(3)=gggp(3)+ees0pijp*zj
3763 gggm(1)=gggm(1)+ees0mijp*xj
3764 gggm(2)=gggm(2)+ees0mijp*yj
3765 gggm(3)=gggm(3)+ees0mijp*zj
3766 C Derivatives due to the contact function
3767 gacont_hbr(1,num_conti,i)=fprimcont*xj
3768 gacont_hbr(2,num_conti,i)=fprimcont*yj
3769 gacont_hbr(3,num_conti,i)=fprimcont*zj
3772 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3773 c following the change of gradient-summation algorithm.
3775 cgrad ghalfp=0.5D0*gggp(k)
3776 cgrad ghalfm=0.5D0*gggm(k)
3777 gacontp_hb1(k,num_conti,i)=!ghalfp
3778 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3779 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3780 gacontp_hb2(k,num_conti,i)=!ghalfp
3781 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3782 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3783 gacontp_hb3(k,num_conti,i)=gggp(k)
3784 gacontm_hb1(k,num_conti,i)=!ghalfm
3785 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3786 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3787 gacontm_hb2(k,num_conti,i)=!ghalfm
3788 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3789 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3790 gacontm_hb3(k,num_conti,i)=gggm(k)
3792 C Diagnostics. Comment out or remove after debugging!
3794 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3795 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3796 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3797 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3798 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3799 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3802 endif ! num_conti.le.maxconts
3805 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3808 ghalf=0.5d0*agg(l,k)
3809 aggi(l,k)=aggi(l,k)+ghalf
3810 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3811 aggj(l,k)=aggj(l,k)+ghalf
3814 if (j.eq.nres-1 .and. i.lt.j-2) then
3817 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3822 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3825 C-----------------------------------------------------------------------------
3826 subroutine eturn3(i,eello_turn3)
3827 C Third- and fourth-order contributions from turns
3828 implicit real*8 (a-h,o-z)
3829 include 'DIMENSIONS'
3830 include 'COMMON.IOUNITS'
3831 include 'COMMON.GEO'
3832 include 'COMMON.VAR'
3833 include 'COMMON.LOCAL'
3834 include 'COMMON.CHAIN'
3835 include 'COMMON.DERIV'
3836 include 'COMMON.INTERACT'
3837 include 'COMMON.CONTACTS'
3838 include 'COMMON.TORSION'
3839 include 'COMMON.VECTORS'
3840 include 'COMMON.FFIELD'
3841 include 'COMMON.CONTROL'
3843 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3844 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3845 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3846 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3847 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3848 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3849 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3852 c write (iout,*) "eturn3",i,j,j1,j2
3857 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3859 C Third-order contributions
3866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3867 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3868 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3869 call transpose2(auxmat(1,1),auxmat1(1,1))
3870 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3871 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3872 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3873 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3874 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3875 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3876 cd & ' eello_turn3_num',4*eello_turn3_num
3877 C Derivatives in gamma(i)
3878 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3879 call transpose2(auxmat2(1,1),auxmat3(1,1))
3880 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3881 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3882 C Derivatives in gamma(i+1)
3883 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3884 call transpose2(auxmat2(1,1),auxmat3(1,1))
3885 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3886 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3887 & +0.5d0*(pizda(1,1)+pizda(2,2))
3888 C Cartesian derivatives
3890 c ghalf1=0.5d0*agg(l,1)
3891 c ghalf2=0.5d0*agg(l,2)
3892 c ghalf3=0.5d0*agg(l,3)
3893 c ghalf4=0.5d0*agg(l,4)
3894 a_temp(1,1)=aggi(l,1)!+ghalf1
3895 a_temp(1,2)=aggi(l,2)!+ghalf2
3896 a_temp(2,1)=aggi(l,3)!+ghalf3
3897 a_temp(2,2)=aggi(l,4)!+ghalf4
3898 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3899 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3900 & +0.5d0*(pizda(1,1)+pizda(2,2))
3901 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3902 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3903 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3904 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3905 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3906 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3907 & +0.5d0*(pizda(1,1)+pizda(2,2))
3908 a_temp(1,1)=aggj(l,1)!+ghalf1
3909 a_temp(1,2)=aggj(l,2)!+ghalf2
3910 a_temp(2,1)=aggj(l,3)!+ghalf3
3911 a_temp(2,2)=aggj(l,4)!+ghalf4
3912 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3913 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3914 & +0.5d0*(pizda(1,1)+pizda(2,2))
3915 a_temp(1,1)=aggj1(l,1)
3916 a_temp(1,2)=aggj1(l,2)
3917 a_temp(2,1)=aggj1(l,3)
3918 a_temp(2,2)=aggj1(l,4)
3919 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3920 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3921 & +0.5d0*(pizda(1,1)+pizda(2,2))
3925 C-------------------------------------------------------------------------------
3926 subroutine eturn4(i,eello_turn4)
3927 C Third- and fourth-order contributions from turns
3928 implicit real*8 (a-h,o-z)
3929 include 'DIMENSIONS'
3930 include 'COMMON.IOUNITS'
3931 include 'COMMON.GEO'
3932 include 'COMMON.VAR'
3933 include 'COMMON.LOCAL'
3934 include 'COMMON.CHAIN'
3935 include 'COMMON.DERIV'
3936 include 'COMMON.INTERACT'
3937 include 'COMMON.CONTACTS'
3938 include 'COMMON.TORSION'
3939 include 'COMMON.VECTORS'
3940 include 'COMMON.FFIELD'
3941 include 'COMMON.CONTROL'
3943 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3944 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3945 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3946 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3947 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3948 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3949 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3952 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3954 C Fourth-order contributions
3962 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3963 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3964 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3969 iti1=itortyp(itype(i+1))
3970 iti2=itortyp(itype(i+2))
3971 iti3=itortyp(itype(i+3))
3972 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3973 call transpose2(EUg(1,1,i+1),e1t(1,1))
3974 call transpose2(Eug(1,1,i+2),e2t(1,1))
3975 call transpose2(Eug(1,1,i+3),e3t(1,1))
3976 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3977 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3978 s1=scalar2(b1(1,iti2),auxvec(1))
3979 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3980 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3981 s2=scalar2(b1(1,iti1),auxvec(1))
3982 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3983 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3984 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3985 eello_turn4=eello_turn4-(s1+s2+s3)
3986 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3987 & 'eturn4',i,j,-(s1+s2+s3)
3988 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3989 cd & ' eello_turn4_num',8*eello_turn4_num
3990 C Derivatives in gamma(i)
3991 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3992 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3993 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3994 s1=scalar2(b1(1,iti2),auxvec(1))
3995 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3996 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3997 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3998 C Derivatives in gamma(i+1)
3999 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4000 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4001 s2=scalar2(b1(1,iti1),auxvec(1))
4002 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4003 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4004 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4005 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4006 C Derivatives in gamma(i+2)
4007 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4008 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4009 s1=scalar2(b1(1,iti2),auxvec(1))
4010 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4011 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4012 s2=scalar2(b1(1,iti1),auxvec(1))
4013 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4014 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4015 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4016 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4017 C Cartesian derivatives
4018 C Derivatives of this turn contributions in DC(i+2)
4019 if (j.lt.nres-1) then
4021 a_temp(1,1)=agg(l,1)
4022 a_temp(1,2)=agg(l,2)
4023 a_temp(2,1)=agg(l,3)
4024 a_temp(2,2)=agg(l,4)
4025 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4026 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4027 s1=scalar2(b1(1,iti2),auxvec(1))
4028 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4029 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4030 s2=scalar2(b1(1,iti1),auxvec(1))
4031 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4032 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4033 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4035 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4038 C Remaining derivatives of this turn contribution
4040 a_temp(1,1)=aggi(l,1)
4041 a_temp(1,2)=aggi(l,2)
4042 a_temp(2,1)=aggi(l,3)
4043 a_temp(2,2)=aggi(l,4)
4044 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4045 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4046 s1=scalar2(b1(1,iti2),auxvec(1))
4047 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4048 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4049 s2=scalar2(b1(1,iti1),auxvec(1))
4050 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4051 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4052 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4053 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4054 a_temp(1,1)=aggi1(l,1)
4055 a_temp(1,2)=aggi1(l,2)
4056 a_temp(2,1)=aggi1(l,3)
4057 a_temp(2,2)=aggi1(l,4)
4058 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4059 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4060 s1=scalar2(b1(1,iti2),auxvec(1))
4061 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4062 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4063 s2=scalar2(b1(1,iti1),auxvec(1))
4064 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4065 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4066 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4067 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4068 a_temp(1,1)=aggj(l,1)
4069 a_temp(1,2)=aggj(l,2)
4070 a_temp(2,1)=aggj(l,3)
4071 a_temp(2,2)=aggj(l,4)
4072 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4073 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4074 s1=scalar2(b1(1,iti2),auxvec(1))
4075 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4076 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4077 s2=scalar2(b1(1,iti1),auxvec(1))
4078 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4079 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4080 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4081 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4082 a_temp(1,1)=aggj1(l,1)
4083 a_temp(1,2)=aggj1(l,2)
4084 a_temp(2,1)=aggj1(l,3)
4085 a_temp(2,2)=aggj1(l,4)
4086 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4087 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4088 s1=scalar2(b1(1,iti2),auxvec(1))
4089 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4090 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4091 s2=scalar2(b1(1,iti1),auxvec(1))
4092 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4093 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4094 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4095 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4096 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4100 C-----------------------------------------------------------------------------
4101 subroutine vecpr(u,v,w)
4102 implicit real*8(a-h,o-z)
4103 dimension u(3),v(3),w(3)
4104 w(1)=u(2)*v(3)-u(3)*v(2)
4105 w(2)=-u(1)*v(3)+u(3)*v(1)
4106 w(3)=u(1)*v(2)-u(2)*v(1)
4109 C-----------------------------------------------------------------------------
4110 subroutine unormderiv(u,ugrad,unorm,ungrad)
4111 C This subroutine computes the derivatives of a normalized vector u, given
4112 C the derivatives computed without normalization conditions, ugrad. Returns
4115 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4116 double precision vec(3)
4117 double precision scalar
4119 c write (2,*) 'ugrad',ugrad
4122 vec(i)=scalar(ugrad(1,i),u(1))
4124 c write (2,*) 'vec',vec
4127 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4130 c write (2,*) 'ungrad',ungrad
4133 C-----------------------------------------------------------------------------
4134 subroutine escp_soft_sphere(evdw2,evdw2_14)
4136 C This subroutine calculates the excluded-volume interaction energy between
4137 C peptide-group centers and side chains and its gradient in virtual-bond and
4138 C side-chain vectors.
4140 implicit real*8 (a-h,o-z)
4141 include 'DIMENSIONS'
4142 include 'COMMON.GEO'
4143 include 'COMMON.VAR'
4144 include 'COMMON.LOCAL'
4145 include 'COMMON.CHAIN'
4146 include 'COMMON.DERIV'
4147 include 'COMMON.INTERACT'
4148 include 'COMMON.FFIELD'
4149 include 'COMMON.IOUNITS'
4150 include 'COMMON.CONTROL'
4155 cd print '(a)','Enter ESCP'
4156 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4157 do i=iatscp_s,iatscp_e
4159 xi=0.5D0*(c(1,i)+c(1,i+1))
4160 yi=0.5D0*(c(2,i)+c(2,i+1))
4161 zi=0.5D0*(c(3,i)+c(3,i+1))
4163 do iint=1,nscp_gr(i)
4165 do j=iscpstart(i,iint),iscpend(i,iint)
4167 C Uncomment following three lines for SC-p interactions
4171 C Uncomment following three lines for Ca-p interactions
4175 rij=xj*xj+yj*yj+zj*zj
4178 if (rij.lt.r0ijsq) then
4179 evdwij=0.25d0*(rij-r0ijsq)**2
4187 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4192 cgrad if (j.lt.i) then
4193 cd write (iout,*) 'j<i'
4194 C Uncomment following three lines for SC-p interactions
4196 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4199 cd write (iout,*) 'j>i'
4201 cgrad ggg(k)=-ggg(k)
4202 C Uncomment following line for SC-p interactions
4203 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4207 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4209 cgrad kstart=min0(i+1,j)
4210 cgrad kend=max0(i-1,j-1)
4211 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4212 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4213 cgrad do k=kstart,kend
4215 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4219 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4220 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4228 C-----------------------------------------------------------------------------
4229 subroutine escp(evdw2,evdw2_14)
4231 C This subroutine calculates the excluded-volume interaction energy between
4232 C peptide-group centers and side chains and its gradient in virtual-bond and
4233 C side-chain vectors.
4235 implicit real*8 (a-h,o-z)
4236 include 'DIMENSIONS'
4237 include 'COMMON.GEO'
4238 include 'COMMON.VAR'
4239 include 'COMMON.LOCAL'
4240 include 'COMMON.CHAIN'
4241 include 'COMMON.DERIV'
4242 include 'COMMON.INTERACT'
4243 include 'COMMON.FFIELD'
4244 include 'COMMON.IOUNITS'
4245 include 'COMMON.CONTROL'
4249 cd print '(a)','Enter ESCP'
4250 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4251 do i=iatscp_s,iatscp_e
4253 xi=0.5D0*(c(1,i)+c(1,i+1))
4254 yi=0.5D0*(c(2,i)+c(2,i+1))
4255 zi=0.5D0*(c(3,i)+c(3,i+1))
4257 do iint=1,nscp_gr(i)
4259 do j=iscpstart(i,iint),iscpend(i,iint)
4261 C Uncomment following three lines for SC-p interactions
4265 C Uncomment following three lines for Ca-p interactions
4269 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4271 e1=fac*fac*aad(itypj,iteli)
4272 e2=fac*bad(itypj,iteli)
4273 if (iabs(j-i) .le. 2) then
4276 evdw2_14=evdw2_14+e1+e2
4280 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4281 & 'evdw2',i,j,evdwij
4283 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4285 fac=-(evdwij+e1)*rrij
4289 cgrad if (j.lt.i) then
4290 cd write (iout,*) 'j<i'
4291 C Uncomment following three lines for SC-p interactions
4293 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4296 cd write (iout,*) 'j>i'
4298 cgrad ggg(k)=-ggg(k)
4299 C Uncomment following line for SC-p interactions
4300 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4301 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4305 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4307 cgrad kstart=min0(i+1,j)
4308 cgrad kend=max0(i-1,j-1)
4309 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4310 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4311 cgrad do k=kstart,kend
4313 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4317 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4318 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4326 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4327 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4328 gradx_scp(j,i)=expon*gradx_scp(j,i)
4331 C******************************************************************************
4335 C To save time the factor EXPON has been extracted from ALL components
4336 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4339 C******************************************************************************
4342 C--------------------------------------------------------------------------
4343 subroutine edis(ehpb)
4345 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4347 implicit real*8 (a-h,o-z)
4348 include 'DIMENSIONS'
4349 include 'COMMON.SBRIDGE'
4350 include 'COMMON.CHAIN'
4351 include 'COMMON.DERIV'
4352 include 'COMMON.VAR'
4353 include 'COMMON.INTERACT'
4354 include 'COMMON.IOUNITS'
4357 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4358 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4359 if (link_end.eq.0) return
4360 do i=link_start,link_end
4361 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4362 C CA-CA distance used in regularization of structure.
4365 C iii and jjj point to the residues for which the distance is assigned.
4366 if (ii.gt.nres) then
4373 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4374 c & dhpb(i),dhpb1(i),forcon(i)
4375 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4376 C distance and angle dependent SS bond potential.
4377 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4378 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4379 if (.not.dyn_ss .and. i.le.nss) then
4380 C 15/02/13 CC dynamic SSbond - additional check
4382 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4383 call ssbond_ene(iii,jjj,eij)
4386 cd write (iout,*) "eij",eij
4387 else if (ii.gt.nres .and. jj.gt.nres) then
4388 c Restraints from contact prediction
4390 if (dhpb1(i).gt.0.0d0) then
4391 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4392 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4393 c write (iout,*) "beta nmr",
4394 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4398 C Get the force constant corresponding to this distance.
4400 C Calculate the contribution to energy.
4401 ehpb=ehpb+waga*rdis*rdis
4402 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4404 C Evaluate gradient.
4409 ggg(j)=fac*(c(j,jj)-c(j,ii))
4412 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4413 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4416 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4417 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4420 C Calculate the distance between the two points and its difference from the
4423 if (dhpb1(i).gt.0.0d0) then
4424 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4425 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4426 c write (iout,*) "alph nmr",
4427 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4430 C Get the force constant corresponding to this distance.
4432 C Calculate the contribution to energy.
4433 ehpb=ehpb+waga*rdis*rdis
4434 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4436 C Evaluate gradient.
4440 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4441 cd & ' waga=',waga,' fac=',fac
4443 ggg(j)=fac*(c(j,jj)-c(j,ii))
4445 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4446 C If this is a SC-SC distance, we need to calculate the contributions to the
4447 C Cartesian gradient in the SC vectors (ghpbx).
4450 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4451 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4454 cgrad do j=iii,jjj-1
4456 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4460 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4461 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4468 C--------------------------------------------------------------------------
4469 subroutine ssbond_ene(i,j,eij)
4471 C Calculate the distance and angle dependent SS-bond potential energy
4472 C using a free-energy function derived based on RHF/6-31G** ab initio
4473 C calculations of diethyl disulfide.
4475 C A. Liwo and U. Kozlowska, 11/24/03
4477 implicit real*8 (a-h,o-z)
4478 include 'DIMENSIONS'
4479 include 'COMMON.SBRIDGE'
4480 include 'COMMON.CHAIN'
4481 include 'COMMON.DERIV'
4482 include 'COMMON.LOCAL'
4483 include 'COMMON.INTERACT'
4484 include 'COMMON.VAR'
4485 include 'COMMON.IOUNITS'
4486 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4491 dxi=dc_norm(1,nres+i)
4492 dyi=dc_norm(2,nres+i)
4493 dzi=dc_norm(3,nres+i)
4494 c dsci_inv=dsc_inv(itypi)
4495 dsci_inv=vbld_inv(nres+i)
4497 c dscj_inv=dsc_inv(itypj)
4498 dscj_inv=vbld_inv(nres+j)
4502 dxj=dc_norm(1,nres+j)
4503 dyj=dc_norm(2,nres+j)
4504 dzj=dc_norm(3,nres+j)
4505 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4510 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4511 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4512 om12=dxi*dxj+dyi*dyj+dzi*dzj
4514 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4515 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4521 deltat12=om2-om1+2.0d0
4523 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4524 & +akct*deltad*deltat12+ebr
4525 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4526 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4527 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4528 c & " deltat12",deltat12," eij",eij
4529 ed=2*akcm*deltad+akct*deltat12
4531 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4532 eom1=-2*akth*deltat1-pom1-om2*pom2
4533 eom2= 2*akth*deltat2+pom1-om1*pom2
4536 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4537 ghpbx(k,i)=ghpbx(k,i)-ggk
4538 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4539 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4540 ghpbx(k,j)=ghpbx(k,j)+ggk
4541 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4542 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4543 ghpbc(k,i)=ghpbc(k,i)-ggk
4544 ghpbc(k,j)=ghpbc(k,j)+ggk
4547 C Calculate the components of the gradient in DC and X
4551 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4556 C--------------------------------------------------------------------------
4557 subroutine ebond(estr)
4559 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4561 implicit real*8 (a-h,o-z)
4562 include 'DIMENSIONS'
4563 include 'COMMON.LOCAL'
4564 include 'COMMON.GEO'
4565 include 'COMMON.INTERACT'
4566 include 'COMMON.DERIV'
4567 include 'COMMON.VAR'
4568 include 'COMMON.CHAIN'
4569 include 'COMMON.IOUNITS'
4570 include 'COMMON.NAMES'
4571 include 'COMMON.FFIELD'
4572 include 'COMMON.CONTROL'
4573 include 'COMMON.SETUP'
4574 double precision u(3),ud(3)
4576 do i=ibondp_start,ibondp_end
4577 diff = vbld(i)-vbldp0
4578 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4581 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4583 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4587 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4589 do i=ibond_start,ibond_end
4594 diff=vbld(i+nres)-vbldsc0(1,iti)
4595 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4596 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4597 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4599 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4603 diff=vbld(i+nres)-vbldsc0(j,iti)
4604 ud(j)=aksc(j,iti)*diff
4605 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4619 uprod2=uprod2*u(k)*u(k)
4623 usumsqder=usumsqder+ud(j)*uprod2
4625 estr=estr+uprod/usum
4627 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4635 C--------------------------------------------------------------------------
4636 subroutine ebend(etheta)
4638 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4639 C angles gamma and its derivatives in consecutive thetas and gammas.
4641 implicit real*8 (a-h,o-z)
4642 include 'DIMENSIONS'
4643 include 'COMMON.LOCAL'
4644 include 'COMMON.GEO'
4645 include 'COMMON.INTERACT'
4646 include 'COMMON.DERIV'
4647 include 'COMMON.VAR'
4648 include 'COMMON.CHAIN'
4649 include 'COMMON.IOUNITS'
4650 include 'COMMON.NAMES'
4651 include 'COMMON.FFIELD'
4652 include 'COMMON.CONTROL'
4653 common /calcthet/ term1,term2,termm,diffak,ratak,
4654 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4655 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4656 double precision y(2),z(2)
4658 c time11=dexp(-2*time)
4661 c write (*,'(a,i2)') 'EBEND ICG=',icg
4662 do i=ithet_start,ithet_end
4663 C Zero the energy function and its derivative at 0 or pi.
4664 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4669 if (phii.ne.phii) phii=150.0
4682 if (phii1.ne.phii1) phii1=150.0
4694 C Calculate the "mean" value of theta from the part of the distribution
4695 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4696 C In following comments this theta will be referred to as t_c.
4697 thet_pred_mean=0.0d0
4701 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4703 dthett=thet_pred_mean*ssd
4704 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4705 C Derivatives of the "mean" values in gamma1 and gamma2.
4706 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4707 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4708 if (theta(i).gt.pi-delta) then
4709 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4711 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4712 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4713 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4715 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4717 else if (theta(i).lt.delta) then
4718 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4719 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4720 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4722 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4723 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4726 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4729 etheta=etheta+ethetai
4730 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4732 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4733 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4734 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4736 C Ufff.... We've done all this!!!
4739 C---------------------------------------------------------------------------
4740 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4742 implicit real*8 (a-h,o-z)
4743 include 'DIMENSIONS'
4744 include 'COMMON.LOCAL'
4745 include 'COMMON.IOUNITS'
4746 common /calcthet/ term1,term2,termm,diffak,ratak,
4747 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4748 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4749 C Calculate the contributions to both Gaussian lobes.
4750 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4751 C The "polynomial part" of the "standard deviation" of this part of
4755 sig=sig*thet_pred_mean+polthet(j,it)
4757 C Derivative of the "interior part" of the "standard deviation of the"
4758 C gamma-dependent Gaussian lobe in t_c.
4759 sigtc=3*polthet(3,it)
4761 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4764 C Set the parameters of both Gaussian lobes of the distribution.
4765 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4766 fac=sig*sig+sigc0(it)
4769 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4770 sigsqtc=-4.0D0*sigcsq*sigtc
4771 c print *,i,sig,sigtc,sigsqtc
4772 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4773 sigtc=-sigtc/(fac*fac)
4774 C Following variable is sigma(t_c)**(-2)
4775 sigcsq=sigcsq*sigcsq
4777 sig0inv=1.0D0/sig0i**2
4778 delthec=thetai-thet_pred_mean
4779 delthe0=thetai-theta0i
4780 term1=-0.5D0*sigcsq*delthec*delthec
4781 term2=-0.5D0*sig0inv*delthe0*delthe0
4782 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4783 C NaNs in taking the logarithm. We extract the largest exponent which is added
4784 C to the energy (this being the log of the distribution) at the end of energy
4785 C term evaluation for this virtual-bond angle.
4786 if (term1.gt.term2) then
4788 term2=dexp(term2-termm)
4792 term1=dexp(term1-termm)
4795 C The ratio between the gamma-independent and gamma-dependent lobes of
4796 C the distribution is a Gaussian function of thet_pred_mean too.
4797 diffak=gthet(2,it)-thet_pred_mean
4798 ratak=diffak/gthet(3,it)**2
4799 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4800 C Let's differentiate it in thet_pred_mean NOW.
4802 C Now put together the distribution terms to make complete distribution.
4803 termexp=term1+ak*term2
4804 termpre=sigc+ak*sig0i
4805 C Contribution of the bending energy from this theta is just the -log of
4806 C the sum of the contributions from the two lobes and the pre-exponential
4807 C factor. Simple enough, isn't it?
4808 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4809 C NOW the derivatives!!!
4810 C 6/6/97 Take into account the deformation.
4811 E_theta=(delthec*sigcsq*term1
4812 & +ak*delthe0*sig0inv*term2)/termexp
4813 E_tc=((sigtc+aktc*sig0i)/termpre
4814 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4815 & aktc*term2)/termexp)
4818 c-----------------------------------------------------------------------------
4819 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4820 implicit real*8 (a-h,o-z)
4821 include 'DIMENSIONS'
4822 include 'COMMON.LOCAL'
4823 include 'COMMON.IOUNITS'
4824 common /calcthet/ term1,term2,termm,diffak,ratak,
4825 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4826 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4827 delthec=thetai-thet_pred_mean
4828 delthe0=thetai-theta0i
4829 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4830 t3 = thetai-thet_pred_mean
4834 t14 = t12+t6*sigsqtc
4836 t21 = thetai-theta0i
4842 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4843 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4844 & *(-t12*t9-ak*sig0inv*t27)
4848 C--------------------------------------------------------------------------
4849 subroutine ebend(etheta)
4851 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4852 C angles gamma and its derivatives in consecutive thetas and gammas.
4853 C ab initio-derived potentials from
4854 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4856 implicit real*8 (a-h,o-z)
4857 include 'DIMENSIONS'
4858 include 'COMMON.LOCAL'
4859 include 'COMMON.GEO'
4860 include 'COMMON.INTERACT'
4861 include 'COMMON.DERIV'
4862 include 'COMMON.VAR'
4863 include 'COMMON.CHAIN'
4864 include 'COMMON.IOUNITS'
4865 include 'COMMON.NAMES'
4866 include 'COMMON.FFIELD'
4867 include 'COMMON.CONTROL'
4868 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4869 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4870 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4871 & sinph1ph2(maxdouble,maxdouble)
4872 logical lprn /.false./, lprn1 /.false./
4874 c write (iout,*) "EBEND ithet_start",ithet_start,
4875 c & " ithet_end",ithet_end
4876 do i=ithet_start,ithet_end
4877 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4878 &(itype(i).eq.ntyp1)) cycle
4882 theti2=0.5d0*theta(i)
4883 ityp2=ithetyp(itype(i-1))
4885 coskt(k)=dcos(k*theti2)
4886 sinkt(k)=dsin(k*theti2)
4889 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4892 if (phii.ne.phii) phii=150.0
4896 ityp1=ithetyp(itype(i-2))
4898 cosph1(k)=dcos(k*phii)
4899 sinph1(k)=dsin(k*phii)
4903 ityp1=ithetyp(itype(i-2))
4909 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4912 if (phii1.ne.phii1) phii1=150.0
4917 ityp3=ithetyp(itype(i))
4919 cosph2(k)=dcos(k*phii1)
4920 sinph2(k)=dsin(k*phii1)
4924 ityp3=ithetyp(itype(i))
4930 ethetai=aa0thet(ityp1,ityp2,ityp3)
4933 ccl=cosph1(l)*cosph2(k-l)
4934 ssl=sinph1(l)*sinph2(k-l)
4935 scl=sinph1(l)*cosph2(k-l)
4936 csl=cosph1(l)*sinph2(k-l)
4937 cosph1ph2(l,k)=ccl-ssl
4938 cosph1ph2(k,l)=ccl+ssl
4939 sinph1ph2(l,k)=scl+csl
4940 sinph1ph2(k,l)=scl-csl
4944 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4945 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4946 write (iout,*) "coskt and sinkt"
4948 write (iout,*) k,coskt(k),sinkt(k)
4952 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4953 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4956 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4957 & " ethetai",ethetai
4960 write (iout,*) "cosph and sinph"
4962 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4964 write (iout,*) "cosph1ph2 and sinph2ph2"
4967 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4968 & sinph1ph2(l,k),sinph1ph2(k,l)
4971 write(iout,*) "ethetai",ethetai
4975 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4976 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4977 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4978 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4979 ethetai=ethetai+sinkt(m)*aux
4980 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4981 dephii=dephii+k*sinkt(m)*(
4982 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4983 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4984 dephii1=dephii1+k*sinkt(m)*(
4985 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4986 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4988 & write (iout,*) "m",m," k",k," bbthet",
4989 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4990 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4991 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4992 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4996 & write(iout,*) "ethetai",ethetai
5000 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5001 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5002 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5003 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5004 ethetai=ethetai+sinkt(m)*aux
5005 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5006 dephii=dephii+l*sinkt(m)*(
5007 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5008 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5009 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5010 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5011 dephii1=dephii1+(k-l)*sinkt(m)*(
5012 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5013 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5014 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5015 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5017 write (iout,*) "m",m," k",k," l",l," ffthet",
5018 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5019 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5020 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5021 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5022 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5023 & cosph1ph2(k,l)*sinkt(m),
5024 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5031 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5032 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5033 & phii1*rad2deg,ethetai
5035 etheta=etheta+ethetai
5036 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5037 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5038 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5044 c-----------------------------------------------------------------------------
5045 subroutine esc(escloc)
5046 C Calculate the local energy of a side chain and its derivatives in the
5047 C corresponding virtual-bond valence angles THETA and the spherical angles
5049 implicit real*8 (a-h,o-z)
5050 include 'DIMENSIONS'
5051 include 'COMMON.GEO'
5052 include 'COMMON.LOCAL'
5053 include 'COMMON.VAR'
5054 include 'COMMON.INTERACT'
5055 include 'COMMON.DERIV'
5056 include 'COMMON.CHAIN'
5057 include 'COMMON.IOUNITS'
5058 include 'COMMON.NAMES'
5059 include 'COMMON.FFIELD'
5060 include 'COMMON.CONTROL'
5061 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5062 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5063 common /sccalc/ time11,time12,time112,theti,it,nlobit
5066 c write (iout,'(a)') 'ESC'
5067 do i=loc_start,loc_end
5069 if (it.eq.10) goto 1
5071 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5072 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5073 theti=theta(i+1)-pipol
5078 if (x(2).gt.pi-delta) then
5082 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5084 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5085 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5087 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5088 & ddersc0(1),dersc(1))
5089 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5090 & ddersc0(3),dersc(3))
5092 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5094 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5095 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5096 & dersc0(2),esclocbi,dersc02)
5097 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5099 call splinthet(x(2),0.5d0*delta,ss,ssd)
5104 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5106 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5107 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5109 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5111 c write (iout,*) escloci
5112 else if (x(2).lt.delta) then
5116 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5118 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5119 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5121 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5122 & ddersc0(1),dersc(1))
5123 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5124 & ddersc0(3),dersc(3))
5126 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5128 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5129 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5130 & dersc0(2),esclocbi,dersc02)
5131 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5136 call splinthet(x(2),0.5d0*delta,ss,ssd)
5138 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5140 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5141 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5143 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5144 c write (iout,*) escloci
5146 call enesc(x,escloci,dersc,ddummy,.false.)
5149 escloc=escloc+escloci
5150 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5151 & 'escloc',i,escloci
5152 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5154 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5156 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5157 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5162 C---------------------------------------------------------------------------
5163 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5164 implicit real*8 (a-h,o-z)
5165 include 'DIMENSIONS'
5166 include 'COMMON.GEO'
5167 include 'COMMON.LOCAL'
5168 include 'COMMON.IOUNITS'
5169 common /sccalc/ time11,time12,time112,theti,it,nlobit
5170 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5171 double precision contr(maxlob,-1:1)
5173 c write (iout,*) 'it=',it,' nlobit=',nlobit
5177 if (mixed) ddersc(j)=0.0d0
5181 C Because of periodicity of the dependence of the SC energy in omega we have
5182 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5183 C To avoid underflows, first compute & store the exponents.
5191 z(k)=x(k)-censc(k,j,it)
5196 Axk=Axk+gaussc(l,k,j,it)*z(l)
5202 expfac=expfac+Ax(k,j,iii)*z(k)
5210 C As in the case of ebend, we want to avoid underflows in exponentiation and
5211 C subsequent NaNs and INFs in energy calculation.
5212 C Find the largest exponent
5216 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5220 cd print *,'it=',it,' emin=',emin
5222 C Compute the contribution to SC energy and derivatives
5227 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5228 if(adexp.ne.adexp) adexp=1.0
5231 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5233 cd print *,'j=',j,' expfac=',expfac
5234 escloc_i=escloc_i+expfac
5236 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5240 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5241 & +gaussc(k,2,j,it))*expfac
5248 dersc(1)=dersc(1)/cos(theti)**2
5249 ddersc(1)=ddersc(1)/cos(theti)**2
5252 escloci=-(dlog(escloc_i)-emin)
5254 dersc(j)=dersc(j)/escloc_i
5258 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5263 C------------------------------------------------------------------------------
5264 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5265 implicit real*8 (a-h,o-z)
5266 include 'DIMENSIONS'
5267 include 'COMMON.GEO'
5268 include 'COMMON.LOCAL'
5269 include 'COMMON.IOUNITS'
5270 common /sccalc/ time11,time12,time112,theti,it,nlobit
5271 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5272 double precision contr(maxlob)
5283 z(k)=x(k)-censc(k,j,it)
5289 Axk=Axk+gaussc(l,k,j,it)*z(l)
5295 expfac=expfac+Ax(k,j)*z(k)
5300 C As in the case of ebend, we want to avoid underflows in exponentiation and
5301 C subsequent NaNs and INFs in energy calculation.
5302 C Find the largest exponent
5305 if (emin.gt.contr(j)) emin=contr(j)
5309 C Compute the contribution to SC energy and derivatives
5313 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5314 escloc_i=escloc_i+expfac
5316 dersc(k)=dersc(k)+Ax(k,j)*expfac
5318 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5319 & +gaussc(1,2,j,it))*expfac
5323 dersc(1)=dersc(1)/cos(theti)**2
5324 dersc12=dersc12/cos(theti)**2
5325 escloci=-(dlog(escloc_i)-emin)
5327 dersc(j)=dersc(j)/escloc_i
5329 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5333 c----------------------------------------------------------------------------------
5334 subroutine esc(escloc)
5335 C Calculate the local energy of a side chain and its derivatives in the
5336 C corresponding virtual-bond valence angles THETA and the spherical angles
5337 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5338 C added by Urszula Kozlowska. 07/11/2007
5340 implicit real*8 (a-h,o-z)
5341 include 'DIMENSIONS'
5342 include 'COMMON.GEO'
5343 include 'COMMON.LOCAL'
5344 include 'COMMON.VAR'
5345 include 'COMMON.SCROT'
5346 include 'COMMON.INTERACT'
5347 include 'COMMON.DERIV'
5348 include 'COMMON.CHAIN'
5349 include 'COMMON.IOUNITS'
5350 include 'COMMON.NAMES'
5351 include 'COMMON.FFIELD'
5352 include 'COMMON.CONTROL'
5353 include 'COMMON.VECTORS'
5354 double precision x_prime(3),y_prime(3),z_prime(3)
5355 & , sumene,dsc_i,dp2_i,x(65),
5356 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5357 & de_dxx,de_dyy,de_dzz,de_dt
5358 double precision s1_t,s1_6_t,s2_t,s2_6_t
5360 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5361 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5362 & dt_dCi(3),dt_dCi1(3)
5363 common /sccalc/ time11,time12,time112,theti,it,nlobit
5366 c write(iout,*) "ESC: loc_start",loc_start," loc_end",loc_end
5367 do i=loc_start,loc_end
5368 costtab(i+1) =dcos(theta(i+1))
5369 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5370 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5371 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5372 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5373 cosfac=dsqrt(cosfac2)
5374 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5375 sinfac=dsqrt(sinfac2)
5377 if (it.eq.10) goto 1
5379 C Compute the axes of tghe local cartesian coordinates system; store in
5380 c x_prime, y_prime and z_prime
5387 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5388 C & dc_norm(3,i+nres)
5390 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5391 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5394 z_prime(j) = -uz(j,i-1)
5397 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5398 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5399 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5400 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5401 c & " xy",scalar(x_prime(1),y_prime(1)),
5402 c & " xz",scalar(x_prime(1),z_prime(1)),
5403 c & " yy",scalar(y_prime(1),y_prime(1)),
5404 c & " yz",scalar(y_prime(1),z_prime(1)),
5405 c & " zz",scalar(z_prime(1),z_prime(1))
5407 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5408 C to local coordinate system. Store in xx, yy, zz.
5414 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5415 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5416 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5423 C Compute the energy of the ith side cbain
5425 c write (2,*) "xx",xx," yy",yy," zz",zz
5428 x(j) = sc_parmin(j,it)
5431 Cc diagnostics - remove later
5433 yy1 = dsin(alph(2))*dcos(omeg(2))
5434 zz1 = -dsin(alph(2))*dsin(omeg(2))
5435 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5436 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5438 C," --- ", xx_w,yy_w,zz_w
5441 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5442 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5444 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5445 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5447 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5448 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5449 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5450 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5451 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5453 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5454 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5455 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5456 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5457 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5459 dsc_i = 0.743d0+x(61)
5461 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5462 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5463 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5464 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5465 s1=(1+x(63))/(0.1d0 + dscp1)
5466 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5467 s2=(1+x(65))/(0.1d0 + dscp2)
5468 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5469 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5470 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5471 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5473 c & dscp1,dscp2,sumene
5474 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5475 escloc = escloc + sumene
5476 c write (2,*) "i",i," escloc",sumene,escloc
5479 C This section to check the numerical derivatives of the energy of ith side
5480 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5481 C #define DEBUG in the code to turn it on.
5483 write (2,*) "sumene =",sumene
5487 write (2,*) xx,yy,zz
5488 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5489 de_dxx_num=(sumenep-sumene)/aincr
5491 write (2,*) "xx+ sumene from enesc=",sumenep
5494 write (2,*) xx,yy,zz
5495 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5496 de_dyy_num=(sumenep-sumene)/aincr
5498 write (2,*) "yy+ sumene from enesc=",sumenep
5501 write (2,*) xx,yy,zz
5502 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5503 de_dzz_num=(sumenep-sumene)/aincr
5505 write (2,*) "zz+ sumene from enesc=",sumenep
5506 costsave=cost2tab(i+1)
5507 sintsave=sint2tab(i+1)
5508 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5509 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5510 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5511 de_dt_num=(sumenep-sumene)/aincr
5512 write (2,*) " t+ sumene from enesc=",sumenep
5513 cost2tab(i+1)=costsave
5514 sint2tab(i+1)=sintsave
5515 C End of diagnostics section.
5518 C Compute the gradient of esc
5520 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5521 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5522 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5523 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5524 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5525 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5526 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5527 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5528 pom1=(sumene3*sint2tab(i+1)+sumene1)
5529 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5530 pom2=(sumene4*cost2tab(i+1)+sumene2)
5531 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5532 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5533 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5534 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5536 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5537 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5538 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5540 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5541 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5542 & +(pom1+pom2)*pom_dx
5544 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5547 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5548 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5549 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5551 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5552 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5553 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5554 & +x(59)*zz**2 +x(60)*xx*zz
5555 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5556 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5557 & +(pom1-pom2)*pom_dy
5559 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5562 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5563 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5564 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5565 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5566 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5567 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5568 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5569 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5571 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5574 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5575 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5576 & +pom1*pom_dt1+pom2*pom_dt2
5578 write(2,*), "de_dt = ", de_dt,de_dt_num
5582 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5583 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5584 cosfac2xx=cosfac2*xx
5585 sinfac2yy=sinfac2*yy
5587 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5589 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5591 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5592 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5593 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5594 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5595 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5596 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5597 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5598 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5599 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5600 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5604 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5605 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5608 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5609 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5610 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5612 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5613 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5617 dXX_Ctab(k,i)=dXX_Ci(k)
5618 dXX_C1tab(k,i)=dXX_Ci1(k)
5619 dYY_Ctab(k,i)=dYY_Ci(k)
5620 dYY_C1tab(k,i)=dYY_Ci1(k)
5621 dZZ_Ctab(k,i)=dZZ_Ci(k)
5622 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5623 dXX_XYZtab(k,i)=dXX_XYZ(k)
5624 dYY_XYZtab(k,i)=dYY_XYZ(k)
5625 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5629 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5630 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5631 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5632 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5633 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5635 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5636 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5637 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5638 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5639 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5640 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5641 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5642 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5644 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5645 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5647 C to check gradient call subroutine check_grad
5653 c------------------------------------------------------------------------------
5654 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5656 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5657 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5658 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5659 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5661 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5662 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5664 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5665 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5666 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5667 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5668 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5670 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5671 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5672 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5673 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5674 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5676 dsc_i = 0.743d0+x(61)
5678 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5679 & *(xx*cost2+yy*sint2))
5680 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5681 & *(xx*cost2-yy*sint2))
5682 s1=(1+x(63))/(0.1d0 + dscp1)
5683 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5684 s2=(1+x(65))/(0.1d0 + dscp2)
5685 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5686 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5687 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5692 c------------------------------------------------------------------------------
5693 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5695 C This procedure calculates two-body contact function g(rij) and its derivative:
5698 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5701 C where x=(rij-r0ij)/delta
5703 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5706 double precision rij,r0ij,eps0ij,fcont,fprimcont
5707 double precision x,x2,x4,delta
5711 if (x.lt.-1.0D0) then
5714 else if (x.le.1.0D0) then
5717 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5718 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5725 c------------------------------------------------------------------------------
5726 subroutine splinthet(theti,delta,ss,ssder)
5727 implicit real*8 (a-h,o-z)
5728 include 'DIMENSIONS'
5729 include 'COMMON.VAR'
5730 include 'COMMON.GEO'
5733 if (theti.gt.pipol) then
5734 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5736 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5741 c------------------------------------------------------------------------------
5742 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5744 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5745 double precision ksi,ksi2,ksi3,a1,a2,a3
5746 a1=fprim0*delta/(f1-f0)
5752 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5753 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5756 c------------------------------------------------------------------------------
5757 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5759 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5760 double precision ksi,ksi2,ksi3,a1,a2,a3
5765 a2=3*(f1x-f0x)-2*fprim0x*delta
5766 a3=fprim0x*delta-2*(f1x-f0x)
5767 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5770 C-----------------------------------------------------------------------------
5772 C-----------------------------------------------------------------------------
5773 subroutine etor(etors,edihcnstr)
5774 implicit real*8 (a-h,o-z)
5775 include 'DIMENSIONS'
5776 include 'COMMON.VAR'
5777 include 'COMMON.GEO'
5778 include 'COMMON.LOCAL'
5779 include 'COMMON.TORSION'
5780 include 'COMMON.INTERACT'
5781 include 'COMMON.DERIV'
5782 include 'COMMON.CHAIN'
5783 include 'COMMON.NAMES'
5784 include 'COMMON.IOUNITS'
5785 include 'COMMON.FFIELD'
5786 include 'COMMON.TORCNSTR'
5787 include 'COMMON.CONTROL'
5789 C Set lprn=.true. for debugging
5793 do i=iphi_start,iphi_end
5795 itori=itortyp(itype(i-2))
5796 itori1=itortyp(itype(i-1))
5799 C Proline-Proline pair is a special case...
5800 if (itori.eq.3 .and. itori1.eq.3) then
5801 if (phii.gt.-dwapi3) then
5803 fac=1.0D0/(1.0D0-cosphi)
5804 etorsi=v1(1,3,3)*fac
5805 etorsi=etorsi+etorsi
5806 etors=etors+etorsi-v1(1,3,3)
5807 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5808 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5811 v1ij=v1(j+1,itori,itori1)
5812 v2ij=v2(j+1,itori,itori1)
5815 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5816 if (energy_dec) etors_ii=etors_ii+
5817 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5818 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5822 v1ij=v1(j,itori,itori1)
5823 v2ij=v2(j,itori,itori1)
5826 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5827 if (energy_dec) etors_ii=etors_ii+
5828 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5829 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5832 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5835 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5836 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5837 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5838 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5839 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5841 ! 6/20/98 - dihedral angle constraints
5844 itori=idih_constr(i)
5847 if (difi.gt.drange(i)) then
5849 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5850 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5851 else if (difi.lt.-drange(i)) then
5853 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5854 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5856 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5857 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5859 ! write (iout,*) 'edihcnstr',edihcnstr
5862 c------------------------------------------------------------------------------
5863 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5864 subroutine e_modeller(ehomology_constr)
5865 ehomology_constr=0.0d0
5866 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5869 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5871 c------------------------------------------------------------------------------
5872 subroutine etor_d(etors_d)
5876 c----------------------------------------------------------------------------
5878 subroutine etor(etors,edihcnstr)
5879 implicit real*8 (a-h,o-z)
5880 include 'DIMENSIONS'
5881 include 'COMMON.VAR'
5882 include 'COMMON.GEO'
5883 include 'COMMON.LOCAL'
5884 include 'COMMON.TORSION'
5885 include 'COMMON.INTERACT'
5886 include 'COMMON.DERIV'
5887 include 'COMMON.CHAIN'
5888 include 'COMMON.NAMES'
5889 include 'COMMON.IOUNITS'
5890 include 'COMMON.FFIELD'
5891 include 'COMMON.TORCNSTR'
5892 include 'COMMON.CONTROL'
5894 C Set lprn=.true. for debugging
5898 do i=iphi_start,iphi_end
5900 itori=itortyp(itype(i-2))
5901 itori1=itortyp(itype(i-1))
5904 C Regular cosine and sine terms
5905 do j=1,nterm(itori,itori1)
5906 v1ij=v1(j,itori,itori1)
5907 v2ij=v2(j,itori,itori1)
5910 etors=etors+v1ij*cosphi+v2ij*sinphi
5911 if (energy_dec) etors_ii=etors_ii+
5912 & v1ij*cosphi+v2ij*sinphi
5913 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5917 C E = SUM ----------------------------------- - v1
5918 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5920 cosphi=dcos(0.5d0*phii)
5921 sinphi=dsin(0.5d0*phii)
5922 do j=1,nlor(itori,itori1)
5923 vl1ij=vlor1(j,itori,itori1)
5924 vl2ij=vlor2(j,itori,itori1)
5925 vl3ij=vlor3(j,itori,itori1)
5926 pom=vl2ij*cosphi+vl3ij*sinphi
5927 pom1=1.0d0/(pom*pom+1.0d0)
5928 etors=etors+vl1ij*pom1
5929 if (energy_dec) etors_ii=etors_ii+
5932 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5934 C Subtract the constant term
5935 etors=etors-v0(itori,itori1)
5936 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5937 & 'etor',i,etors_ii-v0(itori,itori1)
5939 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5940 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5941 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5942 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5943 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5945 ! 6/20/98 - dihedral angle constraints
5947 c do i=1,ndih_constr
5948 do i=idihconstr_start,idihconstr_end
5949 itori=idih_constr(i)
5951 difi=pinorm(phii-phi0(i))
5952 if (difi.gt.drange(i)) then
5954 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5955 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5956 else if (difi.lt.-drange(i)) then
5958 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5959 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5963 c write (iout,*) "gloci", gloc(i-3,icg)
5964 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5965 cd & rad2deg*phi0(i), rad2deg*drange(i),
5966 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5968 cd write (iout,*) 'edihcnstr',edihcnstr
5971 c----------------------------------------------------------------------------
5972 c MODELLER restraint function
5973 subroutine e_modeller(ehomology_constr)
5974 implicit real*8 (a-h,o-z)
5975 include 'DIMENSIONS'
5977 integer nnn, i, j, k, ki, irec, l
5978 integer katy, odleglosci, test7
5979 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
5981 real*8 distance(max_template),distancek(max_template),
5982 & min_odl,godl(max_template),dih_diff(max_template)
5985 c FP - 30/10/2014 Temporary specifications for homology restraints
5987 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
5989 double precision, dimension (maxres) :: guscdiff,usc_diff
5990 double precision, dimension (max_template) ::
5991 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
5995 include 'COMMON.SBRIDGE'
5996 include 'COMMON.CHAIN'
5997 include 'COMMON.GEO'
5998 include 'COMMON.DERIV'
5999 include 'COMMON.LOCAL'
6000 include 'COMMON.INTERACT'
6001 include 'COMMON.VAR'
6002 include 'COMMON.IOUNITS'
6004 include 'COMMON.CONTROL'
6006 c From subroutine Econstr_back
6008 include 'COMMON.NAMES'
6009 include 'COMMON.TIME1'
6014 distancek(i)=9999999.9
6020 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6022 C AL 5/2/14 - Introduce list of restraints
6023 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6025 write(iout,*) "------- dist restrs start -------"
6027 do ii = link_start_homo,link_end_homo
6031 c write (iout,*) "dij(",i,j,") =",dij
6032 do k=1,constr_homology
6033 distance(k)=odl(k,ii)-dij
6034 c write (iout,*) "distance(",k,") =",distance(k)
6036 c For Gaussian-type Urestr
6038 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6039 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6040 c write (iout,*) "distancek(",k,") =",distancek(k)
6041 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6043 c For Lorentzian-type Urestr
6045 if (waga_dist.lt.0.0d0) then
6046 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6047 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6048 & (distance(k)**2+sigma_odlir(k,ii)**2))
6052 min_odl=minval(distancek)
6053 c write (iout,* )"min_odl",min_odl
6055 write (iout,*) "ij dij",i,j,dij
6056 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6057 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6058 write (iout,* )"min_odl",min_odl
6061 do k=1,constr_homology
6062 c Nie wiem po co to liczycie jeszcze raz!
6063 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6064 c & (2*(sigma_odl(i,j,k))**2))
6065 if (waga_dist.ge.0.0d0) then
6067 c For Gaussian-type Urestr
6069 godl(k)=dexp(-distancek(k)+min_odl)
6070 odleg2=odleg2+godl(k)
6072 c For Lorentzian-type Urestr
6075 odleg2=odleg2+distancek(k)
6078 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6079 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6080 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6081 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6084 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6085 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6087 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6088 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6090 if (waga_dist.ge.0.0d0) then
6092 c For Gaussian-type Urestr
6094 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6096 c For Lorentzian-type Urestr
6099 odleg=odleg+odleg2/constr_homology
6102 c write (iout,*) "odleg",odleg ! sum of -ln-s
6105 c For Gaussian-type Urestr
6107 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6109 do k=1,constr_homology
6110 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6111 c & *waga_dist)+min_odl
6112 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6114 if (waga_dist.ge.0.0d0) then
6115 c For Gaussian-type Urestr
6117 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6119 c For Lorentzian-type Urestr
6122 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6123 & sigma_odlir(k,ii)**2)**2)
6125 sum_sgodl=sum_sgodl+sgodl
6127 c sgodl2=sgodl2+sgodl
6128 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6129 c write(iout,*) "constr_homology=",constr_homology
6130 c write(iout,*) i, j, k, "TEST K"
6132 if (waga_dist.ge.0.0d0) then
6134 c For Gaussian-type Urestr
6136 grad_odl3=waga_homology(iset)*waga_dist
6137 & *sum_sgodl/(sum_godl*dij)
6139 c For Lorentzian-type Urestr
6142 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6143 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6144 grad_odl3=-waga_homology(iset)*waga_dist*
6145 & sum_sgodl/(constr_homology*dij)
6148 c grad_odl3=sum_sgodl/(sum_godl*dij)
6151 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6152 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6153 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6155 ccc write(iout,*) godl, sgodl, grad_odl3
6157 c grad_odl=grad_odl+grad_odl3
6160 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6161 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6162 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6163 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6164 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6165 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6166 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6167 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6168 c if (i.eq.25.and.j.eq.27) then
6169 c write(iout,*) "jik",jik,"i",i,"j",j
6170 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
6171 c write(iout,*) "grad_odl3",grad_odl3
6172 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
6173 c write(iout,*) "ggodl",ggodl
6174 c write(iout,*) "ghpbc(",jik,i,")",
6175 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
6179 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6180 ccc & dLOG(odleg2),"-odleg=", -odleg
6182 enddo ! ii-loop for dist
6184 write(iout,*) "------- dist restrs end -------"
6185 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
6186 c & waga_d.eq.1.0d0) call sum_gradient
6188 c Pseudo-energy and gradient from dihedral-angle restraints from
6189 c homology templates
6190 c write (iout,*) "End of distance loop"
6193 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6195 write(iout,*) "------- dih restrs start -------"
6196 do i=idihconstr_start_homo,idihconstr_end_homo
6197 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
6200 do i=idihconstr_start_homo,idihconstr_end_homo
6202 c betai=beta(i,i+1,i+2,i+3)
6204 c write (iout,*) "betai =",betai
6205 do k=1,constr_homology
6206 dih_diff(k)=pinorm(dih(k,i)-betai)
6207 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
6208 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6209 c & -(6.28318-dih_diff(i,k))
6210 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6211 c & 6.28318+dih_diff(i,k)
6213 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6214 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
6217 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6220 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
6221 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
6223 write (iout,*) "i",i," betai",betai," kat2",kat2
6224 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6226 if (kat2.le.1.0d-14) cycle
6227 kat=kat-dLOG(kat2/constr_homology)
6228 c write (iout,*) "kat",kat ! sum of -ln-s
6230 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6231 ccc & dLOG(kat2), "-kat=", -kat
6233 c ----------------------------------------------------------------------
6235 c ----------------------------------------------------------------------
6239 do k=1,constr_homology
6240 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
6241 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
6242 sum_sgdih=sum_sgdih+sgdih
6244 c grad_dih3=sum_sgdih/sum_gdih
6245 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
6247 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6248 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6249 ccc & gloc(nphi+i-3,icg)
6250 gloc(i,icg)=gloc(i,icg)+grad_dih3
6252 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
6254 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6255 ccc & gloc(nphi+i-3,icg)
6257 enddo ! i-loop for dih
6259 write(iout,*) "------- dih restrs end -------"
6262 c Pseudo-energy and gradient for theta angle restraints from
6263 c homology templates
6264 c FP 01/15 - inserted from econstr_local_test.F, loop structure
6268 c For constr_homology reference structures (FP)
6270 c Uconst_back_tot=0.0d0
6273 c Econstr_back legacy
6275 c do i=ithet_start,ithet_end
6278 c do i=loc_start,loc_end
6281 duscdiffx(j,i)=0.0d0
6286 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
6287 c write (iout,*) "waga_theta",waga_theta
6288 if (waga_theta.gt.0.0d0) then
6290 write (iout,*) "usampl",usampl
6291 write(iout,*) "------- theta restrs start -------"
6292 c do i=ithet_start,ithet_end
6293 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
6296 c write (iout,*) "maxres",maxres,"nres",nres
6298 do i=ithet_start,ithet_end
6301 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
6303 c Deviation of theta angles wrt constr_homology ref structures
6305 utheta_i=0.0d0 ! argument of Gaussian for single k
6306 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6307 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
6308 c over residues in a fragment
6309 c write (iout,*) "theta(",i,")=",theta(i)
6310 do k=1,constr_homology
6312 c dtheta_i=theta(j)-thetaref(j,iref)
6313 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
6314 theta_diff(k)=thetatpl(k,i)-theta(i)
6316 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
6317 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
6318 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
6319 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
6320 c Gradient for single Gaussian restraint in subr Econstr_back
6321 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
6324 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
6325 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
6328 c Gradient for multiple Gaussian restraint
6329 sum_gtheta=gutheta_i
6331 do k=1,constr_homology
6332 c New generalized expr for multiple Gaussian from Econstr_back
6333 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
6335 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
6336 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
6338 c grad_theta3=sum_sgtheta/sum_gtheta 1/*theta(i)? s. line below
6339 c grad_theta3=sum_sgtheta/sum_gtheta
6341 c Final value of gradient using same var as in Econstr_back
6342 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)
6343 & +sum_sgtheta/sum_gtheta*waga_theta
6344 & *waga_homology(iset)
6345 c dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
6346 c & *waga_homology(iset)
6347 c dutheta(i)=sum_sgtheta/sum_gtheta
6349 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
6350 Eval=Eval-dLOG(gutheta_i/constr_homology)
6351 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
6352 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
6353 c Uconst_back=Uconst_back+utheta(i)
6354 enddo ! (i-loop for theta)
6356 write(iout,*) "------- theta restrs end -------"
6360 c Deviation of local SC geometry
6362 c Separation of two i-loops (instructed by AL - 11/3/2014)
6364 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
6365 c write (iout,*) "waga_d",waga_d
6368 write(iout,*) "------- SC restrs start -------"
6369 write (iout,*) "Initial duscdiff,duscdiffx"
6370 do i=loc_start,loc_end
6371 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
6372 & (duscdiffx(jik,i),jik=1,3)
6375 do i=loc_start,loc_end
6376 usc_diff_i=0.0d0 ! argument of Gaussian for single k
6377 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6378 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
6379 c write(iout,*) "xxtab, yytab, zztab"
6380 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
6381 do k=1,constr_homology
6383 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6384 c Original sign inverted for calc of gradients (s. Econstr_back)
6385 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6386 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6387 c write(iout,*) "dxx, dyy, dzz"
6388 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6390 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
6391 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
6392 c uscdiffk(k)=usc_diff(i)
6393 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
6394 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
6395 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
6396 c & xxref(j),yyref(j),zzref(j)
6401 c Generalized expression for multiple Gaussian acc to that for a single
6402 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
6404 c Original implementation
6405 c sum_guscdiff=guscdiff(i)
6407 c sum_sguscdiff=0.0d0
6408 c do k=1,constr_homology
6409 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
6410 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
6411 c sum_sguscdiff=sum_sguscdiff+sguscdiff
6414 c Implementation of new expressions for gradient (Jan. 2015)
6416 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
6417 do k=1,constr_homology
6419 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
6420 c before. Now the drivatives should be correct
6422 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6423 c Original sign inverted for calc of gradients (s. Econstr_back)
6424 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6425 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6427 c New implementation
6429 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
6430 & sigma_d(k,i) ! for the grad wrt r'
6431 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
6434 c New implementation
6435 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
6437 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
6438 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
6439 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
6440 duscdiff(jik,i)=duscdiff(jik,i)+
6441 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
6442 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
6443 duscdiffx(jik,i)=duscdiffx(jik,i)+
6444 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
6445 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
6448 write(iout,*) "jik",jik,"i",i
6449 write(iout,*) "dxx, dyy, dzz"
6450 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6451 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
6452 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
6453 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
6454 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
6455 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
6456 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
6457 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
6458 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
6459 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
6460 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
6461 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
6462 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
6463 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
6464 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
6470 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
6471 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
6473 c write (iout,*) i," uscdiff",uscdiff(i)
6475 c Put together deviations from local geometry
6477 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
6478 c & wfrag_back(3,i,iset)*uscdiff(i)
6479 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
6480 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
6481 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
6482 c Uconst_back=Uconst_back+usc_diff(i)
6484 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
6486 c New implment: multiplied by sum_sguscdiff
6489 enddo ! (i-loop for dscdiff)
6494 write(iout,*) "------- SC restrs end -------"
6495 write (iout,*) "------ After SC loop in e_modeller ------"
6496 do i=loc_start,loc_end
6497 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
6498 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
6500 if (waga_theta.eq.1.0d0) then
6501 write (iout,*) "in e_modeller after SC restr end: dutheta"
6502 do i=ithet_start,ithet_end
6503 write (iout,*) i,dutheta(i)
6506 if (waga_d.eq.1.0d0) then
6507 write (iout,*) "e_modeller after SC loop: duscdiff/x"
6509 write (iout,*) i,(duscdiff(j,i),j=1,3)
6510 write (iout,*) i,(duscdiffx(j,i),j=1,3)
6515 c Total energy from homology restraints
6517 write (iout,*) "odleg",odleg," kat",kat
6520 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
6522 c ehomology_constr=odleg+kat
6524 c For Lorentzian-type Urestr
6527 if (waga_dist.ge.0.0d0) then
6529 c For Gaussian-type Urestr
6531 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
6532 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6533 c write (iout,*) "ehomology_constr=",ehomology_constr
6536 c For Lorentzian-type Urestr
6538 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
6539 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6540 c write (iout,*) "ehomology_constr=",ehomology_constr
6543 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
6544 & "Eval",waga_theta,eval,
6545 & "Erot",waga_d,Erot
6546 write (iout,*) "ehomology_constr",ehomology_constr
6552 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6553 747 format(a12,i4,i4,i4,f8.3,f8.3)
6554 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6555 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6556 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6557 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6560 c------------------------------------------------------------------------------
6561 subroutine etor_d(etors_d)
6562 C 6/23/01 Compute double torsional energy
6563 implicit real*8 (a-h,o-z)
6564 include 'DIMENSIONS'
6565 include 'COMMON.VAR'
6566 include 'COMMON.GEO'
6567 include 'COMMON.LOCAL'
6568 include 'COMMON.TORSION'
6569 include 'COMMON.INTERACT'
6570 include 'COMMON.DERIV'
6571 include 'COMMON.CHAIN'
6572 include 'COMMON.NAMES'
6573 include 'COMMON.IOUNITS'
6574 include 'COMMON.FFIELD'
6575 include 'COMMON.TORCNSTR'
6577 C Set lprn=.true. for debugging
6581 do i=iphid_start,iphid_end
6582 itori=itortyp(itype(i-2))
6583 itori1=itortyp(itype(i-1))
6584 itori2=itortyp(itype(i))
6589 do j=1,ntermd_1(itori,itori1,itori2)
6590 v1cij=v1c(1,j,itori,itori1,itori2)
6591 v1sij=v1s(1,j,itori,itori1,itori2)
6592 v2cij=v1c(2,j,itori,itori1,itori2)
6593 v2sij=v1s(2,j,itori,itori1,itori2)
6594 cosphi1=dcos(j*phii)
6595 sinphi1=dsin(j*phii)
6596 cosphi2=dcos(j*phii1)
6597 sinphi2=dsin(j*phii1)
6598 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6599 & v2cij*cosphi2+v2sij*sinphi2
6600 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6601 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6603 do k=2,ntermd_2(itori,itori1,itori2)
6605 v1cdij = v2c(k,l,itori,itori1,itori2)
6606 v2cdij = v2c(l,k,itori,itori1,itori2)
6607 v1sdij = v2s(k,l,itori,itori1,itori2)
6608 v2sdij = v2s(l,k,itori,itori1,itori2)
6609 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6610 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6611 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6612 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6613 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6614 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6615 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6616 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6617 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6618 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6621 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6622 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6623 c write (iout,*) "gloci", gloc(i-3,icg)
6628 c------------------------------------------------------------------------------
6629 subroutine eback_sc_corr(esccor)
6630 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6631 c conformational states; temporarily implemented as differences
6632 c between UNRES torsional potentials (dependent on three types of
6633 c residues) and the torsional potentials dependent on all 20 types
6634 c of residues computed from AM1 energy surfaces of terminally-blocked
6635 c amino-acid residues.
6636 implicit real*8 (a-h,o-z)
6637 include 'DIMENSIONS'
6638 include 'COMMON.VAR'
6639 include 'COMMON.GEO'
6640 include 'COMMON.LOCAL'
6641 include 'COMMON.TORSION'
6642 include 'COMMON.SCCOR'
6643 include 'COMMON.INTERACT'
6644 include 'COMMON.DERIV'
6645 include 'COMMON.CHAIN'
6646 include 'COMMON.NAMES'
6647 include 'COMMON.IOUNITS'
6648 include 'COMMON.FFIELD'
6649 include 'COMMON.CONTROL'
6651 C Set lprn=.true. for debugging
6654 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6656 do i=itau_start,itau_end
6658 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6659 isccori=isccortyp(itype(i-2))
6660 isccori1=isccortyp(itype(i-1))
6662 cccc Added 9 May 2012
6663 cc Tauangle is torsional engle depending on the value of first digit
6664 c(see comment below)
6665 cc Omicron is flat angle depending on the value of first digit
6666 c(see comment below)
6669 do intertyp=1,3 !intertyp
6670 cc Added 09 May 2012 (Adasko)
6671 cc Intertyp means interaction type of backbone mainchain correlation:
6672 c 1 = SC...Ca...Ca...Ca
6673 c 2 = Ca...Ca...Ca...SC
6674 c 3 = SC...Ca...Ca...SCi
6676 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6677 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6678 & (itype(i-1).eq.21)))
6679 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6680 & .or.(itype(i-2).eq.21)))
6681 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6682 & (itype(i-1).eq.21)))) cycle
6683 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6684 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6686 do j=1,nterm_sccor(isccori,isccori1)
6687 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6688 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6689 cosphi=dcos(j*tauangle(intertyp,i))
6690 sinphi=dsin(j*tauangle(intertyp,i))
6691 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6692 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6694 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6695 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6696 c &gloc_sc(intertyp,i-3,icg)
6698 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6699 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6700 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6701 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6702 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6706 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6710 c----------------------------------------------------------------------------
6711 subroutine multibody(ecorr)
6712 C This subroutine calculates multi-body contributions to energy following
6713 C the idea of Skolnick et al. If side chains I and J make a contact and
6714 C at the same time side chains I+1 and J+1 make a contact, an extra
6715 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6716 implicit real*8 (a-h,o-z)
6717 include 'DIMENSIONS'
6718 include 'COMMON.IOUNITS'
6719 include 'COMMON.DERIV'
6720 include 'COMMON.INTERACT'
6721 include 'COMMON.CONTACTS'
6722 double precision gx(3),gx1(3)
6725 C Set lprn=.true. for debugging
6729 write (iout,'(a)') 'Contact function values:'
6731 write (iout,'(i2,20(1x,i2,f10.5))')
6732 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6747 num_conti=num_cont(i)
6748 num_conti1=num_cont(i1)
6753 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6754 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6755 cd & ' ishift=',ishift
6756 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6757 C The system gains extra energy.
6758 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6759 endif ! j1==j+-ishift
6768 c------------------------------------------------------------------------------
6769 double precision function esccorr(i,j,k,l,jj,kk)
6770 implicit real*8 (a-h,o-z)
6771 include 'DIMENSIONS'
6772 include 'COMMON.IOUNITS'
6773 include 'COMMON.DERIV'
6774 include 'COMMON.INTERACT'
6775 include 'COMMON.CONTACTS'
6776 double precision gx(3),gx1(3)
6781 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6782 C Calculate the multi-body contribution to energy.
6783 C Calculate multi-body contributions to the gradient.
6784 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6785 cd & k,l,(gacont(m,kk,k),m=1,3)
6787 gx(m) =ekl*gacont(m,jj,i)
6788 gx1(m)=eij*gacont(m,kk,k)
6789 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6790 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6791 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6792 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6796 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6801 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6807 c------------------------------------------------------------------------------
6808 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6809 C This subroutine calculates multi-body contributions to hydrogen-bonding
6810 implicit real*8 (a-h,o-z)
6811 include 'DIMENSIONS'
6812 include 'COMMON.IOUNITS'
6815 parameter (max_cont=maxconts)
6816 parameter (max_dim=26)
6817 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6818 double precision zapas(max_dim,maxconts,max_fg_procs),
6819 & zapas_recv(max_dim,maxconts,max_fg_procs)
6820 common /przechowalnia/ zapas
6821 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6822 & status_array(MPI_STATUS_SIZE,maxconts*2)
6824 include 'COMMON.SETUP'
6825 include 'COMMON.FFIELD'
6826 include 'COMMON.DERIV'
6827 include 'COMMON.INTERACT'
6828 include 'COMMON.CONTACTS'
6829 include 'COMMON.CONTROL'
6830 include 'COMMON.LOCAL'
6831 double precision gx(3),gx1(3),time00
6834 C Set lprn=.true. for debugging
6839 if (nfgtasks.le.1) goto 30
6841 write (iout,'(a)') 'Contact function values before RECEIVE:'
6843 write (iout,'(2i3,50(1x,i2,f5.2))')
6844 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6845 & j=1,num_cont_hb(i))
6849 do i=1,ntask_cont_from
6852 do i=1,ntask_cont_to
6855 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6857 C Make the list of contacts to send to send to other procesors
6858 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6860 do i=iturn3_start,iturn3_end
6861 c write (iout,*) "make contact list turn3",i," num_cont",
6863 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6865 do i=iturn4_start,iturn4_end
6866 c write (iout,*) "make contact list turn4",i," num_cont",
6868 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6872 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6874 do j=1,num_cont_hb(i)
6877 iproc=iint_sent_local(k,jjc,ii)
6878 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6879 if (iproc.gt.0) then
6880 ncont_sent(iproc)=ncont_sent(iproc)+1
6881 nn=ncont_sent(iproc)
6883 zapas(2,nn,iproc)=jjc
6884 zapas(3,nn,iproc)=facont_hb(j,i)
6885 zapas(4,nn,iproc)=ees0p(j,i)
6886 zapas(5,nn,iproc)=ees0m(j,i)
6887 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6888 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6889 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6890 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6891 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6892 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6893 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6894 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6895 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6896 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6897 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6898 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6899 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6900 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6901 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6902 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6903 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6904 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6905 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6906 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6907 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6914 & "Numbers of contacts to be sent to other processors",
6915 & (ncont_sent(i),i=1,ntask_cont_to)
6916 write (iout,*) "Contacts sent"
6917 do ii=1,ntask_cont_to
6919 iproc=itask_cont_to(ii)
6920 write (iout,*) nn," contacts to processor",iproc,
6921 & " of CONT_TO_COMM group"
6923 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6931 CorrelID1=nfgtasks+fg_rank+1
6933 C Receive the numbers of needed contacts from other processors
6934 do ii=1,ntask_cont_from
6935 iproc=itask_cont_from(ii)
6937 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6938 & FG_COMM,req(ireq),IERR)
6940 c write (iout,*) "IRECV ended"
6942 C Send the number of contacts needed by other processors
6943 do ii=1,ntask_cont_to
6944 iproc=itask_cont_to(ii)
6946 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6947 & FG_COMM,req(ireq),IERR)
6949 c write (iout,*) "ISEND ended"
6950 c write (iout,*) "number of requests (nn)",ireq
6953 & call MPI_Waitall(ireq,req,status_array,ierr)
6955 c & "Numbers of contacts to be received from other processors",
6956 c & (ncont_recv(i),i=1,ntask_cont_from)
6960 do ii=1,ntask_cont_from
6961 iproc=itask_cont_from(ii)
6963 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6964 c & " of CONT_TO_COMM group"
6968 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6969 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6970 c write (iout,*) "ireq,req",ireq,req(ireq)
6973 C Send the contacts to processors that need them
6974 do ii=1,ntask_cont_to
6975 iproc=itask_cont_to(ii)
6977 c write (iout,*) nn," contacts to processor",iproc,
6978 c & " of CONT_TO_COMM group"
6981 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6982 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6983 c write (iout,*) "ireq,req",ireq,req(ireq)
6985 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6989 c write (iout,*) "number of requests (contacts)",ireq
6990 c write (iout,*) "req",(req(i),i=1,4)
6993 & call MPI_Waitall(ireq,req,status_array,ierr)
6994 do iii=1,ntask_cont_from
6995 iproc=itask_cont_from(iii)
6998 write (iout,*) "Received",nn," contacts from processor",iproc,
6999 & " of CONT_FROM_COMM group"
7002 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7007 ii=zapas_recv(1,i,iii)
7008 c Flag the received contacts to prevent double-counting
7009 jj=-zapas_recv(2,i,iii)
7010 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7012 nnn=num_cont_hb(ii)+1
7015 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7016 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7017 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7018 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7019 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7020 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7021 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7022 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7023 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7024 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7025 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7026 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7027 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7028 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7029 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7030 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7031 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7032 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7033 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7034 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7035 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7036 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7037 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7038 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7043 write (iout,'(a)') 'Contact function values after receive:'
7045 write (iout,'(2i3,50(1x,i3,f5.2))')
7046 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7047 & j=1,num_cont_hb(i))
7054 write (iout,'(a)') 'Contact function values:'
7056 write (iout,'(2i3,50(1x,i3,f5.2))')
7057 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7058 & j=1,num_cont_hb(i))
7062 C Remove the loop below after debugging !!!
7069 C Calculate the local-electrostatic correlation terms
7070 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7072 num_conti=num_cont_hb(i)
7073 num_conti1=num_cont_hb(i+1)
7080 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7081 c & ' jj=',jj,' kk=',kk
7082 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7083 & .or. j.lt.0 .and. j1.gt.0) .and.
7084 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7085 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7086 C The system gains extra energy.
7087 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7088 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7089 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7091 else if (j1.eq.j) then
7092 C Contacts I-J and I-(J+1) occur simultaneously.
7093 C The system loses extra energy.
7094 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7099 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7100 c & ' jj=',jj,' kk=',kk
7102 C Contacts I-J and (I+1)-J occur simultaneously.
7103 C The system loses extra energy.
7104 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7111 c------------------------------------------------------------------------------
7112 subroutine add_hb_contact(ii,jj,itask)
7113 implicit real*8 (a-h,o-z)
7114 include "DIMENSIONS"
7115 include "COMMON.IOUNITS"
7118 parameter (max_cont=maxconts)
7119 parameter (max_dim=26)
7120 include "COMMON.CONTACTS"
7121 double precision zapas(max_dim,maxconts,max_fg_procs),
7122 & zapas_recv(max_dim,maxconts,max_fg_procs)
7123 common /przechowalnia/ zapas
7124 integer i,j,ii,jj,iproc,itask(4),nn
7125 c write (iout,*) "itask",itask
7128 if (iproc.gt.0) then
7129 do j=1,num_cont_hb(ii)
7131 c write (iout,*) "i",ii," j",jj," jjc",jjc
7133 ncont_sent(iproc)=ncont_sent(iproc)+1
7134 nn=ncont_sent(iproc)
7135 zapas(1,nn,iproc)=ii
7136 zapas(2,nn,iproc)=jjc
7137 zapas(3,nn,iproc)=facont_hb(j,ii)
7138 zapas(4,nn,iproc)=ees0p(j,ii)
7139 zapas(5,nn,iproc)=ees0m(j,ii)
7140 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7141 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7142 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7143 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7144 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7145 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7146 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7147 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7148 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7149 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7150 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7151 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7152 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7153 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7154 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7155 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7156 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7157 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7158 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7159 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7160 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7168 c------------------------------------------------------------------------------
7169 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7171 C This subroutine calculates multi-body contributions to hydrogen-bonding
7172 implicit real*8 (a-h,o-z)
7173 include 'DIMENSIONS'
7174 include 'COMMON.IOUNITS'
7177 parameter (max_cont=maxconts)
7178 parameter (max_dim=70)
7179 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7180 double precision zapas(max_dim,maxconts,max_fg_procs),
7181 & zapas_recv(max_dim,maxconts,max_fg_procs)
7182 common /przechowalnia/ zapas
7183 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7184 & status_array(MPI_STATUS_SIZE,maxconts*2)
7186 include 'COMMON.SETUP'
7187 include 'COMMON.FFIELD'
7188 include 'COMMON.DERIV'
7189 include 'COMMON.LOCAL'
7190 include 'COMMON.INTERACT'
7191 include 'COMMON.CONTACTS'
7192 include 'COMMON.CHAIN'
7193 include 'COMMON.CONTROL'
7194 double precision gx(3),gx1(3)
7195 integer num_cont_hb_old(maxres)
7197 double precision eello4,eello5,eelo6,eello_turn6
7198 external eello4,eello5,eello6,eello_turn6
7199 C Set lprn=.true. for debugging
7204 num_cont_hb_old(i)=num_cont_hb(i)
7208 if (nfgtasks.le.1) goto 30
7210 write (iout,'(a)') 'Contact function values before RECEIVE:'
7212 write (iout,'(2i3,50(1x,i2,f5.2))')
7213 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7214 & j=1,num_cont_hb(i))
7218 do i=1,ntask_cont_from
7221 do i=1,ntask_cont_to
7224 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7226 C Make the list of contacts to send to send to other procesors
7227 do i=iturn3_start,iturn3_end
7228 c write (iout,*) "make contact list turn3",i," num_cont",
7230 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7232 do i=iturn4_start,iturn4_end
7233 c write (iout,*) "make contact list turn4",i," num_cont",
7235 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7239 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7241 do j=1,num_cont_hb(i)
7244 iproc=iint_sent_local(k,jjc,ii)
7245 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7246 if (iproc.ne.0) then
7247 ncont_sent(iproc)=ncont_sent(iproc)+1
7248 nn=ncont_sent(iproc)
7250 zapas(2,nn,iproc)=jjc
7251 zapas(3,nn,iproc)=d_cont(j,i)
7255 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7260 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7268 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7279 & "Numbers of contacts to be sent to other processors",
7280 & (ncont_sent(i),i=1,ntask_cont_to)
7281 write (iout,*) "Contacts sent"
7282 do ii=1,ntask_cont_to
7284 iproc=itask_cont_to(ii)
7285 write (iout,*) nn," contacts to processor",iproc,
7286 & " of CONT_TO_COMM group"
7288 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7296 CorrelID1=nfgtasks+fg_rank+1
7298 C Receive the numbers of needed contacts from other processors
7299 do ii=1,ntask_cont_from
7300 iproc=itask_cont_from(ii)
7302 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7303 & FG_COMM,req(ireq),IERR)
7305 c write (iout,*) "IRECV ended"
7307 C Send the number of contacts needed by other processors
7308 do ii=1,ntask_cont_to
7309 iproc=itask_cont_to(ii)
7311 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7312 & FG_COMM,req(ireq),IERR)
7314 c write (iout,*) "ISEND ended"
7315 c write (iout,*) "number of requests (nn)",ireq
7318 & call MPI_Waitall(ireq,req,status_array,ierr)
7320 c & "Numbers of contacts to be received from other processors",
7321 c & (ncont_recv(i),i=1,ntask_cont_from)
7325 do ii=1,ntask_cont_from
7326 iproc=itask_cont_from(ii)
7328 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7329 c & " of CONT_TO_COMM group"
7333 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7334 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7335 c write (iout,*) "ireq,req",ireq,req(ireq)
7338 C Send the contacts to processors that need them
7339 do ii=1,ntask_cont_to
7340 iproc=itask_cont_to(ii)
7342 c write (iout,*) nn," contacts to processor",iproc,
7343 c & " of CONT_TO_COMM group"
7346 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7347 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7348 c write (iout,*) "ireq,req",ireq,req(ireq)
7350 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7354 c write (iout,*) "number of requests (contacts)",ireq
7355 c write (iout,*) "req",(req(i),i=1,4)
7358 & call MPI_Waitall(ireq,req,status_array,ierr)
7359 do iii=1,ntask_cont_from
7360 iproc=itask_cont_from(iii)
7363 write (iout,*) "Received",nn," contacts from processor",iproc,
7364 & " of CONT_FROM_COMM group"
7367 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7372 ii=zapas_recv(1,i,iii)
7373 c Flag the received contacts to prevent double-counting
7374 jj=-zapas_recv(2,i,iii)
7375 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7377 nnn=num_cont_hb(ii)+1
7380 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7384 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7389 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7397 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7406 write (iout,'(a)') 'Contact function values after receive:'
7408 write (iout,'(2i3,50(1x,i3,5f6.3))')
7409 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7410 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7417 write (iout,'(a)') 'Contact function values:'
7419 write (iout,'(2i3,50(1x,i2,5f6.3))')
7420 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7421 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7427 C Remove the loop below after debugging !!!
7434 C Calculate the dipole-dipole interaction energies
7435 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7436 do i=iatel_s,iatel_e+1
7437 num_conti=num_cont_hb(i)
7446 C Calculate the local-electrostatic correlation terms
7447 c write (iout,*) "gradcorr5 in eello5 before loop"
7449 c write (iout,'(i5,3f10.5)')
7450 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7452 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7453 c write (iout,*) "corr loop i",i
7455 num_conti=num_cont_hb(i)
7456 num_conti1=num_cont_hb(i+1)
7463 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7464 c & ' jj=',jj,' kk=',kk
7465 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7466 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7467 & .or. j.lt.0 .and. j1.gt.0) .and.
7468 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7469 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7470 C The system gains extra energy.
7472 sqd1=dsqrt(d_cont(jj,i))
7473 sqd2=dsqrt(d_cont(kk,i1))
7474 sred_geom = sqd1*sqd2
7475 IF (sred_geom.lt.cutoff_corr) THEN
7476 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7478 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7479 cd & ' jj=',jj,' kk=',kk
7480 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7481 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7483 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7484 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7487 cd write (iout,*) 'sred_geom=',sred_geom,
7488 cd & ' ekont=',ekont,' fprim=',fprimcont,
7489 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7490 cd write (iout,*) "g_contij",g_contij
7491 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7492 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7493 call calc_eello(i,jp,i+1,jp1,jj,kk)
7494 if (wcorr4.gt.0.0d0)
7495 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7496 if (energy_dec.and.wcorr4.gt.0.0d0)
7497 1 write (iout,'(a6,4i5,0pf7.3)')
7498 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7499 c write (iout,*) "gradcorr5 before eello5"
7501 c write (iout,'(i5,3f10.5)')
7502 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7504 if (wcorr5.gt.0.0d0)
7505 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7506 c write (iout,*) "gradcorr5 after eello5"
7508 c write (iout,'(i5,3f10.5)')
7509 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7511 if (energy_dec.and.wcorr5.gt.0.0d0)
7512 1 write (iout,'(a6,4i5,0pf7.3)')
7513 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7514 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7515 cd write(2,*)'ijkl',i,jp,i+1,jp1
7516 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7517 & .or. wturn6.eq.0.0d0))then
7518 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7519 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7520 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7521 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7522 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7523 cd & 'ecorr6=',ecorr6
7524 cd write (iout,'(4e15.5)') sred_geom,
7525 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7526 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7527 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7528 else if (wturn6.gt.0.0d0
7529 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7530 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7531 eturn6=eturn6+eello_turn6(i,jj,kk)
7532 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7533 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7534 cd write (2,*) 'multibody_eello:eturn6',eturn6
7543 num_cont_hb(i)=num_cont_hb_old(i)
7545 c write (iout,*) "gradcorr5 in eello5"
7547 c write (iout,'(i5,3f10.5)')
7548 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7552 c------------------------------------------------------------------------------
7553 subroutine add_hb_contact_eello(ii,jj,itask)
7554 implicit real*8 (a-h,o-z)
7555 include "DIMENSIONS"
7556 include "COMMON.IOUNITS"
7559 parameter (max_cont=maxconts)
7560 parameter (max_dim=70)
7561 include "COMMON.CONTACTS"
7562 double precision zapas(max_dim,maxconts,max_fg_procs),
7563 & zapas_recv(max_dim,maxconts,max_fg_procs)
7564 common /przechowalnia/ zapas
7565 integer i,j,ii,jj,iproc,itask(4),nn
7566 c write (iout,*) "itask",itask
7569 if (iproc.gt.0) then
7570 do j=1,num_cont_hb(ii)
7572 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7574 ncont_sent(iproc)=ncont_sent(iproc)+1
7575 nn=ncont_sent(iproc)
7576 zapas(1,nn,iproc)=ii
7577 zapas(2,nn,iproc)=jjc
7578 zapas(3,nn,iproc)=d_cont(j,ii)
7582 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7587 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7595 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7607 c------------------------------------------------------------------------------
7608 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7609 implicit real*8 (a-h,o-z)
7610 include 'DIMENSIONS'
7611 include 'COMMON.IOUNITS'
7612 include 'COMMON.DERIV'
7613 include 'COMMON.INTERACT'
7614 include 'COMMON.CONTACTS'
7615 double precision gx(3),gx1(3)
7625 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7626 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7627 C Following 4 lines for diagnostics.
7632 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7633 c & 'Contacts ',i,j,
7634 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7635 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7637 C Calculate the multi-body contribution to energy.
7638 c ecorr=ecorr+ekont*ees
7639 C Calculate multi-body contributions to the gradient.
7640 coeffpees0pij=coeffp*ees0pij
7641 coeffmees0mij=coeffm*ees0mij
7642 coeffpees0pkl=coeffp*ees0pkl
7643 coeffmees0mkl=coeffm*ees0mkl
7645 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7646 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7647 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7648 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7649 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7650 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7651 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7652 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7653 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7654 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7655 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7656 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7657 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7658 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7659 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7660 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7661 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7662 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7663 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7664 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7665 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7666 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7667 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7668 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7669 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7674 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7675 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7676 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7677 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7682 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7683 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7684 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7685 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7688 c write (iout,*) "ehbcorr",ekont*ees
7693 C---------------------------------------------------------------------------
7694 subroutine dipole(i,j,jj)
7695 implicit real*8 (a-h,o-z)
7696 include 'DIMENSIONS'
7697 include 'COMMON.IOUNITS'
7698 include 'COMMON.CHAIN'
7699 include 'COMMON.FFIELD'
7700 include 'COMMON.DERIV'
7701 include 'COMMON.INTERACT'
7702 include 'COMMON.CONTACTS'
7703 include 'COMMON.TORSION'
7704 include 'COMMON.VAR'
7705 include 'COMMON.GEO'
7706 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7708 iti1 = itortyp(itype(i+1))
7709 if (j.lt.nres-1) then
7710 itj1 = itortyp(itype(j+1))
7715 dipi(iii,1)=Ub2(iii,i)
7716 dipderi(iii)=Ub2der(iii,i)
7717 dipi(iii,2)=b1(iii,iti1)
7718 dipj(iii,1)=Ub2(iii,j)
7719 dipderj(iii)=Ub2der(iii,j)
7720 dipj(iii,2)=b1(iii,itj1)
7724 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7727 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7734 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7738 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7743 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7744 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7746 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7748 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7750 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7755 C---------------------------------------------------------------------------
7756 subroutine calc_eello(i,j,k,l,jj,kk)
7758 C This subroutine computes matrices and vectors needed to calculate
7759 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7761 implicit real*8 (a-h,o-z)
7762 include 'DIMENSIONS'
7763 include 'COMMON.IOUNITS'
7764 include 'COMMON.CHAIN'
7765 include 'COMMON.DERIV'
7766 include 'COMMON.INTERACT'
7767 include 'COMMON.CONTACTS'
7768 include 'COMMON.TORSION'
7769 include 'COMMON.VAR'
7770 include 'COMMON.GEO'
7771 include 'COMMON.FFIELD'
7772 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7773 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7776 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7777 cd & ' jj=',jj,' kk=',kk
7778 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7779 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7780 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7783 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7784 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7787 call transpose2(aa1(1,1),aa1t(1,1))
7788 call transpose2(aa2(1,1),aa2t(1,1))
7791 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7792 & aa1tder(1,1,lll,kkk))
7793 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7794 & aa2tder(1,1,lll,kkk))
7798 C parallel orientation of the two CA-CA-CA frames.
7800 iti=itortyp(itype(i))
7804 itk1=itortyp(itype(k+1))
7805 itj=itortyp(itype(j))
7806 if (l.lt.nres-1) then
7807 itl1=itortyp(itype(l+1))
7811 C A1 kernel(j+1) A2T
7813 cd write (iout,'(3f10.5,5x,3f10.5)')
7814 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7816 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7817 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7818 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7819 C Following matrices are needed only for 6-th order cumulants
7820 IF (wcorr6.gt.0.0d0) THEN
7821 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7822 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7823 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7824 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7825 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7826 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7827 & ADtEAderx(1,1,1,1,1,1))
7829 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7830 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7831 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7832 & ADtEA1derx(1,1,1,1,1,1))
7834 C End 6-th order cumulants
7837 cd write (2,*) 'In calc_eello6'
7839 cd write (2,*) 'iii=',iii
7841 cd write (2,*) 'kkk=',kkk
7843 cd write (2,'(3(2f10.5),5x)')
7844 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7849 call transpose2(EUgder(1,1,k),auxmat(1,1))
7850 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7851 call transpose2(EUg(1,1,k),auxmat(1,1))
7852 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7853 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7857 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7858 & EAEAderx(1,1,lll,kkk,iii,1))
7862 C A1T kernel(i+1) A2
7863 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7864 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7865 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7866 C Following matrices are needed only for 6-th order cumulants
7867 IF (wcorr6.gt.0.0d0) THEN
7868 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7869 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7870 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7871 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7872 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7873 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7874 & ADtEAderx(1,1,1,1,1,2))
7875 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7876 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7877 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7878 & ADtEA1derx(1,1,1,1,1,2))
7880 C End 6-th order cumulants
7881 call transpose2(EUgder(1,1,l),auxmat(1,1))
7882 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7883 call transpose2(EUg(1,1,l),auxmat(1,1))
7884 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7885 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7889 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7890 & EAEAderx(1,1,lll,kkk,iii,2))
7895 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7896 C They are needed only when the fifth- or the sixth-order cumulants are
7898 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7899 call transpose2(AEA(1,1,1),auxmat(1,1))
7900 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7901 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7902 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7903 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7904 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7905 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7906 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7907 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7908 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7909 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7910 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7911 call transpose2(AEA(1,1,2),auxmat(1,1))
7912 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7913 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7914 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7915 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7916 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7917 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7918 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7919 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7920 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7921 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7922 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7923 C Calculate the Cartesian derivatives of the vectors.
7927 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7928 call matvec2(auxmat(1,1),b1(1,iti),
7929 & AEAb1derx(1,lll,kkk,iii,1,1))
7930 call matvec2(auxmat(1,1),Ub2(1,i),
7931 & AEAb2derx(1,lll,kkk,iii,1,1))
7932 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7933 & AEAb1derx(1,lll,kkk,iii,2,1))
7934 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7935 & AEAb2derx(1,lll,kkk,iii,2,1))
7936 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7937 call matvec2(auxmat(1,1),b1(1,itj),
7938 & AEAb1derx(1,lll,kkk,iii,1,2))
7939 call matvec2(auxmat(1,1),Ub2(1,j),
7940 & AEAb2derx(1,lll,kkk,iii,1,2))
7941 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7942 & AEAb1derx(1,lll,kkk,iii,2,2))
7943 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7944 & AEAb2derx(1,lll,kkk,iii,2,2))
7951 C Antiparallel orientation of the two CA-CA-CA frames.
7953 iti=itortyp(itype(i))
7957 itk1=itortyp(itype(k+1))
7958 itl=itortyp(itype(l))
7959 itj=itortyp(itype(j))
7960 if (j.lt.nres-1) then
7961 itj1=itortyp(itype(j+1))
7965 C A2 kernel(j-1)T A1T
7966 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7967 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7968 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7969 C Following matrices are needed only for 6-th order cumulants
7970 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7971 & j.eq.i+4 .and. l.eq.i+3)) THEN
7972 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7973 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7974 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7975 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7976 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7977 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7978 & ADtEAderx(1,1,1,1,1,1))
7979 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7980 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7981 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7982 & ADtEA1derx(1,1,1,1,1,1))
7984 C End 6-th order cumulants
7985 call transpose2(EUgder(1,1,k),auxmat(1,1))
7986 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7987 call transpose2(EUg(1,1,k),auxmat(1,1))
7988 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7989 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7993 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7994 & EAEAderx(1,1,lll,kkk,iii,1))
7998 C A2T kernel(i+1)T A1
7999 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8000 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8001 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8002 C Following matrices are needed only for 6-th order cumulants
8003 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8004 & j.eq.i+4 .and. l.eq.i+3)) THEN
8005 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8006 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8007 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8008 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8009 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8010 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8011 & ADtEAderx(1,1,1,1,1,2))
8012 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8013 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8014 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8015 & ADtEA1derx(1,1,1,1,1,2))
8017 C End 6-th order cumulants
8018 call transpose2(EUgder(1,1,j),auxmat(1,1))
8019 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8020 call transpose2(EUg(1,1,j),auxmat(1,1))
8021 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8022 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8026 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8027 & EAEAderx(1,1,lll,kkk,iii,2))
8032 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8033 C They are needed only when the fifth- or the sixth-order cumulants are
8035 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8036 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8037 call transpose2(AEA(1,1,1),auxmat(1,1))
8038 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8039 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8040 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8041 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8042 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8043 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8044 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8045 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8046 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8047 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8048 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8049 call transpose2(AEA(1,1,2),auxmat(1,1))
8050 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8051 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8052 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8053 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8054 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8055 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8056 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8057 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8058 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8059 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8060 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8061 C Calculate the Cartesian derivatives of the vectors.
8065 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8066 call matvec2(auxmat(1,1),b1(1,iti),
8067 & AEAb1derx(1,lll,kkk,iii,1,1))
8068 call matvec2(auxmat(1,1),Ub2(1,i),
8069 & AEAb2derx(1,lll,kkk,iii,1,1))
8070 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8071 & AEAb1derx(1,lll,kkk,iii,2,1))
8072 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8073 & AEAb2derx(1,lll,kkk,iii,2,1))
8074 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8075 call matvec2(auxmat(1,1),b1(1,itl),
8076 & AEAb1derx(1,lll,kkk,iii,1,2))
8077 call matvec2(auxmat(1,1),Ub2(1,l),
8078 & AEAb2derx(1,lll,kkk,iii,1,2))
8079 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8080 & AEAb1derx(1,lll,kkk,iii,2,2))
8081 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8082 & AEAb2derx(1,lll,kkk,iii,2,2))
8091 C---------------------------------------------------------------------------
8092 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8093 & KK,KKderg,AKA,AKAderg,AKAderx)
8097 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8098 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8099 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8104 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8106 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8109 cd if (lprn) write (2,*) 'In kernel'
8111 cd if (lprn) write (2,*) 'kkk=',kkk
8113 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8114 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8116 cd write (2,*) 'lll=',lll
8117 cd write (2,*) 'iii=1'
8119 cd write (2,'(3(2f10.5),5x)')
8120 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8123 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8124 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8126 cd write (2,*) 'lll=',lll
8127 cd write (2,*) 'iii=2'
8129 cd write (2,'(3(2f10.5),5x)')
8130 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8137 C---------------------------------------------------------------------------
8138 double precision function eello4(i,j,k,l,jj,kk)
8139 implicit real*8 (a-h,o-z)
8140 include 'DIMENSIONS'
8141 include 'COMMON.IOUNITS'
8142 include 'COMMON.CHAIN'
8143 include 'COMMON.DERIV'
8144 include 'COMMON.INTERACT'
8145 include 'COMMON.CONTACTS'
8146 include 'COMMON.TORSION'
8147 include 'COMMON.VAR'
8148 include 'COMMON.GEO'
8149 double precision pizda(2,2),ggg1(3),ggg2(3)
8150 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8154 cd print *,'eello4:',i,j,k,l,jj,kk
8155 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8156 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8157 cold eij=facont_hb(jj,i)
8158 cold ekl=facont_hb(kk,k)
8160 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8161 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8162 gcorr_loc(k-1)=gcorr_loc(k-1)
8163 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8165 gcorr_loc(l-1)=gcorr_loc(l-1)
8166 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8168 gcorr_loc(j-1)=gcorr_loc(j-1)
8169 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8174 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8175 & -EAEAderx(2,2,lll,kkk,iii,1)
8176 cd derx(lll,kkk,iii)=0.0d0
8180 cd gcorr_loc(l-1)=0.0d0
8181 cd gcorr_loc(j-1)=0.0d0
8182 cd gcorr_loc(k-1)=0.0d0
8184 cd write (iout,*)'Contacts have occurred for peptide groups',
8185 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8186 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8187 if (j.lt.nres-1) then
8194 if (l.lt.nres-1) then
8202 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8203 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8204 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8205 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8206 cgrad ghalf=0.5d0*ggg1(ll)
8207 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8208 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8209 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8210 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8211 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8212 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8213 cgrad ghalf=0.5d0*ggg2(ll)
8214 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8215 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8216 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8217 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8218 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8219 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8223 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8228 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8233 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8238 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8242 cd write (2,*) iii,gcorr_loc(iii)
8245 cd write (2,*) 'ekont',ekont
8246 cd write (iout,*) 'eello4',ekont*eel4
8249 C---------------------------------------------------------------------------
8250 double precision function eello5(i,j,k,l,jj,kk)
8251 implicit real*8 (a-h,o-z)
8252 include 'DIMENSIONS'
8253 include 'COMMON.IOUNITS'
8254 include 'COMMON.CHAIN'
8255 include 'COMMON.DERIV'
8256 include 'COMMON.INTERACT'
8257 include 'COMMON.CONTACTS'
8258 include 'COMMON.TORSION'
8259 include 'COMMON.VAR'
8260 include 'COMMON.GEO'
8261 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8262 double precision ggg1(3),ggg2(3)
8263 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8268 C /l\ / \ \ / \ / \ / C
8269 C / \ / \ \ / \ / \ / C
8270 C j| o |l1 | o | o| o | | o |o C
8271 C \ |/k\| |/ \| / |/ \| |/ \| C
8272 C \i/ \ / \ / / \ / \ C
8274 C (I) (II) (III) (IV) C
8276 C eello5_1 eello5_2 eello5_3 eello5_4 C
8278 C Antiparallel chains C
8281 C /j\ / \ \ / \ / \ / C
8282 C / \ / \ \ / \ / \ / C
8283 C j1| o |l | o | o| o | | o |o C
8284 C \ |/k\| |/ \| / |/ \| |/ \| C
8285 C \i/ \ / \ / / \ / \ C
8287 C (I) (II) (III) (IV) C
8289 C eello5_1 eello5_2 eello5_3 eello5_4 C
8291 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8293 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8294 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8299 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8301 itk=itortyp(itype(k))
8302 itl=itortyp(itype(l))
8303 itj=itortyp(itype(j))
8308 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8309 cd & eel5_3_num,eel5_4_num)
8313 derx(lll,kkk,iii)=0.0d0
8317 cd eij=facont_hb(jj,i)
8318 cd ekl=facont_hb(kk,k)
8320 cd write (iout,*)'Contacts have occurred for peptide groups',
8321 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8323 C Contribution from the graph I.
8324 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8325 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8326 call transpose2(EUg(1,1,k),auxmat(1,1))
8327 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8328 vv(1)=pizda(1,1)-pizda(2,2)
8329 vv(2)=pizda(1,2)+pizda(2,1)
8330 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8331 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8332 C Explicit gradient in virtual-dihedral angles.
8333 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8334 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8335 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8336 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8337 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8338 vv(1)=pizda(1,1)-pizda(2,2)
8339 vv(2)=pizda(1,2)+pizda(2,1)
8340 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8341 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8342 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8343 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8344 vv(1)=pizda(1,1)-pizda(2,2)
8345 vv(2)=pizda(1,2)+pizda(2,1)
8347 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8348 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8349 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8351 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8352 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8353 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8355 C Cartesian gradient
8359 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8361 vv(1)=pizda(1,1)-pizda(2,2)
8362 vv(2)=pizda(1,2)+pizda(2,1)
8363 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8364 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8365 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8371 C Contribution from graph II
8372 call transpose2(EE(1,1,itk),auxmat(1,1))
8373 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8374 vv(1)=pizda(1,1)+pizda(2,2)
8375 vv(2)=pizda(2,1)-pizda(1,2)
8376 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8377 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8378 C Explicit gradient in virtual-dihedral angles.
8379 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8380 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8381 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8382 vv(1)=pizda(1,1)+pizda(2,2)
8383 vv(2)=pizda(2,1)-pizda(1,2)
8385 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8386 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8387 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8389 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8390 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8391 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8393 C Cartesian gradient
8397 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8399 vv(1)=pizda(1,1)+pizda(2,2)
8400 vv(2)=pizda(2,1)-pizda(1,2)
8401 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8402 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8403 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8411 C Parallel orientation
8412 C Contribution from graph III
8413 call transpose2(EUg(1,1,l),auxmat(1,1))
8414 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8415 vv(1)=pizda(1,1)-pizda(2,2)
8416 vv(2)=pizda(1,2)+pizda(2,1)
8417 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8418 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8419 C Explicit gradient in virtual-dihedral angles.
8420 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8421 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8422 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8423 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8424 vv(1)=pizda(1,1)-pizda(2,2)
8425 vv(2)=pizda(1,2)+pizda(2,1)
8426 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8427 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8428 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8429 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8430 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8431 vv(1)=pizda(1,1)-pizda(2,2)
8432 vv(2)=pizda(1,2)+pizda(2,1)
8433 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8434 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8435 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8436 C Cartesian gradient
8440 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8442 vv(1)=pizda(1,1)-pizda(2,2)
8443 vv(2)=pizda(1,2)+pizda(2,1)
8444 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8445 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8446 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8451 C Contribution from graph IV
8453 call transpose2(EE(1,1,itl),auxmat(1,1))
8454 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8455 vv(1)=pizda(1,1)+pizda(2,2)
8456 vv(2)=pizda(2,1)-pizda(1,2)
8457 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8458 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8459 C Explicit gradient in virtual-dihedral angles.
8460 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8461 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8462 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8463 vv(1)=pizda(1,1)+pizda(2,2)
8464 vv(2)=pizda(2,1)-pizda(1,2)
8465 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8466 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8467 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8468 C Cartesian gradient
8472 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8474 vv(1)=pizda(1,1)+pizda(2,2)
8475 vv(2)=pizda(2,1)-pizda(1,2)
8476 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8477 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8478 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8483 C Antiparallel orientation
8484 C Contribution from graph III
8486 call transpose2(EUg(1,1,j),auxmat(1,1))
8487 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8488 vv(1)=pizda(1,1)-pizda(2,2)
8489 vv(2)=pizda(1,2)+pizda(2,1)
8490 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8491 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8492 C Explicit gradient in virtual-dihedral angles.
8493 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8494 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8495 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8496 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8497 vv(1)=pizda(1,1)-pizda(2,2)
8498 vv(2)=pizda(1,2)+pizda(2,1)
8499 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8500 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8501 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8502 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8503 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8504 vv(1)=pizda(1,1)-pizda(2,2)
8505 vv(2)=pizda(1,2)+pizda(2,1)
8506 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8507 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8508 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8509 C Cartesian gradient
8513 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8515 vv(1)=pizda(1,1)-pizda(2,2)
8516 vv(2)=pizda(1,2)+pizda(2,1)
8517 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8518 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8519 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8524 C Contribution from graph IV
8526 call transpose2(EE(1,1,itj),auxmat(1,1))
8527 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8528 vv(1)=pizda(1,1)+pizda(2,2)
8529 vv(2)=pizda(2,1)-pizda(1,2)
8530 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8531 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8532 C Explicit gradient in virtual-dihedral angles.
8533 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8534 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8535 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8536 vv(1)=pizda(1,1)+pizda(2,2)
8537 vv(2)=pizda(2,1)-pizda(1,2)
8538 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8539 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8540 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8541 C Cartesian gradient
8545 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8547 vv(1)=pizda(1,1)+pizda(2,2)
8548 vv(2)=pizda(2,1)-pizda(1,2)
8549 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8550 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8551 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8557 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8558 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8559 cd write (2,*) 'ijkl',i,j,k,l
8560 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8561 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8563 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8564 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8565 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8566 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8567 if (j.lt.nres-1) then
8574 if (l.lt.nres-1) then
8584 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8585 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8586 C summed up outside the subrouine as for the other subroutines
8587 C handling long-range interactions. The old code is commented out
8588 C with "cgrad" to keep track of changes.
8590 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8591 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8592 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8593 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8594 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8595 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8596 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8597 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8598 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8599 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8601 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8602 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8603 cgrad ghalf=0.5d0*ggg1(ll)
8605 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8606 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8607 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8608 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8609 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8610 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8611 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8612 cgrad ghalf=0.5d0*ggg2(ll)
8614 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8615 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8616 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8617 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8618 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8619 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8624 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8625 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8630 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8631 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8637 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8642 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8646 cd write (2,*) iii,g_corr5_loc(iii)
8649 cd write (2,*) 'ekont',ekont
8650 cd write (iout,*) 'eello5',ekont*eel5
8653 c--------------------------------------------------------------------------
8654 double precision function eello6(i,j,k,l,jj,kk)
8655 implicit real*8 (a-h,o-z)
8656 include 'DIMENSIONS'
8657 include 'COMMON.IOUNITS'
8658 include 'COMMON.CHAIN'
8659 include 'COMMON.DERIV'
8660 include 'COMMON.INTERACT'
8661 include 'COMMON.CONTACTS'
8662 include 'COMMON.TORSION'
8663 include 'COMMON.VAR'
8664 include 'COMMON.GEO'
8665 include 'COMMON.FFIELD'
8666 double precision ggg1(3),ggg2(3)
8667 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8672 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8680 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8681 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8685 derx(lll,kkk,iii)=0.0d0
8689 cd eij=facont_hb(jj,i)
8690 cd ekl=facont_hb(kk,k)
8696 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8697 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8698 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8699 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8700 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8701 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8703 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8704 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8705 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8706 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8707 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8708 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8712 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8714 C If turn contributions are considered, they will be handled separately.
8715 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8716 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8717 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8718 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8719 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8720 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8721 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8723 if (j.lt.nres-1) then
8730 if (l.lt.nres-1) then
8738 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8739 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8740 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8741 cgrad ghalf=0.5d0*ggg1(ll)
8743 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8744 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8745 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8746 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8747 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8748 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8749 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8750 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8751 cgrad ghalf=0.5d0*ggg2(ll)
8752 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8754 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8755 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8756 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8757 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8758 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8759 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8764 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8765 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8770 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8771 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8777 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8782 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8786 cd write (2,*) iii,g_corr6_loc(iii)
8789 cd write (2,*) 'ekont',ekont
8790 cd write (iout,*) 'eello6',ekont*eel6
8793 c--------------------------------------------------------------------------
8794 double precision function eello6_graph1(i,j,k,l,imat,swap)
8795 implicit real*8 (a-h,o-z)
8796 include 'DIMENSIONS'
8797 include 'COMMON.IOUNITS'
8798 include 'COMMON.CHAIN'
8799 include 'COMMON.DERIV'
8800 include 'COMMON.INTERACT'
8801 include 'COMMON.CONTACTS'
8802 include 'COMMON.TORSION'
8803 include 'COMMON.VAR'
8804 include 'COMMON.GEO'
8805 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8809 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8811 C Parallel Antiparallel
8817 C \ j|/k\| / \ |/k\|l /
8822 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8823 itk=itortyp(itype(k))
8824 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8825 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8826 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8827 call transpose2(EUgC(1,1,k),auxmat(1,1))
8828 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8829 vv1(1)=pizda1(1,1)-pizda1(2,2)
8830 vv1(2)=pizda1(1,2)+pizda1(2,1)
8831 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8832 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8833 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8834 s5=scalar2(vv(1),Dtobr2(1,i))
8835 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8836 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8837 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8838 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8839 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8840 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8841 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8842 & +scalar2(vv(1),Dtobr2der(1,i)))
8843 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8844 vv1(1)=pizda1(1,1)-pizda1(2,2)
8845 vv1(2)=pizda1(1,2)+pizda1(2,1)
8846 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8847 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8849 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8850 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8851 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8852 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8853 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8855 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8856 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8857 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8858 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8859 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8861 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8862 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8863 vv1(1)=pizda1(1,1)-pizda1(2,2)
8864 vv1(2)=pizda1(1,2)+pizda1(2,1)
8865 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8866 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8867 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8868 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8877 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8878 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8879 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8880 call transpose2(EUgC(1,1,k),auxmat(1,1))
8881 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8883 vv1(1)=pizda1(1,1)-pizda1(2,2)
8884 vv1(2)=pizda1(1,2)+pizda1(2,1)
8885 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8886 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8887 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8888 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8889 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8890 s5=scalar2(vv(1),Dtobr2(1,i))
8891 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8897 c----------------------------------------------------------------------------
8898 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8899 implicit real*8 (a-h,o-z)
8900 include 'DIMENSIONS'
8901 include 'COMMON.IOUNITS'
8902 include 'COMMON.CHAIN'
8903 include 'COMMON.DERIV'
8904 include 'COMMON.INTERACT'
8905 include 'COMMON.CONTACTS'
8906 include 'COMMON.TORSION'
8907 include 'COMMON.VAR'
8908 include 'COMMON.GEO'
8910 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8911 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8914 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8916 C Parallel Antiparallel C
8922 C \ j|/k\| \ |/k\|l C
8927 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8928 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8929 C AL 7/4/01 s1 would occur in the sixth-order moment,
8930 C but not in a cluster cumulant
8932 s1=dip(1,jj,i)*dip(1,kk,k)
8934 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8935 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8936 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8937 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8938 call transpose2(EUg(1,1,k),auxmat(1,1))
8939 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8940 vv(1)=pizda(1,1)-pizda(2,2)
8941 vv(2)=pizda(1,2)+pizda(2,1)
8942 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8943 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8945 eello6_graph2=-(s1+s2+s3+s4)
8947 eello6_graph2=-(s2+s3+s4)
8950 C Derivatives in gamma(i-1)
8953 s1=dipderg(1,jj,i)*dip(1,kk,k)
8955 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8956 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8957 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8958 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8960 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8962 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8964 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8966 C Derivatives in gamma(k-1)
8968 s1=dip(1,jj,i)*dipderg(1,kk,k)
8970 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8971 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8972 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8973 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8974 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8975 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8976 vv(1)=pizda(1,1)-pizda(2,2)
8977 vv(2)=pizda(1,2)+pizda(2,1)
8978 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8980 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8982 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8984 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8985 C Derivatives in gamma(j-1) or gamma(l-1)
8988 s1=dipderg(3,jj,i)*dip(1,kk,k)
8990 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8991 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8992 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8993 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8994 vv(1)=pizda(1,1)-pizda(2,2)
8995 vv(2)=pizda(1,2)+pizda(2,1)
8996 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8999 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9001 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9004 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9005 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9007 C Derivatives in gamma(l-1) or gamma(j-1)
9010 s1=dip(1,jj,i)*dipderg(3,kk,k)
9012 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9013 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9014 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9015 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9016 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9017 vv(1)=pizda(1,1)-pizda(2,2)
9018 vv(2)=pizda(1,2)+pizda(2,1)
9019 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9022 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9024 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9027 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9028 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9030 C Cartesian derivatives.
9032 write (2,*) 'In eello6_graph2'
9034 write (2,*) 'iii=',iii
9036 write (2,*) 'kkk=',kkk
9038 write (2,'(3(2f10.5),5x)')
9039 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9049 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9051 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9054 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9056 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9057 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9059 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9060 call transpose2(EUg(1,1,k),auxmat(1,1))
9061 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9063 vv(1)=pizda(1,1)-pizda(2,2)
9064 vv(2)=pizda(1,2)+pizda(2,1)
9065 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9066 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9068 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9070 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9073 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9075 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9082 c----------------------------------------------------------------------------
9083 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9084 implicit real*8 (a-h,o-z)
9085 include 'DIMENSIONS'
9086 include 'COMMON.IOUNITS'
9087 include 'COMMON.CHAIN'
9088 include 'COMMON.DERIV'
9089 include 'COMMON.INTERACT'
9090 include 'COMMON.CONTACTS'
9091 include 'COMMON.TORSION'
9092 include 'COMMON.VAR'
9093 include 'COMMON.GEO'
9094 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9096 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9098 C Parallel Antiparallel C
9104 C j|/k\| / |/k\|l / C
9109 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9111 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9112 C energy moment and not to the cluster cumulant.
9113 iti=itortyp(itype(i))
9114 if (j.lt.nres-1) then
9115 itj1=itortyp(itype(j+1))
9119 itk=itortyp(itype(k))
9120 itk1=itortyp(itype(k+1))
9121 if (l.lt.nres-1) then
9122 itl1=itortyp(itype(l+1))
9127 s1=dip(4,jj,i)*dip(4,kk,k)
9129 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9130 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9131 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9132 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9133 call transpose2(EE(1,1,itk),auxmat(1,1))
9134 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9135 vv(1)=pizda(1,1)+pizda(2,2)
9136 vv(2)=pizda(2,1)-pizda(1,2)
9137 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9138 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9139 cd & "sum",-(s2+s3+s4)
9141 eello6_graph3=-(s1+s2+s3+s4)
9143 eello6_graph3=-(s2+s3+s4)
9146 C Derivatives in gamma(k-1)
9147 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9148 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9149 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9150 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9151 C Derivatives in gamma(l-1)
9152 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9153 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9154 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9155 vv(1)=pizda(1,1)+pizda(2,2)
9156 vv(2)=pizda(2,1)-pizda(1,2)
9157 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9158 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9159 C Cartesian derivatives.
9165 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9167 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9170 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9172 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9173 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9175 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9176 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9178 vv(1)=pizda(1,1)+pizda(2,2)
9179 vv(2)=pizda(2,1)-pizda(1,2)
9180 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9182 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9184 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9187 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9189 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9191 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9197 c----------------------------------------------------------------------------
9198 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9199 implicit real*8 (a-h,o-z)
9200 include 'DIMENSIONS'
9201 include 'COMMON.IOUNITS'
9202 include 'COMMON.CHAIN'
9203 include 'COMMON.DERIV'
9204 include 'COMMON.INTERACT'
9205 include 'COMMON.CONTACTS'
9206 include 'COMMON.TORSION'
9207 include 'COMMON.VAR'
9208 include 'COMMON.GEO'
9209 include 'COMMON.FFIELD'
9210 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9211 & auxvec1(2),auxmat1(2,2)
9213 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9215 C Parallel Antiparallel C
9221 C \ j|/k\| \ |/k\|l C
9226 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9228 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9229 C energy moment and not to the cluster cumulant.
9230 cd write (2,*) 'eello_graph4: wturn6',wturn6
9231 iti=itortyp(itype(i))
9232 itj=itortyp(itype(j))
9233 if (j.lt.nres-1) then
9234 itj1=itortyp(itype(j+1))
9238 itk=itortyp(itype(k))
9239 if (k.lt.nres-1) then
9240 itk1=itortyp(itype(k+1))
9244 itl=itortyp(itype(l))
9245 if (l.lt.nres-1) then
9246 itl1=itortyp(itype(l+1))
9250 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9251 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9252 cd & ' itl',itl,' itl1',itl1
9255 s1=dip(3,jj,i)*dip(3,kk,k)
9257 s1=dip(2,jj,j)*dip(2,kk,l)
9260 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9261 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9263 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9264 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9266 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9267 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9269 call transpose2(EUg(1,1,k),auxmat(1,1))
9270 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9271 vv(1)=pizda(1,1)-pizda(2,2)
9272 vv(2)=pizda(2,1)+pizda(1,2)
9273 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9274 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9276 eello6_graph4=-(s1+s2+s3+s4)
9278 eello6_graph4=-(s2+s3+s4)
9280 C Derivatives in gamma(i-1)
9284 s1=dipderg(2,jj,i)*dip(3,kk,k)
9286 s1=dipderg(4,jj,j)*dip(2,kk,l)
9289 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9291 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9292 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9294 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9295 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9297 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9298 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9299 cd write (2,*) 'turn6 derivatives'
9301 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9303 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9307 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9309 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9313 C Derivatives in gamma(k-1)
9316 s1=dip(3,jj,i)*dipderg(2,kk,k)
9318 s1=dip(2,jj,j)*dipderg(4,kk,l)
9321 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9322 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9324 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9325 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9327 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9328 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9330 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9331 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9332 vv(1)=pizda(1,1)-pizda(2,2)
9333 vv(2)=pizda(2,1)+pizda(1,2)
9334 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9335 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9337 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9339 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9343 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9345 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9348 C Derivatives in gamma(j-1) or gamma(l-1)
9349 if (l.eq.j+1 .and. l.gt.1) then
9350 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9351 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9352 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9353 vv(1)=pizda(1,1)-pizda(2,2)
9354 vv(2)=pizda(2,1)+pizda(1,2)
9355 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9356 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9357 else if (j.gt.1) then
9358 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9359 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9360 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9361 vv(1)=pizda(1,1)-pizda(2,2)
9362 vv(2)=pizda(2,1)+pizda(1,2)
9363 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9364 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9365 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9367 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9370 C Cartesian derivatives.
9377 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9379 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9383 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9385 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9389 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9391 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9393 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9394 & b1(1,itj1),auxvec(1))
9395 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9397 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9398 & b1(1,itl1),auxvec(1))
9399 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9401 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9403 vv(1)=pizda(1,1)-pizda(2,2)
9404 vv(2)=pizda(2,1)+pizda(1,2)
9405 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9407 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9409 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9412 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9415 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9418 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9420 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9422 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9426 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9428 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9431 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9433 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9441 c----------------------------------------------------------------------------
9442 double precision function eello_turn6(i,jj,kk)
9443 implicit real*8 (a-h,o-z)
9444 include 'DIMENSIONS'
9445 include 'COMMON.IOUNITS'
9446 include 'COMMON.CHAIN'
9447 include 'COMMON.DERIV'
9448 include 'COMMON.INTERACT'
9449 include 'COMMON.CONTACTS'
9450 include 'COMMON.TORSION'
9451 include 'COMMON.VAR'
9452 include 'COMMON.GEO'
9453 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9454 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9456 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9457 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9458 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9459 C the respective energy moment and not to the cluster cumulant.
9468 iti=itortyp(itype(i))
9469 itk=itortyp(itype(k))
9470 itk1=itortyp(itype(k+1))
9471 itl=itortyp(itype(l))
9472 itj=itortyp(itype(j))
9473 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9474 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9475 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9480 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9482 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9486 derx_turn(lll,kkk,iii)=0.0d0
9493 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9495 cd write (2,*) 'eello6_5',eello6_5
9497 call transpose2(AEA(1,1,1),auxmat(1,1))
9498 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9499 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9500 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9502 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9503 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9504 s2 = scalar2(b1(1,itk),vtemp1(1))
9506 call transpose2(AEA(1,1,2),atemp(1,1))
9507 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9508 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9509 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9511 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9512 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9513 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9515 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9516 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9517 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9518 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9519 ss13 = scalar2(b1(1,itk),vtemp4(1))
9520 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9522 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9528 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9529 C Derivatives in gamma(i+2)
9533 call transpose2(AEA(1,1,1),auxmatd(1,1))
9534 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9535 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9536 call transpose2(AEAderg(1,1,2),atempd(1,1))
9537 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9538 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9540 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9541 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9542 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9548 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9549 C Derivatives in gamma(i+3)
9551 call transpose2(AEA(1,1,1),auxmatd(1,1))
9552 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9553 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9554 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9556 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9557 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9558 s2d = scalar2(b1(1,itk),vtemp1d(1))
9560 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9561 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9563 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9565 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9566 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9567 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9575 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9576 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9578 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9579 & -0.5d0*ekont*(s2d+s12d)
9581 C Derivatives in gamma(i+4)
9582 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9583 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9584 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9586 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9587 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9588 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9596 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9598 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9600 C Derivatives in gamma(i+5)
9602 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9603 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9604 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9606 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9607 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9608 s2d = scalar2(b1(1,itk),vtemp1d(1))
9610 call transpose2(AEA(1,1,2),atempd(1,1))
9611 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9612 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9614 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9615 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9617 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9618 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9619 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9627 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9628 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9630 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9631 & -0.5d0*ekont*(s2d+s12d)
9633 C Cartesian derivatives
9638 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9639 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9640 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9642 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9643 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9645 s2d = scalar2(b1(1,itk),vtemp1d(1))
9647 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9648 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9649 s8d = -(atempd(1,1)+atempd(2,2))*
9650 & scalar2(cc(1,1,itl),vtemp2(1))
9652 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9654 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9655 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9662 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9665 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9669 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9670 & - 0.5d0*(s8d+s12d)
9672 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9681 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9683 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9684 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9685 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9686 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9687 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9689 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9690 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9691 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9695 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9696 cd & 16*eel_turn6_num
9698 if (j.lt.nres-1) then
9705 if (l.lt.nres-1) then
9713 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9714 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9715 cgrad ghalf=0.5d0*ggg1(ll)
9717 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9718 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9719 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9720 & +ekont*derx_turn(ll,2,1)
9721 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9722 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9723 & +ekont*derx_turn(ll,4,1)
9724 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9725 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9726 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9727 cgrad ghalf=0.5d0*ggg2(ll)
9729 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9730 & +ekont*derx_turn(ll,2,2)
9731 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9732 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9733 & +ekont*derx_turn(ll,4,2)
9734 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9735 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9736 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9741 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9746 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9752 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9757 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9761 cd write (2,*) iii,g_corr6_loc(iii)
9763 eello_turn6=ekont*eel_turn6
9764 cd write (2,*) 'ekont',ekont
9765 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9769 C-----------------------------------------------------------------------------
9770 double precision function scalar(u,v)
9771 !DIR$ INLINEALWAYS scalar
9773 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9776 double precision u(3),v(3)
9777 cd double precision sc
9785 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9788 crc-------------------------------------------------
9789 SUBROUTINE MATVEC2(A1,V1,V2)
9790 !DIR$ INLINEALWAYS MATVEC2
9792 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9794 implicit real*8 (a-h,o-z)
9795 include 'DIMENSIONS'
9796 DIMENSION A1(2,2),V1(2),V2(2)
9800 c 3 VI=VI+A1(I,K)*V1(K)
9804 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9805 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9810 C---------------------------------------
9811 SUBROUTINE MATMAT2(A1,A2,A3)
9813 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9815 implicit real*8 (a-h,o-z)
9816 include 'DIMENSIONS'
9817 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9818 c DIMENSION AI3(2,2)
9822 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9828 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9829 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9830 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9831 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9839 c-------------------------------------------------------------------------
9840 double precision function scalar2(u,v)
9841 !DIR$ INLINEALWAYS scalar2
9843 double precision u(2),v(2)
9846 scalar2=u(1)*v(1)+u(2)*v(2)
9850 C-----------------------------------------------------------------------------
9852 subroutine transpose2(a,at)
9853 !DIR$ INLINEALWAYS transpose2
9855 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9858 double precision a(2,2),at(2,2)
9865 c--------------------------------------------------------------------------
9866 subroutine transpose(n,a,at)
9869 double precision a(n,n),at(n,n)
9877 C---------------------------------------------------------------------------
9878 subroutine prodmat3(a1,a2,kk,transp,prod)
9879 !DIR$ INLINEALWAYS prodmat3
9881 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9885 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9887 crc double precision auxmat(2,2),prod_(2,2)
9890 crc call transpose2(kk(1,1),auxmat(1,1))
9891 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9892 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9894 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9895 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9896 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9897 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9898 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9899 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9900 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9901 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9904 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9905 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9907 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9908 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9909 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9910 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9911 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9912 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9913 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9914 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9917 c call transpose2(a2(1,1),a2t(1,1))
9920 crc print *,((prod_(i,j),i=1,2),j=1,2)
9921 crc print *,((prod(i,j),i=1,2),j=1,2)