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'
554 write (iout,*) "sum_gradient gvdwc, gvdwx"
556 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
557 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
558 & (gvdwcT(j,i),j=1,3)
563 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
564 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
565 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
568 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
569 C in virtual-bond-vector coordinates
572 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
574 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
575 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
577 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
579 c write (iout,'(i5,3f10.5,2x,f10.5)')
580 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
582 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
584 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
585 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
594 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
595 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
596 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
597 & wel_loc*gel_loc_long(j,i)+
598 & wcorr*gradcorr_long(j,i)+
599 & wcorr5*gradcorr5_long(j,i)+
600 & wcorr6*gradcorr6_long(j,i)+
601 & wturn6*gcorr6_turn_long(j,i)+
602 & wstrain*ghpbc(j,i)+
603 & wdfa_dist*gdfad(j,i)+
604 & wdfa_tor*gdfat(j,i)+
605 & wdfa_nei*gdfan(j,i)+
606 & wdfa_beta*gdfab(j,i)
612 gradbufc(j,i)=wsc*gvdwc(j,i)+
613 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
614 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
615 & wel_loc*gel_loc_long(j,i)+
616 & wcorr*gradcorr_long(j,i)+
617 & wcorr5*gradcorr5_long(j,i)+
618 & wcorr6*gradcorr6_long(j,i)+
619 & wturn6*gcorr6_turn_long(j,i)+
620 & wstrain*ghpbc(j,i)+
621 & wdfa_dist*gdfad(j,i)+
622 & wdfa_tor*gdfat(j,i)+
623 & wdfa_nei*gdfan(j,i)+
624 & wdfa_beta*gdfab(j,i)
631 gradbufc(j,i)=wsc*gvdwc(j,i)+
632 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
633 & welec*gelc_long(j,i)+
635 & wel_loc*gel_loc_long(j,i)+
636 & wcorr*gradcorr_long(j,i)+
637 & wcorr5*gradcorr5_long(j,i)+
638 & wcorr6*gradcorr6_long(j,i)+
639 & wturn6*gcorr6_turn_long(j,i)+
640 & wstrain*ghpbc(j,i)+
641 & wdfa_dist*gdfad(j,i)+
642 & wdfa_tor*gdfat(j,i)+
643 & wdfa_nei*gdfan(j,i)+
644 & wdfa_beta*gdfab(j,i)
649 if (nfgtasks.gt.1) then
652 write (iout,*) "gradbufc before allreduce"
654 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
660 gradbufc_sum(j,i)=gradbufc(j,i)
663 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
664 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
665 c time_reduce=time_reduce+MPI_Wtime()-time00
667 c write (iout,*) "gradbufc_sum after allreduce"
669 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
674 c time_allreduce=time_allreduce+MPI_Wtime()-time00
682 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
683 write (iout,*) (i," jgrad_start",jgrad_start(i),
684 & " jgrad_end ",jgrad_end(i),
685 & i=igrad_start,igrad_end)
688 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
689 c do not parallelize this part.
691 c do i=igrad_start,igrad_end
692 c do j=jgrad_start(i),jgrad_end(i)
694 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
699 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
703 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
707 write (iout,*) "gradbufc after summing"
709 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
716 write (iout,*) "gradbufc"
718 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
724 gradbufc_sum(j,i)=gradbufc(j,i)
729 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
733 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
738 c gradbufc(k,i)=0.0d0
742 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
747 write (iout,*) "gradbufc after summing"
749 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
757 gradbufc(k,nres)=0.0d0
762 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
763 & wel_loc*gel_loc(j,i)+
764 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
765 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
766 & wel_loc*gel_loc_long(j,i)+
767 & wcorr*gradcorr_long(j,i)+
768 & wcorr5*gradcorr5_long(j,i)+
769 & wcorr6*gradcorr6_long(j,i)+
770 & wturn6*gcorr6_turn_long(j,i))+
772 & wcorr*gradcorr(j,i)+
773 & wturn3*gcorr3_turn(j,i)+
774 & wturn4*gcorr4_turn(j,i)+
775 & wcorr5*gradcorr5(j,i)+
776 & wcorr6*gradcorr6(j,i)+
777 & wturn6*gcorr6_turn(j,i)+
778 & wsccor*gsccorc(j,i)
779 & +wscloc*gscloc(j,i)
781 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
782 & wel_loc*gel_loc(j,i)+
783 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
784 & welec*gelc_long(j,i)+
785 & wel_loc*gel_loc_long(j,i)+
786 & wcorr*gcorr_long(j,i)+
787 & wcorr5*gradcorr5_long(j,i)+
788 & wcorr6*gradcorr6_long(j,i)+
789 & wturn6*gcorr6_turn_long(j,i))+
791 & wcorr*gradcorr(j,i)+
792 & wturn3*gcorr3_turn(j,i)+
793 & wturn4*gcorr4_turn(j,i)+
794 & wcorr5*gradcorr5(j,i)+
795 & wcorr6*gradcorr6(j,i)+
796 & wturn6*gcorr6_turn(j,i)+
797 & wsccor*gsccorc(j,i)
798 & +wscloc*gscloc(j,i)
801 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
802 & wscp*gradx_scp(j,i)+
804 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
805 & wsccor*gsccorx(j,i)
806 & +wscloc*gsclocx(j,i)
808 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
810 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
811 & wsccor*gsccorx(j,i)
812 & +wscloc*gsclocx(j,i)
817 write (iout,*) "gloc before adding corr"
819 write (iout,*) i,gloc(i,icg)
823 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
824 & +wcorr5*g_corr5_loc(i)
825 & +wcorr6*g_corr6_loc(i)
826 & +wturn4*gel_loc_turn4(i)
827 & +wturn3*gel_loc_turn3(i)
828 & +wturn6*gel_loc_turn6(i)
829 & +wel_loc*gel_loc_loc(i)
832 write (iout,*) "gloc after adding corr"
834 write (iout,*) i,gloc(i,icg)
838 if (nfgtasks.gt.1) then
841 gradbufc(j,i)=gradc(j,i,icg)
842 gradbufx(j,i)=gradx(j,i,icg)
846 glocbuf(i)=gloc(i,icg)
849 write (iout,*) "gloc_sc before reduce"
852 write (iout,*) i,j,gloc_sc(j,i,icg)
858 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
862 call MPI_Barrier(FG_COMM,IERR)
863 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
865 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
866 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
867 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
868 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
869 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
870 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
871 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
872 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
873 time_reduce=time_reduce+MPI_Wtime()-time00
875 write (iout,*) "gloc_sc after reduce"
878 write (iout,*) i,j,gloc_sc(j,i,icg)
883 write (iout,*) "gloc after reduce"
885 write (iout,*) i,gloc(i,icg)
890 if (gnorm_check) then
892 c Compute the maximum elements of the gradient
902 gcorr3_turn_max=0.0d0
903 gcorr4_turn_max=0.0d0
906 gcorr6_turn_max=0.0d0
916 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
917 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
919 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
920 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
922 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
923 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
924 & gvdwc_scp_max=gvdwc_scp_norm
925 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
926 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
927 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
928 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
929 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
930 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
931 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
932 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
933 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
934 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
935 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
936 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
937 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
939 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
940 & gcorr3_turn_max=gcorr3_turn_norm
941 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
943 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
944 & gcorr4_turn_max=gcorr4_turn_norm
945 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
946 if (gradcorr5_norm.gt.gradcorr5_max)
947 & gradcorr5_max=gradcorr5_norm
948 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
949 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
950 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
952 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
953 & gcorr6_turn_max=gcorr6_turn_norm
954 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
955 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
956 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
957 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
958 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
959 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
961 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
962 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
964 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
965 if (gradx_scp_norm.gt.gradx_scp_max)
966 & gradx_scp_max=gradx_scp_norm
967 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
968 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
969 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
970 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
971 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
972 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
973 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
974 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
978 open(istat,file=statname,position="append")
980 open(istat,file=statname,access="append")
982 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
983 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
984 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
985 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
986 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
987 & gsccorx_max,gsclocx_max
989 if (gvdwc_max.gt.1.0d4) then
990 write (iout,*) "gvdwc gvdwx gradb gradbx"
992 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
993 & gradb(j,i),gradbx(j,i),j=1,3)
995 call pdbout(0.0d0,'cipiszcze',iout)
1001 write (iout,*) "gradc gradx gloc"
1003 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
1004 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
1009 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
1011 time_sumgradient=time_sumgradient+tcpu()-time01
1016 c-------------------------------------------------------------------------------
1017 subroutine rescale_weights(t_bath)
1018 implicit real*8 (a-h,o-z)
1019 include 'DIMENSIONS'
1020 include 'COMMON.IOUNITS'
1021 include 'COMMON.FFIELD'
1022 include 'COMMON.SBRIDGE'
1023 double precision kfac /2.4d0/
1024 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1026 c facT=2*temp0/(t_bath+temp0)
1027 if (rescale_mode.eq.0) then
1033 else if (rescale_mode.eq.1) then
1034 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1035 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1036 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1037 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1038 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1039 else if (rescale_mode.eq.2) then
1045 facT=licznik/dlog(dexp(x)+dexp(-x))
1046 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1047 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1048 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1049 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1051 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1052 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1054 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1058 welec=weights(3)*fact
1059 wcorr=weights(4)*fact3
1060 wcorr5=weights(5)*fact4
1061 wcorr6=weights(6)*fact5
1062 wel_loc=weights(7)*fact2
1063 wturn3=weights(8)*fact2
1064 wturn4=weights(9)*fact3
1065 wturn6=weights(10)*fact5
1066 wtor=weights(13)*fact
1067 wtor_d=weights(14)*fact2
1068 wsccor=weights(21)*fact
1071 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1075 C------------------------------------------------------------------------
1076 subroutine enerprint(energia)
1077 implicit real*8 (a-h,o-z)
1078 include 'DIMENSIONS'
1079 include 'COMMON.IOUNITS'
1080 include 'COMMON.FFIELD'
1081 include 'COMMON.SBRIDGE'
1083 double precision energia(0:n_ene)
1086 evdw=energia(22)+wsct*energia(23)
1092 evdw2=energia(2)+energia(18)
1104 eello_turn3=energia(8)
1105 eello_turn4=energia(9)
1106 eello_turn6=energia(10)
1112 edihcnstr=energia(19)
1116 ehomology_constr=energia(24)
1118 edfadis = energia(25)
1119 edfator = energia(26)
1120 edfanei = energia(27)
1121 edfabet = energia(28)
1124 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1125 & estr,wbond,ebe,wang,
1126 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1128 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1129 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1130 & edihcnstr,ehomology_constr, ebr*nss,
1131 & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,
1132 & edfabet,wdfa_beta,etot
1133 10 format (/'Virtual-chain energies:'//
1134 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1135 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1136 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1137 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1138 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1139 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1140 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1141 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1142 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1143 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1144 & ' (SS bridges & dist. cnstr.)'/
1145 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1146 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1147 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1148 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1149 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1150 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1151 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1152 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1153 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1154 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1155 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1156 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1157 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/
1158 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/
1159 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/
1160 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/
1161 & 'ETOT= ',1pE16.6,' (total)')
1163 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1164 & estr,wbond,ebe,wang,
1165 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1167 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1168 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1169 & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator,
1170 & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta,
1172 10 format (/'Virtual-chain energies:'//
1173 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1174 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1175 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1176 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1177 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1178 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1179 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1180 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1181 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1182 & ' (SS bridges & dist. cnstr.)'/
1183 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1184 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1185 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1186 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1187 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1188 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1189 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1190 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1191 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1192 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
1193 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1194 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1195 & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/
1196 & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/
1197 & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/
1198 & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/
1199 & 'ETOT= ',1pE16.6,' (total)')
1203 C-----------------------------------------------------------------------
1204 subroutine elj(evdw,evdw_p,evdw_m)
1206 C This subroutine calculates the interaction energy of nonbonded side chains
1207 C assuming the LJ potential of interaction.
1209 implicit real*8 (a-h,o-z)
1210 include 'DIMENSIONS'
1211 parameter (accur=1.0d-10)
1212 include 'COMMON.GEO'
1213 include 'COMMON.VAR'
1214 include 'COMMON.LOCAL'
1215 include 'COMMON.CHAIN'
1216 include 'COMMON.DERIV'
1217 include 'COMMON.INTERACT'
1218 include 'COMMON.TORSION'
1219 include 'COMMON.SBRIDGE'
1220 include 'COMMON.NAMES'
1221 include 'COMMON.IOUNITS'
1222 include 'COMMON.CONTACTS'
1224 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1226 do i=iatsc_s,iatsc_e
1235 C Calculate SC interaction energy.
1237 do iint=1,nint_gr(i)
1238 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1239 cd & 'iend=',iend(i,iint)
1240 do j=istart(i,iint),iend(i,iint)
1245 C Change 12/1/95 to calculate four-body interactions
1246 rij=xj*xj+yj*yj+zj*zj
1248 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1249 eps0ij=eps(itypi,itypj)
1251 e1=fac*fac*aa(itypi,itypj)
1252 e2=fac*bb(itypi,itypj)
1254 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1255 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1256 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1257 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1258 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1259 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1261 if (bb(itypi,itypj).gt.0) then
1262 evdw_p=evdw_p+evdwij
1264 evdw_m=evdw_m+evdwij
1270 C Calculate the components of the gradient in DC and X
1272 fac=-rrij*(e1+evdwij)
1277 if (bb(itypi,itypj).gt.0.0d0) then
1279 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1280 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1281 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1282 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1286 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1287 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1288 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1289 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1294 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1295 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1296 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1297 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1302 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1306 C 12/1/95, revised on 5/20/97
1308 C Calculate the contact function. The ith column of the array JCONT will
1309 C contain the numbers of atoms that make contacts with the atom I (of numbers
1310 C greater than I). The arrays FACONT and GACONT will contain the values of
1311 C the contact function and its derivative.
1313 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1314 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1315 C Uncomment next line, if the correlation interactions are contact function only
1316 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1318 sigij=sigma(itypi,itypj)
1319 r0ij=rs0(itypi,itypj)
1321 C Check whether the SC's are not too far to make a contact.
1324 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1325 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1327 if (fcont.gt.0.0D0) then
1328 C If the SC-SC distance if close to sigma, apply spline.
1329 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1330 cAdam & fcont1,fprimcont1)
1331 cAdam fcont1=1.0d0-fcont1
1332 cAdam if (fcont1.gt.0.0d0) then
1333 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1334 cAdam fcont=fcont*fcont1
1336 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1337 cga eps0ij=1.0d0/dsqrt(eps0ij)
1339 cga gg(k)=gg(k)*eps0ij
1341 cga eps0ij=-evdwij*eps0ij
1342 C Uncomment for AL's type of SC correlation interactions.
1343 cadam eps0ij=-evdwij
1344 num_conti=num_conti+1
1345 jcont(num_conti,i)=j
1346 facont(num_conti,i)=fcont*eps0ij
1347 fprimcont=eps0ij*fprimcont/rij
1349 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1350 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1351 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1352 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1353 gacont(1,num_conti,i)=-fprimcont*xj
1354 gacont(2,num_conti,i)=-fprimcont*yj
1355 gacont(3,num_conti,i)=-fprimcont*zj
1356 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1357 cd write (iout,'(2i3,3f10.5)')
1358 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1364 num_cont(i)=num_conti
1368 gvdwc(j,i)=expon*gvdwc(j,i)
1369 gvdwx(j,i)=expon*gvdwx(j,i)
1372 C******************************************************************************
1376 C To save time, the factor of EXPON has been extracted from ALL components
1377 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1380 C******************************************************************************
1383 C-----------------------------------------------------------------------------
1384 subroutine eljk(evdw,evdw_p,evdw_m)
1386 C This subroutine calculates the interaction energy of nonbonded side chains
1387 C assuming the LJK potential of interaction.
1389 implicit real*8 (a-h,o-z)
1390 include 'DIMENSIONS'
1391 include 'COMMON.GEO'
1392 include 'COMMON.VAR'
1393 include 'COMMON.LOCAL'
1394 include 'COMMON.CHAIN'
1395 include 'COMMON.DERIV'
1396 include 'COMMON.INTERACT'
1397 include 'COMMON.IOUNITS'
1398 include 'COMMON.NAMES'
1401 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1403 do i=iatsc_s,iatsc_e
1410 C Calculate SC interaction energy.
1412 do iint=1,nint_gr(i)
1413 do j=istart(i,iint),iend(i,iint)
1418 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1419 fac_augm=rrij**expon
1420 e_augm=augm(itypi,itypj)*fac_augm
1421 r_inv_ij=dsqrt(rrij)
1423 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1424 fac=r_shift_inv**expon
1425 e1=fac*fac*aa(itypi,itypj)
1426 e2=fac*bb(itypi,itypj)
1428 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1429 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1430 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1431 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1432 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1433 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1434 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1436 if (bb(itypi,itypj).gt.0) then
1437 evdw_p=evdw_p+evdwij
1439 evdw_m=evdw_m+evdwij
1445 C Calculate the components of the gradient in DC and X
1447 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1452 if (bb(itypi,itypj).gt.0.0d0) then
1454 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1455 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1456 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1457 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1461 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1462 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1463 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1464 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1469 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1470 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1471 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1472 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1477 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1485 gvdwc(j,i)=expon*gvdwc(j,i)
1486 gvdwx(j,i)=expon*gvdwx(j,i)
1491 C-----------------------------------------------------------------------------
1492 subroutine ebp(evdw,evdw_p,evdw_m)
1494 C This subroutine calculates the interaction energy of nonbonded side chains
1495 C assuming the Berne-Pechukas potential of interaction.
1497 implicit real*8 (a-h,o-z)
1498 include 'DIMENSIONS'
1499 include 'COMMON.GEO'
1500 include 'COMMON.VAR'
1501 include 'COMMON.LOCAL'
1502 include 'COMMON.CHAIN'
1503 include 'COMMON.DERIV'
1504 include 'COMMON.NAMES'
1505 include 'COMMON.INTERACT'
1506 include 'COMMON.IOUNITS'
1507 include 'COMMON.CALC'
1508 common /srutu/ icall
1509 c double precision rrsave(maxdim)
1512 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1514 c if (icall.eq.0) then
1520 do i=iatsc_s,iatsc_e
1526 dxi=dc_norm(1,nres+i)
1527 dyi=dc_norm(2,nres+i)
1528 dzi=dc_norm(3,nres+i)
1529 c dsci_inv=dsc_inv(itypi)
1530 dsci_inv=vbld_inv(i+nres)
1532 C Calculate SC interaction energy.
1534 do iint=1,nint_gr(i)
1535 do j=istart(i,iint),iend(i,iint)
1538 c dscj_inv=dsc_inv(itypj)
1539 dscj_inv=vbld_inv(j+nres)
1540 chi1=chi(itypi,itypj)
1541 chi2=chi(itypj,itypi)
1548 alf12=0.5D0*(alf1+alf2)
1549 C For diagnostics only!!!
1562 dxj=dc_norm(1,nres+j)
1563 dyj=dc_norm(2,nres+j)
1564 dzj=dc_norm(3,nres+j)
1565 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1566 cd if (icall.eq.0) then
1572 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1574 C Calculate whole angle-dependent part of epsilon and contributions
1575 C to its derivatives
1576 fac=(rrij*sigsq)**expon2
1577 e1=fac*fac*aa(itypi,itypj)
1578 e2=fac*bb(itypi,itypj)
1579 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1580 eps2der=evdwij*eps3rt
1581 eps3der=evdwij*eps2rt
1582 evdwij=evdwij*eps2rt*eps3rt
1584 if (bb(itypi,itypj).gt.0) then
1585 evdw_p=evdw_p+evdwij
1587 evdw_m=evdw_m+evdwij
1593 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1594 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1595 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1596 cd & restyp(itypi),i,restyp(itypj),j,
1597 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1598 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1599 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1602 C Calculate gradient components.
1603 e1=e1*eps1*eps2rt**2*eps3rt**2
1604 fac=-expon*(e1+evdwij)
1607 C Calculate radial part of the gradient
1611 C Calculate the angular part of the gradient and sum add the contributions
1612 C to the appropriate components of the Cartesian gradient.
1614 if (bb(itypi,itypj).gt.0) then
1628 C-----------------------------------------------------------------------------
1629 subroutine egb(evdw,evdw_p,evdw_m)
1631 C This subroutine calculates the interaction energy of nonbonded side chains
1632 C assuming the Gay-Berne potential of interaction.
1634 implicit real*8 (a-h,o-z)
1635 include 'DIMENSIONS'
1636 include 'COMMON.GEO'
1637 include 'COMMON.VAR'
1638 include 'COMMON.LOCAL'
1639 include 'COMMON.CHAIN'
1640 include 'COMMON.DERIV'
1641 include 'COMMON.NAMES'
1642 include 'COMMON.INTERACT'
1643 include 'COMMON.IOUNITS'
1644 include 'COMMON.CALC'
1645 include 'COMMON.CONTROL'
1646 include 'COMMON.SBRIDGE'
1649 ccccc energy_dec=.false.
1650 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1655 c if (icall.eq.0) lprn=.false.
1657 do i=iatsc_s,iatsc_e
1663 dxi=dc_norm(1,nres+i)
1664 dyi=dc_norm(2,nres+i)
1665 dzi=dc_norm(3,nres+i)
1666 c dsci_inv=dsc_inv(itypi)
1667 dsci_inv=vbld_inv(i+nres)
1668 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1669 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1671 C Calculate SC interaction energy.
1673 do iint=1,nint_gr(i)
1674 do j=istart(i,iint),iend(i,iint)
1675 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1676 call dyn_ssbond_ene(i,j,evdwij)
1678 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1679 & 'evdw',i,j,evdwij,' ss'
1683 c dscj_inv=dsc_inv(itypj)
1684 dscj_inv=vbld_inv(j+nres)
1685 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1686 c & 1.0d0/vbld(j+nres)
1687 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1688 sig0ij=sigma(itypi,itypj)
1689 chi1=chi(itypi,itypj)
1690 chi2=chi(itypj,itypi)
1697 alf12=0.5D0*(alf1+alf2)
1698 C For diagnostics only!!!
1711 dxj=dc_norm(1,nres+j)
1712 dyj=dc_norm(2,nres+j)
1713 dzj=dc_norm(3,nres+j)
1714 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1715 c write (iout,*) "j",j," dc_norm",
1716 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1717 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1719 C Calculate angle-dependent terms of energy and contributions to their
1723 sig=sig0ij*dsqrt(sigsq)
1724 rij_shift=1.0D0/rij-sig+sig0ij
1725 c for diagnostics; uncomment
1726 c rij_shift=1.2*sig0ij
1727 C I hate to put IF's in the loops, but here don't have another choice!!!!
1728 if (rij_shift.le.0.0D0) then
1730 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1731 cd & restyp(itypi),i,restyp(itypj),j,
1732 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1736 c---------------------------------------------------------------
1737 rij_shift=1.0D0/rij_shift
1738 fac=rij_shift**expon
1739 e1=fac*fac*aa(itypi,itypj)
1740 e2=fac*bb(itypi,itypj)
1741 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1742 eps2der=evdwij*eps3rt
1743 eps3der=evdwij*eps2rt
1744 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1745 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1746 evdwij=evdwij*eps2rt*eps3rt
1748 if (bb(itypi,itypj).gt.0) then
1749 evdw_p=evdw_p+evdwij
1751 evdw_m=evdw_m+evdwij
1757 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1758 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1759 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1760 & restyp(itypi),i,restyp(itypj),j,
1761 & epsi,sigm,chi1,chi2,chip1,chip2,
1762 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1763 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1767 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1770 C Calculate gradient components.
1771 e1=e1*eps1*eps2rt**2*eps3rt**2
1772 fac=-expon*(e1+evdwij)*rij_shift
1776 C Calculate the radial part of the gradient
1780 C Calculate angular part of the gradient.
1782 if (bb(itypi,itypj).gt.0) then
1794 c write (iout,*) "Number of loop steps in EGB:",ind
1795 cccc energy_dec=.false.
1798 C-----------------------------------------------------------------------------
1799 subroutine egbv(evdw,evdw_p,evdw_m)
1801 C This subroutine calculates the interaction energy of nonbonded side chains
1802 C assuming the Gay-Berne-Vorobjev potential of interaction.
1804 implicit real*8 (a-h,o-z)
1805 include 'DIMENSIONS'
1806 include 'COMMON.GEO'
1807 include 'COMMON.VAR'
1808 include 'COMMON.LOCAL'
1809 include 'COMMON.CHAIN'
1810 include 'COMMON.DERIV'
1811 include 'COMMON.NAMES'
1812 include 'COMMON.INTERACT'
1813 include 'COMMON.IOUNITS'
1814 include 'COMMON.CALC'
1815 common /srutu/ icall
1818 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1821 c if (icall.eq.0) lprn=.true.
1823 do i=iatsc_s,iatsc_e
1829 dxi=dc_norm(1,nres+i)
1830 dyi=dc_norm(2,nres+i)
1831 dzi=dc_norm(3,nres+i)
1832 c dsci_inv=dsc_inv(itypi)
1833 dsci_inv=vbld_inv(i+nres)
1835 C Calculate SC interaction energy.
1837 do iint=1,nint_gr(i)
1838 do j=istart(i,iint),iend(i,iint)
1841 c dscj_inv=dsc_inv(itypj)
1842 dscj_inv=vbld_inv(j+nres)
1843 sig0ij=sigma(itypi,itypj)
1844 r0ij=r0(itypi,itypj)
1845 chi1=chi(itypi,itypj)
1846 chi2=chi(itypj,itypi)
1853 alf12=0.5D0*(alf1+alf2)
1854 C For diagnostics only!!!
1867 dxj=dc_norm(1,nres+j)
1868 dyj=dc_norm(2,nres+j)
1869 dzj=dc_norm(3,nres+j)
1870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1872 C Calculate angle-dependent terms of energy and contributions to their
1876 sig=sig0ij*dsqrt(sigsq)
1877 rij_shift=1.0D0/rij-sig+r0ij
1878 C I hate to put IF's in the loops, but here don't have another choice!!!!
1879 if (rij_shift.le.0.0D0) then
1884 c---------------------------------------------------------------
1885 rij_shift=1.0D0/rij_shift
1886 fac=rij_shift**expon
1887 e1=fac*fac*aa(itypi,itypj)
1888 e2=fac*bb(itypi,itypj)
1889 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1890 eps2der=evdwij*eps3rt
1891 eps3der=evdwij*eps2rt
1892 fac_augm=rrij**expon
1893 e_augm=augm(itypi,itypj)*fac_augm
1894 evdwij=evdwij*eps2rt*eps3rt
1896 if (bb(itypi,itypj).gt.0) then
1897 evdw_p=evdw_p+evdwij+e_augm
1899 evdw_m=evdw_m+evdwij+e_augm
1902 evdw=evdw+evdwij+e_augm
1905 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1906 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1907 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1908 & restyp(itypi),i,restyp(itypj),j,
1909 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1910 & chi1,chi2,chip1,chip2,
1911 & eps1,eps2rt**2,eps3rt**2,
1912 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1915 C Calculate gradient components.
1916 e1=e1*eps1*eps2rt**2*eps3rt**2
1917 fac=-expon*(e1+evdwij)*rij_shift
1919 fac=rij*fac-2*expon*rrij*e_augm
1920 C Calculate the radial part of the gradient
1924 C Calculate angular part of the gradient.
1926 if (bb(itypi,itypj).gt.0) then
1938 C-----------------------------------------------------------------------------
1939 subroutine sc_angular
1940 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1941 C om12. Called by ebp, egb, and egbv.
1943 include 'COMMON.CALC'
1944 include 'COMMON.IOUNITS'
1948 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1949 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1950 om12=dxi*dxj+dyi*dyj+dzi*dzj
1952 C Calculate eps1(om12) and its derivative in om12
1953 faceps1=1.0D0-om12*chiom12
1954 faceps1_inv=1.0D0/faceps1
1955 eps1=dsqrt(faceps1_inv)
1956 C Following variable is eps1*deps1/dom12
1957 eps1_om12=faceps1_inv*chiom12
1962 c write (iout,*) "om12",om12," eps1",eps1
1963 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1968 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1969 sigsq=1.0D0-facsig*faceps1_inv
1970 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1971 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1972 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1978 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1979 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1981 C Calculate eps2 and its derivatives in om1, om2, and om12.
1984 chipom12=chip12*om12
1985 facp=1.0D0-om12*chipom12
1987 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1988 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1989 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1990 C Following variable is the square root of eps2
1991 eps2rt=1.0D0-facp1*facp_inv
1992 C Following three variables are the derivatives of the square root of eps
1993 C in om1, om2, and om12.
1994 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1995 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1996 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1997 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1998 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1999 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2000 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2001 c & " eps2rt_om12",eps2rt_om12
2002 C Calculate whole angle-dependent part of epsilon and contributions
2003 C to its derivatives
2007 C----------------------------------------------------------------------------
2008 subroutine sc_grad_T
2009 implicit real*8 (a-h,o-z)
2010 include 'DIMENSIONS'
2011 include 'COMMON.CHAIN'
2012 include 'COMMON.DERIV'
2013 include 'COMMON.CALC'
2014 include 'COMMON.IOUNITS'
2015 double precision dcosom1(3),dcosom2(3)
2016 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2017 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2018 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2019 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2023 c eom12=evdwij*eps1_om12
2025 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2026 c & " sigder",sigder
2027 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2028 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2030 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2031 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2034 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2036 c write (iout,*) "gg",(gg(k),k=1,3)
2038 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2039 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2040 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2041 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2042 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2043 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2044 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2045 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2046 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2047 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2050 C Calculate the components of the gradient in DC and X
2054 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2058 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2059 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2064 C----------------------------------------------------------------------------
2066 implicit real*8 (a-h,o-z)
2067 include 'DIMENSIONS'
2068 include 'COMMON.CHAIN'
2069 include 'COMMON.DERIV'
2070 include 'COMMON.CALC'
2071 include 'COMMON.IOUNITS'
2072 double precision dcosom1(3),dcosom2(3)
2073 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2074 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2075 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2076 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2080 c eom12=evdwij*eps1_om12
2082 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2083 c & " sigder",sigder
2084 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2085 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2087 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2088 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2091 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2093 c write (iout,*) "gg",(gg(k),k=1,3)
2095 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2096 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2097 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2098 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2099 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2100 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2101 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2102 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2103 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2104 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2107 C Calculate the components of the gradient in DC and X
2111 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2115 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2116 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2120 C-----------------------------------------------------------------------
2121 subroutine e_softsphere(evdw)
2123 C This subroutine calculates the interaction energy of nonbonded side chains
2124 C assuming the LJ potential of interaction.
2126 implicit real*8 (a-h,o-z)
2127 include 'DIMENSIONS'
2128 parameter (accur=1.0d-10)
2129 include 'COMMON.GEO'
2130 include 'COMMON.VAR'
2131 include 'COMMON.LOCAL'
2132 include 'COMMON.CHAIN'
2133 include 'COMMON.DERIV'
2134 include 'COMMON.INTERACT'
2135 include 'COMMON.TORSION'
2136 include 'COMMON.SBRIDGE'
2137 include 'COMMON.NAMES'
2138 include 'COMMON.IOUNITS'
2139 include 'COMMON.CONTACTS'
2141 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2143 do i=iatsc_s,iatsc_e
2150 C Calculate SC interaction energy.
2152 do iint=1,nint_gr(i)
2153 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2154 cd & 'iend=',iend(i,iint)
2155 do j=istart(i,iint),iend(i,iint)
2160 rij=xj*xj+yj*yj+zj*zj
2161 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2162 r0ij=r0(itypi,itypj)
2164 c print *,i,j,r0ij,dsqrt(rij)
2165 if (rij.lt.r0ijsq) then
2166 evdwij=0.25d0*(rij-r0ijsq)**2
2174 C Calculate the components of the gradient in DC and X
2180 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2181 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2182 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2183 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2187 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2195 C--------------------------------------------------------------------------
2196 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2199 C Soft-sphere potential of p-p interaction
2201 implicit real*8 (a-h,o-z)
2202 include 'DIMENSIONS'
2203 include 'COMMON.CONTROL'
2204 include 'COMMON.IOUNITS'
2205 include 'COMMON.GEO'
2206 include 'COMMON.VAR'
2207 include 'COMMON.LOCAL'
2208 include 'COMMON.CHAIN'
2209 include 'COMMON.DERIV'
2210 include 'COMMON.INTERACT'
2211 include 'COMMON.CONTACTS'
2212 include 'COMMON.TORSION'
2213 include 'COMMON.VECTORS'
2214 include 'COMMON.FFIELD'
2216 cd write(iout,*) 'In EELEC_soft_sphere'
2223 do i=iatel_s,iatel_e
2227 xmedi=c(1,i)+0.5d0*dxi
2228 ymedi=c(2,i)+0.5d0*dyi
2229 zmedi=c(3,i)+0.5d0*dzi
2231 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2232 do j=ielstart(i),ielend(i)
2236 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2237 r0ij=rpp(iteli,itelj)
2242 xj=c(1,j)+0.5D0*dxj-xmedi
2243 yj=c(2,j)+0.5D0*dyj-ymedi
2244 zj=c(3,j)+0.5D0*dzj-zmedi
2245 rij=xj*xj+yj*yj+zj*zj
2246 if (rij.lt.r0ijsq) then
2247 evdw1ij=0.25d0*(rij-r0ijsq)**2
2255 C Calculate contributions to the Cartesian gradient.
2261 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2262 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2265 * Loop over residues i+1 thru j-1.
2269 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2274 cgrad do i=nnt,nct-1
2276 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2278 cgrad do j=i+1,nct-1
2280 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2286 c------------------------------------------------------------------------------
2287 subroutine vec_and_deriv
2288 implicit real*8 (a-h,o-z)
2289 include 'DIMENSIONS'
2293 include 'COMMON.IOUNITS'
2294 include 'COMMON.GEO'
2295 include 'COMMON.VAR'
2296 include 'COMMON.LOCAL'
2297 include 'COMMON.CHAIN'
2298 include 'COMMON.VECTORS'
2299 include 'COMMON.SETUP'
2300 include 'COMMON.TIME1'
2301 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2302 C Compute the local reference systems. For reference system (i), the
2303 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2304 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2306 do i=ivec_start,ivec_end
2310 if (i.eq.nres-1) then
2311 C Case of the last full residue
2312 C Compute the Z-axis
2313 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2314 costh=dcos(pi-theta(nres))
2315 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2319 C Compute the derivatives of uz
2321 uzder(2,1,1)=-dc_norm(3,i-1)
2322 uzder(3,1,1)= dc_norm(2,i-1)
2323 uzder(1,2,1)= dc_norm(3,i-1)
2325 uzder(3,2,1)=-dc_norm(1,i-1)
2326 uzder(1,3,1)=-dc_norm(2,i-1)
2327 uzder(2,3,1)= dc_norm(1,i-1)
2330 uzder(2,1,2)= dc_norm(3,i)
2331 uzder(3,1,2)=-dc_norm(2,i)
2332 uzder(1,2,2)=-dc_norm(3,i)
2334 uzder(3,2,2)= dc_norm(1,i)
2335 uzder(1,3,2)= dc_norm(2,i)
2336 uzder(2,3,2)=-dc_norm(1,i)
2338 C Compute the Y-axis
2341 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2343 C Compute the derivatives of uy
2346 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2347 & -dc_norm(k,i)*dc_norm(j,i-1)
2348 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2350 uyder(j,j,1)=uyder(j,j,1)-costh
2351 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2356 uygrad(l,k,j,i)=uyder(l,k,j)
2357 uzgrad(l,k,j,i)=uzder(l,k,j)
2361 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2362 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2363 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2364 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2367 C Compute the Z-axis
2368 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2369 costh=dcos(pi-theta(i+2))
2370 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2374 C Compute the derivatives of uz
2376 uzder(2,1,1)=-dc_norm(3,i+1)
2377 uzder(3,1,1)= dc_norm(2,i+1)
2378 uzder(1,2,1)= dc_norm(3,i+1)
2380 uzder(3,2,1)=-dc_norm(1,i+1)
2381 uzder(1,3,1)=-dc_norm(2,i+1)
2382 uzder(2,3,1)= dc_norm(1,i+1)
2385 uzder(2,1,2)= dc_norm(3,i)
2386 uzder(3,1,2)=-dc_norm(2,i)
2387 uzder(1,2,2)=-dc_norm(3,i)
2389 uzder(3,2,2)= dc_norm(1,i)
2390 uzder(1,3,2)= dc_norm(2,i)
2391 uzder(2,3,2)=-dc_norm(1,i)
2393 C Compute the Y-axis
2396 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2398 C Compute the derivatives of uy
2401 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2402 & -dc_norm(k,i)*dc_norm(j,i+1)
2403 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2405 uyder(j,j,1)=uyder(j,j,1)-costh
2406 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2411 uygrad(l,k,j,i)=uyder(l,k,j)
2412 uzgrad(l,k,j,i)=uzder(l,k,j)
2416 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2417 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2418 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2419 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2423 vbld_inv_temp(1)=vbld_inv(i+1)
2424 if (i.lt.nres-1) then
2425 vbld_inv_temp(2)=vbld_inv(i+2)
2427 vbld_inv_temp(2)=vbld_inv(i)
2432 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2433 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2438 #if defined(PARVEC) && defined(MPI)
2439 if (nfgtasks1.gt.1) then
2441 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2442 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2443 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2444 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2445 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2447 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2448 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2450 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2451 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2452 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2453 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2454 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2455 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2456 time_gather=time_gather+MPI_Wtime()-time00
2458 c if (fg_rank.eq.0) then
2459 c write (iout,*) "Arrays UY and UZ"
2461 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2468 C-----------------------------------------------------------------------------
2469 subroutine check_vecgrad
2470 implicit real*8 (a-h,o-z)
2471 include 'DIMENSIONS'
2472 include 'COMMON.IOUNITS'
2473 include 'COMMON.GEO'
2474 include 'COMMON.VAR'
2475 include 'COMMON.LOCAL'
2476 include 'COMMON.CHAIN'
2477 include 'COMMON.VECTORS'
2478 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2479 dimension uyt(3,maxres),uzt(3,maxres)
2480 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2481 double precision delta /1.0d-7/
2484 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2485 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2486 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2487 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2488 cd & (dc_norm(if90,i),if90=1,3)
2489 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2490 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2491 cd write(iout,'(a)')
2497 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2498 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2511 cd write (iout,*) 'i=',i
2513 erij(k)=dc_norm(k,i)
2517 dc_norm(k,i)=erij(k)
2519 dc_norm(j,i)=dc_norm(j,i)+delta
2520 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2522 c dc_norm(k,i)=dc_norm(k,i)/fac
2524 c write (iout,*) (dc_norm(k,i),k=1,3)
2525 c write (iout,*) (erij(k),k=1,3)
2528 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2529 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2530 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2531 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2533 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2534 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2535 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2538 dc_norm(k,i)=erij(k)
2541 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2542 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2543 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2544 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2545 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2546 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2547 cd write (iout,'(a)')
2552 C--------------------------------------------------------------------------
2553 subroutine set_matrices
2554 implicit real*8 (a-h,o-z)
2555 include 'DIMENSIONS'
2558 include "COMMON.SETUP"
2560 integer status(MPI_STATUS_SIZE)
2562 include 'COMMON.IOUNITS'
2563 include 'COMMON.GEO'
2564 include 'COMMON.VAR'
2565 include 'COMMON.LOCAL'
2566 include 'COMMON.CHAIN'
2567 include 'COMMON.DERIV'
2568 include 'COMMON.INTERACT'
2569 include 'COMMON.CONTACTS'
2570 include 'COMMON.TORSION'
2571 include 'COMMON.VECTORS'
2572 include 'COMMON.FFIELD'
2573 double precision auxvec(2),auxmat(2,2)
2575 C Compute the virtual-bond-torsional-angle dependent quantities needed
2576 C to calculate the el-loc multibody terms of various order.
2579 do i=ivec_start+2,ivec_end+2
2583 if (i .lt. nres+1) then
2620 if (i .gt. 3 .and. i .lt. nres+1) then
2621 obrot_der(1,i-2)=-sin1
2622 obrot_der(2,i-2)= cos1
2623 Ugder(1,1,i-2)= sin1
2624 Ugder(1,2,i-2)=-cos1
2625 Ugder(2,1,i-2)=-cos1
2626 Ugder(2,2,i-2)=-sin1
2629 obrot2_der(1,i-2)=-dwasin2
2630 obrot2_der(2,i-2)= dwacos2
2631 Ug2der(1,1,i-2)= dwasin2
2632 Ug2der(1,2,i-2)=-dwacos2
2633 Ug2der(2,1,i-2)=-dwacos2
2634 Ug2der(2,2,i-2)=-dwasin2
2636 obrot_der(1,i-2)=0.0d0
2637 obrot_der(2,i-2)=0.0d0
2638 Ugder(1,1,i-2)=0.0d0
2639 Ugder(1,2,i-2)=0.0d0
2640 Ugder(2,1,i-2)=0.0d0
2641 Ugder(2,2,i-2)=0.0d0
2642 obrot2_der(1,i-2)=0.0d0
2643 obrot2_der(2,i-2)=0.0d0
2644 Ug2der(1,1,i-2)=0.0d0
2645 Ug2der(1,2,i-2)=0.0d0
2646 Ug2der(2,1,i-2)=0.0d0
2647 Ug2der(2,2,i-2)=0.0d0
2649 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2650 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2651 iti = itortyp(itype(i-2))
2655 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2656 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2657 iti1 = itortyp(itype(i-1))
2661 cd write (iout,*) '*******i',i,' iti1',iti
2662 cd write (iout,*) 'b1',b1(:,iti)
2663 cd write (iout,*) 'b2',b2(:,iti)
2664 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2665 c if (i .gt. iatel_s+2) then
2666 if (i .gt. nnt+2) then
2667 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2668 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2669 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2671 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2672 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2673 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2674 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2675 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2686 DtUg2(l,k,i-2)=0.0d0
2690 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2691 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2693 muder(k,i-2)=Ub2der(k,i-2)
2695 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2696 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2697 iti1 = itortyp(itype(i-1))
2702 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2704 cd write (iout,*) 'mu ',mu(:,i-2)
2705 cd write (iout,*) 'mu1',mu1(:,i-2)
2706 cd write (iout,*) 'mu2',mu2(:,i-2)
2707 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2709 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2710 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2711 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2712 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2713 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2714 C Vectors and matrices dependent on a single virtual-bond dihedral.
2715 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2716 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2717 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2718 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2719 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2720 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2721 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2722 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2723 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2726 C Matrices dependent on two consecutive virtual-bond dihedrals.
2727 C The order of matrices is from left to right.
2728 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2730 c do i=max0(ivec_start,2),ivec_end
2732 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2733 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2734 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2735 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2736 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2737 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2738 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2739 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2742 #if defined(MPI) && defined(PARMAT)
2744 c if (fg_rank.eq.0) then
2745 write (iout,*) "Arrays UG and UGDER before GATHER"
2747 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2748 & ((ug(l,k,i),l=1,2),k=1,2),
2749 & ((ugder(l,k,i),l=1,2),k=1,2)
2751 write (iout,*) "Arrays UG2 and UG2DER"
2753 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2754 & ((ug2(l,k,i),l=1,2),k=1,2),
2755 & ((ug2der(l,k,i),l=1,2),k=1,2)
2757 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2759 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2760 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2761 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2763 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2765 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2766 & costab(i),sintab(i),costab2(i),sintab2(i)
2768 write (iout,*) "Array MUDER"
2770 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2774 if (nfgtasks.gt.1) then
2776 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2777 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2778 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2780 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2781 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2783 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2784 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2786 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2787 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2789 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2790 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2792 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2793 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2795 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2796 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2798 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2799 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2800 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2801 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2802 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2803 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2804 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2805 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2806 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2807 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2808 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2809 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2810 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2812 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2815 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2816 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2818 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2819 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2821 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2822 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2824 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2825 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2827 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2828 & ivec_count(fg_rank1),
2829 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2831 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2832 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2834 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2835 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2837 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2838 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2840 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2841 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2843 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2844 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2846 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2847 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2849 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2850 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2852 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2853 & ivec_count(fg_rank1),
2854 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2856 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2857 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2859 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2860 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2862 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2863 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2865 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2866 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2868 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2869 & ivec_count(fg_rank1),
2870 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2872 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2873 & ivec_count(fg_rank1),
2874 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2876 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2877 & ivec_count(fg_rank1),
2878 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2879 & MPI_MAT2,FG_COMM1,IERR)
2880 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2881 & ivec_count(fg_rank1),
2882 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2883 & MPI_MAT2,FG_COMM1,IERR)
2886 c Passes matrix info through the ring
2889 if (irecv.lt.0) irecv=nfgtasks1-1
2892 if (inext.ge.nfgtasks1) inext=0
2894 c write (iout,*) "isend",isend," irecv",irecv
2896 lensend=lentyp(isend)
2897 lenrecv=lentyp(irecv)
2898 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2899 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2900 c & MPI_ROTAT1(lensend),inext,2200+isend,
2901 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2902 c & iprev,2200+irecv,FG_COMM,status,IERR)
2903 c write (iout,*) "Gather ROTAT1"
2905 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2906 c & MPI_ROTAT2(lensend),inext,3300+isend,
2907 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2908 c & iprev,3300+irecv,FG_COMM,status,IERR)
2909 c write (iout,*) "Gather ROTAT2"
2911 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2912 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2913 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2914 & iprev,4400+irecv,FG_COMM,status,IERR)
2915 c write (iout,*) "Gather ROTAT_OLD"
2917 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2918 & MPI_PRECOMP11(lensend),inext,5500+isend,
2919 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2920 & iprev,5500+irecv,FG_COMM,status,IERR)
2921 c write (iout,*) "Gather PRECOMP11"
2923 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2924 & MPI_PRECOMP12(lensend),inext,6600+isend,
2925 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2926 & iprev,6600+irecv,FG_COMM,status,IERR)
2927 c write (iout,*) "Gather PRECOMP12"
2929 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2931 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2932 & MPI_ROTAT2(lensend),inext,7700+isend,
2933 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2934 & iprev,7700+irecv,FG_COMM,status,IERR)
2935 c write (iout,*) "Gather PRECOMP21"
2937 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2938 & MPI_PRECOMP22(lensend),inext,8800+isend,
2939 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2940 & iprev,8800+irecv,FG_COMM,status,IERR)
2941 c write (iout,*) "Gather PRECOMP22"
2943 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2944 & MPI_PRECOMP23(lensend),inext,9900+isend,
2945 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2946 & MPI_PRECOMP23(lenrecv),
2947 & iprev,9900+irecv,FG_COMM,status,IERR)
2948 c write (iout,*) "Gather PRECOMP23"
2953 if (irecv.lt.0) irecv=nfgtasks1-1
2956 time_gather=time_gather+MPI_Wtime()-time00
2959 c if (fg_rank.eq.0) then
2960 write (iout,*) "Arrays UG and UGDER"
2962 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2963 & ((ug(l,k,i),l=1,2),k=1,2),
2964 & ((ugder(l,k,i),l=1,2),k=1,2)
2966 write (iout,*) "Arrays UG2 and UG2DER"
2968 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2969 & ((ug2(l,k,i),l=1,2),k=1,2),
2970 & ((ug2der(l,k,i),l=1,2),k=1,2)
2972 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2974 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2975 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2976 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2978 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2980 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2981 & costab(i),sintab(i),costab2(i),sintab2(i)
2983 write (iout,*) "Array MUDER"
2985 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2991 cd iti = itortyp(itype(i))
2994 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2995 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3000 C--------------------------------------------------------------------------
3001 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3003 C This subroutine calculates the average interaction energy and its gradient
3004 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3005 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3006 C The potential depends both on the distance of peptide-group centers and on
3007 C the orientation of the CA-CA virtual bonds.
3009 implicit real*8 (a-h,o-z)
3013 include 'DIMENSIONS'
3014 include 'COMMON.CONTROL'
3015 include 'COMMON.SETUP'
3016 include 'COMMON.IOUNITS'
3017 include 'COMMON.GEO'
3018 include 'COMMON.VAR'
3019 include 'COMMON.LOCAL'
3020 include 'COMMON.CHAIN'
3021 include 'COMMON.DERIV'
3022 include 'COMMON.INTERACT'
3023 include 'COMMON.CONTACTS'
3024 include 'COMMON.TORSION'
3025 include 'COMMON.VECTORS'
3026 include 'COMMON.FFIELD'
3027 include 'COMMON.TIME1'
3028 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3029 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3030 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3031 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3032 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3033 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3035 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3037 double precision scal_el /1.0d0/
3039 double precision scal_el /0.5d0/
3042 C 13-go grudnia roku pamietnego...
3043 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3044 & 0.0d0,1.0d0,0.0d0,
3045 & 0.0d0,0.0d0,1.0d0/
3046 cd write(iout,*) 'In EELEC'
3048 cd write(iout,*) 'Type',i
3049 cd write(iout,*) 'B1',B1(:,i)
3050 cd write(iout,*) 'B2',B2(:,i)
3051 cd write(iout,*) 'CC',CC(:,:,i)
3052 cd write(iout,*) 'DD',DD(:,:,i)
3053 cd write(iout,*) 'EE',EE(:,:,i)
3055 cd call check_vecgrad
3057 if (icheckgrad.eq.1) then
3059 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3061 dc_norm(k,i)=dc(k,i)*fac
3063 c write (iout,*) 'i',i,' fac',fac
3066 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3067 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3068 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3069 c call vec_and_deriv
3075 time_mat=time_mat+MPI_Wtime()-time01
3079 cd write (iout,*) 'i=',i
3081 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3084 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3085 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3098 cd print '(a)','Enter EELEC'
3099 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3101 gel_loc_loc(i)=0.0d0
3106 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3108 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3110 do i=iturn3_start,iturn3_end
3114 dx_normi=dc_norm(1,i)
3115 dy_normi=dc_norm(2,i)
3116 dz_normi=dc_norm(3,i)
3117 xmedi=c(1,i)+0.5d0*dxi
3118 ymedi=c(2,i)+0.5d0*dyi
3119 zmedi=c(3,i)+0.5d0*dzi
3121 call eelecij(i,i+2,ees,evdw1,eel_loc)
3122 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3123 num_cont_hb(i)=num_conti
3125 do i=iturn4_start,iturn4_end
3129 dx_normi=dc_norm(1,i)
3130 dy_normi=dc_norm(2,i)
3131 dz_normi=dc_norm(3,i)
3132 xmedi=c(1,i)+0.5d0*dxi
3133 ymedi=c(2,i)+0.5d0*dyi
3134 zmedi=c(3,i)+0.5d0*dzi
3135 num_conti=num_cont_hb(i)
3136 call eelecij(i,i+3,ees,evdw1,eel_loc)
3137 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3138 num_cont_hb(i)=num_conti
3141 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3143 do i=iatel_s,iatel_e
3147 dx_normi=dc_norm(1,i)
3148 dy_normi=dc_norm(2,i)
3149 dz_normi=dc_norm(3,i)
3150 xmedi=c(1,i)+0.5d0*dxi
3151 ymedi=c(2,i)+0.5d0*dyi
3152 zmedi=c(3,i)+0.5d0*dzi
3153 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3154 num_conti=num_cont_hb(i)
3155 do j=ielstart(i),ielend(i)
3156 call eelecij(i,j,ees,evdw1,eel_loc)
3158 num_cont_hb(i)=num_conti
3160 c write (iout,*) "Number of loop steps in EELEC:",ind
3162 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3163 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3165 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3166 ccc eel_loc=eel_loc+eello_turn3
3167 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3170 C-------------------------------------------------------------------------------
3171 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3172 implicit real*8 (a-h,o-z)
3173 include 'DIMENSIONS'
3177 include 'COMMON.CONTROL'
3178 include 'COMMON.IOUNITS'
3179 include 'COMMON.GEO'
3180 include 'COMMON.VAR'
3181 include 'COMMON.LOCAL'
3182 include 'COMMON.CHAIN'
3183 include 'COMMON.DERIV'
3184 include 'COMMON.INTERACT'
3185 include 'COMMON.CONTACTS'
3186 include 'COMMON.TORSION'
3187 include 'COMMON.VECTORS'
3188 include 'COMMON.FFIELD'
3189 include 'COMMON.TIME1'
3190 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3191 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3192 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3193 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3194 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3195 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3197 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3199 double precision scal_el /1.0d0/
3201 double precision scal_el /0.5d0/
3204 C 13-go grudnia roku pamietnego...
3205 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3206 & 0.0d0,1.0d0,0.0d0,
3207 & 0.0d0,0.0d0,1.0d0/
3208 c time00=MPI_Wtime()
3209 cd write (iout,*) "eelecij",i,j
3213 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3214 aaa=app(iteli,itelj)
3215 bbb=bpp(iteli,itelj)
3216 ael6i=ael6(iteli,itelj)
3217 ael3i=ael3(iteli,itelj)
3221 dx_normj=dc_norm(1,j)
3222 dy_normj=dc_norm(2,j)
3223 dz_normj=dc_norm(3,j)
3224 xj=c(1,j)+0.5D0*dxj-xmedi
3225 yj=c(2,j)+0.5D0*dyj-ymedi
3226 zj=c(3,j)+0.5D0*dzj-zmedi
3227 rij=xj*xj+yj*yj+zj*zj
3233 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3234 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3235 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3236 fac=cosa-3.0D0*cosb*cosg
3238 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3239 if (j.eq.i+2) ev1=scal_el*ev1
3244 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3247 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3248 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3251 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3252 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3253 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3254 cd & xmedi,ymedi,zmedi,xj,yj,zj
3256 if (energy_dec) then
3257 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3258 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3262 C Calculate contributions to the Cartesian gradient.
3265 facvdw=-6*rrmij*(ev1+evdwij)
3266 facel=-3*rrmij*(el1+eesij)
3272 * Radial derivatives. First process both termini of the fragment (i,j)
3278 c ghalf=0.5D0*ggg(k)
3279 c gelc(k,i)=gelc(k,i)+ghalf
3280 c gelc(k,j)=gelc(k,j)+ghalf
3282 c 9/28/08 AL Gradient compotents will be summed only at the end
3284 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3285 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3288 * Loop over residues i+1 thru j-1.
3292 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3299 c ghalf=0.5D0*ggg(k)
3300 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3301 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3303 c 9/28/08 AL Gradient compotents will be summed only at the end
3305 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3306 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3309 * Loop over residues i+1 thru j-1.
3313 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3320 fac=-3*rrmij*(facvdw+facvdw+facel)
3325 * Radial derivatives. First process both termini of the fragment (i,j)
3331 c ghalf=0.5D0*ggg(k)
3332 c gelc(k,i)=gelc(k,i)+ghalf
3333 c gelc(k,j)=gelc(k,j)+ghalf
3335 c 9/28/08 AL Gradient compotents will be summed only at the end
3337 gelc_long(k,j)=gelc(k,j)+ggg(k)
3338 gelc_long(k,i)=gelc(k,i)-ggg(k)
3341 * Loop over residues i+1 thru j-1.
3345 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3348 c 9/28/08 AL Gradient compotents will be summed only at the end
3353 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3354 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3360 ecosa=2.0D0*fac3*fac1+fac4
3363 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3364 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3366 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3367 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3369 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3370 cd & (dcosg(k),k=1,3)
3372 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3375 c ghalf=0.5D0*ggg(k)
3376 c gelc(k,i)=gelc(k,i)+ghalf
3377 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3378 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3379 c gelc(k,j)=gelc(k,j)+ghalf
3380 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3381 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3385 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3390 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3391 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3393 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3394 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3395 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3396 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3398 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3399 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3400 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3402 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3403 C energy of a peptide unit is assumed in the form of a second-order
3404 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3405 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3406 C are computed for EVERY pair of non-contiguous peptide groups.
3408 if (j.lt.nres-1) then
3419 muij(kkk)=mu(k,i)*mu(l,j)
3422 cd write (iout,*) 'EELEC: i',i,' j',j
3423 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3424 cd write(iout,*) 'muij',muij
3425 ury=scalar(uy(1,i),erij)
3426 urz=scalar(uz(1,i),erij)
3427 vry=scalar(uy(1,j),erij)
3428 vrz=scalar(uz(1,j),erij)
3429 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3430 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3431 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3432 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3433 fac=dsqrt(-ael6i)*r3ij
3438 cd write (iout,'(4i5,4f10.5)')
3439 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3440 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3441 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3442 cd & uy(:,j),uz(:,j)
3443 cd write (iout,'(4f10.5)')
3444 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3445 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3446 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3447 cd write (iout,'(9f10.5/)')
3448 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3449 C Derivatives of the elements of A in virtual-bond vectors
3450 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3452 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3453 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3454 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3455 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3456 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3457 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3458 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3459 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3460 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3461 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3462 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3463 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3465 C Compute radial contributions to the gradient
3483 C Add the contributions coming from er
3486 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3487 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3488 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3489 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3492 C Derivatives in DC(i)
3493 cgrad ghalf1=0.5d0*agg(k,1)
3494 cgrad ghalf2=0.5d0*agg(k,2)
3495 cgrad ghalf3=0.5d0*agg(k,3)
3496 cgrad ghalf4=0.5d0*agg(k,4)
3497 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3498 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3499 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3500 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3501 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3502 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3503 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3504 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3505 C Derivatives in DC(i+1)
3506 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3507 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3508 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3509 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3510 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3511 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3512 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3513 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3514 C Derivatives in DC(j)
3515 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3516 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3517 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3518 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3519 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3520 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3521 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3522 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3523 C Derivatives in DC(j+1) or DC(nres-1)
3524 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3525 & -3.0d0*vryg(k,3)*ury)
3526 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3527 & -3.0d0*vrzg(k,3)*ury)
3528 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3529 & -3.0d0*vryg(k,3)*urz)
3530 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3531 & -3.0d0*vrzg(k,3)*urz)
3532 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3534 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3547 aggi(k,l)=-aggi(k,l)
3548 aggi1(k,l)=-aggi1(k,l)
3549 aggj(k,l)=-aggj(k,l)
3550 aggj1(k,l)=-aggj1(k,l)
3553 if (j.lt.nres-1) then
3559 aggi(k,l)=-aggi(k,l)
3560 aggi1(k,l)=-aggi1(k,l)
3561 aggj(k,l)=-aggj(k,l)
3562 aggj1(k,l)=-aggj1(k,l)
3573 aggi(k,l)=-aggi(k,l)
3574 aggi1(k,l)=-aggi1(k,l)
3575 aggj(k,l)=-aggj(k,l)
3576 aggj1(k,l)=-aggj1(k,l)
3581 IF (wel_loc.gt.0.0d0) THEN
3582 C Contribution to the local-electrostatic energy coming from the i-j pair
3583 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3585 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3587 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3588 & 'eelloc',i,j,eel_loc_ij
3590 eel_loc=eel_loc+eel_loc_ij
3591 C Partial derivatives in virtual-bond dihedral angles gamma
3593 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3594 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3595 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3596 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3597 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3598 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3599 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3601 ggg(l)=agg(l,1)*muij(1)+
3602 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3603 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3604 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3605 cgrad ghalf=0.5d0*ggg(l)
3606 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3607 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3611 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3614 C Remaining derivatives of eello
3616 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3617 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3618 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3619 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3620 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3621 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3622 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3623 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3626 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3627 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3628 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3629 & .and. num_conti.le.maxconts) then
3630 c write (iout,*) i,j," entered corr"
3632 C Calculate the contact function. The ith column of the array JCONT will
3633 C contain the numbers of atoms that make contacts with the atom I (of numbers
3634 C greater than I). The arrays FACONT and GACONT will contain the values of
3635 C the contact function and its derivative.
3636 c r0ij=1.02D0*rpp(iteli,itelj)
3637 c r0ij=1.11D0*rpp(iteli,itelj)
3638 r0ij=2.20D0*rpp(iteli,itelj)
3639 c r0ij=1.55D0*rpp(iteli,itelj)
3640 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3641 if (fcont.gt.0.0D0) then
3642 num_conti=num_conti+1
3643 if (num_conti.gt.maxconts) then
3644 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3645 & ' will skip next contacts for this conf.'
3647 jcont_hb(num_conti,i)=j
3648 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3649 cd & " jcont_hb",jcont_hb(num_conti,i)
3650 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3651 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3652 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3654 d_cont(num_conti,i)=rij
3655 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3656 C --- Electrostatic-interaction matrix ---
3657 a_chuj(1,1,num_conti,i)=a22
3658 a_chuj(1,2,num_conti,i)=a23
3659 a_chuj(2,1,num_conti,i)=a32
3660 a_chuj(2,2,num_conti,i)=a33
3661 C --- Gradient of rij
3663 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3670 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3671 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3672 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3673 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3674 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3679 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3680 C Calculate contact energies
3682 wij=cosa-3.0D0*cosb*cosg
3685 c fac3=dsqrt(-ael6i)/r0ij**3
3686 fac3=dsqrt(-ael6i)*r3ij
3687 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3688 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3689 if (ees0tmp.gt.0) then
3690 ees0pij=dsqrt(ees0tmp)
3694 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3695 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3696 if (ees0tmp.gt.0) then
3697 ees0mij=dsqrt(ees0tmp)
3702 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3703 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3704 C Diagnostics. Comment out or remove after debugging!
3705 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3706 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3707 c ees0m(num_conti,i)=0.0D0
3709 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3710 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3711 C Angular derivatives of the contact function
3712 ees0pij1=fac3/ees0pij
3713 ees0mij1=fac3/ees0mij
3714 fac3p=-3.0D0*fac3*rrmij
3715 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3716 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3718 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3719 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3720 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3721 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3722 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3723 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3724 ecosap=ecosa1+ecosa2
3725 ecosbp=ecosb1+ecosb2
3726 ecosgp=ecosg1+ecosg2
3727 ecosam=ecosa1-ecosa2
3728 ecosbm=ecosb1-ecosb2
3729 ecosgm=ecosg1-ecosg2
3738 facont_hb(num_conti,i)=fcont
3739 fprimcont=fprimcont/rij
3740 cd facont_hb(num_conti,i)=1.0D0
3741 C Following line is for diagnostics.
3744 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3745 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3748 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3749 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3751 gggp(1)=gggp(1)+ees0pijp*xj
3752 gggp(2)=gggp(2)+ees0pijp*yj
3753 gggp(3)=gggp(3)+ees0pijp*zj
3754 gggm(1)=gggm(1)+ees0mijp*xj
3755 gggm(2)=gggm(2)+ees0mijp*yj
3756 gggm(3)=gggm(3)+ees0mijp*zj
3757 C Derivatives due to the contact function
3758 gacont_hbr(1,num_conti,i)=fprimcont*xj
3759 gacont_hbr(2,num_conti,i)=fprimcont*yj
3760 gacont_hbr(3,num_conti,i)=fprimcont*zj
3763 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3764 c following the change of gradient-summation algorithm.
3766 cgrad ghalfp=0.5D0*gggp(k)
3767 cgrad ghalfm=0.5D0*gggm(k)
3768 gacontp_hb1(k,num_conti,i)=!ghalfp
3769 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3770 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3771 gacontp_hb2(k,num_conti,i)=!ghalfp
3772 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3773 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3774 gacontp_hb3(k,num_conti,i)=gggp(k)
3775 gacontm_hb1(k,num_conti,i)=!ghalfm
3776 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3777 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3778 gacontm_hb2(k,num_conti,i)=!ghalfm
3779 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3780 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3781 gacontm_hb3(k,num_conti,i)=gggm(k)
3783 C Diagnostics. Comment out or remove after debugging!
3785 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3786 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3787 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3788 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3789 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3790 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3793 endif ! num_conti.le.maxconts
3796 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3799 ghalf=0.5d0*agg(l,k)
3800 aggi(l,k)=aggi(l,k)+ghalf
3801 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3802 aggj(l,k)=aggj(l,k)+ghalf
3805 if (j.eq.nres-1 .and. i.lt.j-2) then
3808 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3813 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3816 C-----------------------------------------------------------------------------
3817 subroutine eturn3(i,eello_turn3)
3818 C Third- and fourth-order contributions from turns
3819 implicit real*8 (a-h,o-z)
3820 include 'DIMENSIONS'
3821 include 'COMMON.IOUNITS'
3822 include 'COMMON.GEO'
3823 include 'COMMON.VAR'
3824 include 'COMMON.LOCAL'
3825 include 'COMMON.CHAIN'
3826 include 'COMMON.DERIV'
3827 include 'COMMON.INTERACT'
3828 include 'COMMON.CONTACTS'
3829 include 'COMMON.TORSION'
3830 include 'COMMON.VECTORS'
3831 include 'COMMON.FFIELD'
3832 include 'COMMON.CONTROL'
3834 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3835 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3836 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3837 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3838 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3839 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3840 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3843 c write (iout,*) "eturn3",i,j,j1,j2
3848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3850 C Third-order contributions
3857 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3858 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3859 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3860 call transpose2(auxmat(1,1),auxmat1(1,1))
3861 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3862 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3863 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3864 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3865 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3866 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3867 cd & ' eello_turn3_num',4*eello_turn3_num
3868 C Derivatives in gamma(i)
3869 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3870 call transpose2(auxmat2(1,1),auxmat3(1,1))
3871 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3872 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3873 C Derivatives in gamma(i+1)
3874 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3875 call transpose2(auxmat2(1,1),auxmat3(1,1))
3876 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3877 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3878 & +0.5d0*(pizda(1,1)+pizda(2,2))
3879 C Cartesian derivatives
3881 c ghalf1=0.5d0*agg(l,1)
3882 c ghalf2=0.5d0*agg(l,2)
3883 c ghalf3=0.5d0*agg(l,3)
3884 c ghalf4=0.5d0*agg(l,4)
3885 a_temp(1,1)=aggi(l,1)!+ghalf1
3886 a_temp(1,2)=aggi(l,2)!+ghalf2
3887 a_temp(2,1)=aggi(l,3)!+ghalf3
3888 a_temp(2,2)=aggi(l,4)!+ghalf4
3889 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3890 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3891 & +0.5d0*(pizda(1,1)+pizda(2,2))
3892 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3893 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3894 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3895 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3896 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3897 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3898 & +0.5d0*(pizda(1,1)+pizda(2,2))
3899 a_temp(1,1)=aggj(l,1)!+ghalf1
3900 a_temp(1,2)=aggj(l,2)!+ghalf2
3901 a_temp(2,1)=aggj(l,3)!+ghalf3
3902 a_temp(2,2)=aggj(l,4)!+ghalf4
3903 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3904 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3905 & +0.5d0*(pizda(1,1)+pizda(2,2))
3906 a_temp(1,1)=aggj1(l,1)
3907 a_temp(1,2)=aggj1(l,2)
3908 a_temp(2,1)=aggj1(l,3)
3909 a_temp(2,2)=aggj1(l,4)
3910 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3911 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3912 & +0.5d0*(pizda(1,1)+pizda(2,2))
3916 C-------------------------------------------------------------------------------
3917 subroutine eturn4(i,eello_turn4)
3918 C Third- and fourth-order contributions from turns
3919 implicit real*8 (a-h,o-z)
3920 include 'DIMENSIONS'
3921 include 'COMMON.IOUNITS'
3922 include 'COMMON.GEO'
3923 include 'COMMON.VAR'
3924 include 'COMMON.LOCAL'
3925 include 'COMMON.CHAIN'
3926 include 'COMMON.DERIV'
3927 include 'COMMON.INTERACT'
3928 include 'COMMON.CONTACTS'
3929 include 'COMMON.TORSION'
3930 include 'COMMON.VECTORS'
3931 include 'COMMON.FFIELD'
3932 include 'COMMON.CONTROL'
3934 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3935 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3936 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3937 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3938 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3939 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3940 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3943 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3945 C Fourth-order contributions
3953 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3954 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3955 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3960 iti1=itortyp(itype(i+1))
3961 iti2=itortyp(itype(i+2))
3962 iti3=itortyp(itype(i+3))
3963 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3964 call transpose2(EUg(1,1,i+1),e1t(1,1))
3965 call transpose2(Eug(1,1,i+2),e2t(1,1))
3966 call transpose2(Eug(1,1,i+3),e3t(1,1))
3967 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3968 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3969 s1=scalar2(b1(1,iti2),auxvec(1))
3970 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3971 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3972 s2=scalar2(b1(1,iti1),auxvec(1))
3973 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3974 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3975 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3976 eello_turn4=eello_turn4-(s1+s2+s3)
3977 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3978 & 'eturn4',i,j,-(s1+s2+s3)
3979 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3980 cd & ' eello_turn4_num',8*eello_turn4_num
3981 C Derivatives in gamma(i)
3982 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3983 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3984 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3985 s1=scalar2(b1(1,iti2),auxvec(1))
3986 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3988 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3989 C Derivatives in gamma(i+1)
3990 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3991 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3992 s2=scalar2(b1(1,iti1),auxvec(1))
3993 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3994 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3995 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3996 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3997 C Derivatives in gamma(i+2)
3998 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3999 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4000 s1=scalar2(b1(1,iti2),auxvec(1))
4001 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4002 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4003 s2=scalar2(b1(1,iti1),auxvec(1))
4004 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4005 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4006 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4007 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4008 C Cartesian derivatives
4009 C Derivatives of this turn contributions in DC(i+2)
4010 if (j.lt.nres-1) then
4012 a_temp(1,1)=agg(l,1)
4013 a_temp(1,2)=agg(l,2)
4014 a_temp(2,1)=agg(l,3)
4015 a_temp(2,2)=agg(l,4)
4016 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4017 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4018 s1=scalar2(b1(1,iti2),auxvec(1))
4019 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4020 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4021 s2=scalar2(b1(1,iti1),auxvec(1))
4022 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4023 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4024 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4026 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4029 C Remaining derivatives of this turn contribution
4031 a_temp(1,1)=aggi(l,1)
4032 a_temp(1,2)=aggi(l,2)
4033 a_temp(2,1)=aggi(l,3)
4034 a_temp(2,2)=aggi(l,4)
4035 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4036 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4037 s1=scalar2(b1(1,iti2),auxvec(1))
4038 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4039 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4040 s2=scalar2(b1(1,iti1),auxvec(1))
4041 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4042 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4043 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4044 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4045 a_temp(1,1)=aggi1(l,1)
4046 a_temp(1,2)=aggi1(l,2)
4047 a_temp(2,1)=aggi1(l,3)
4048 a_temp(2,2)=aggi1(l,4)
4049 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4050 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4051 s1=scalar2(b1(1,iti2),auxvec(1))
4052 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4053 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4054 s2=scalar2(b1(1,iti1),auxvec(1))
4055 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4056 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4057 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4058 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4059 a_temp(1,1)=aggj(l,1)
4060 a_temp(1,2)=aggj(l,2)
4061 a_temp(2,1)=aggj(l,3)
4062 a_temp(2,2)=aggj(l,4)
4063 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4064 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4065 s1=scalar2(b1(1,iti2),auxvec(1))
4066 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4067 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4068 s2=scalar2(b1(1,iti1),auxvec(1))
4069 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4070 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4071 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4072 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4073 a_temp(1,1)=aggj1(l,1)
4074 a_temp(1,2)=aggj1(l,2)
4075 a_temp(2,1)=aggj1(l,3)
4076 a_temp(2,2)=aggj1(l,4)
4077 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4078 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4079 s1=scalar2(b1(1,iti2),auxvec(1))
4080 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4081 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4082 s2=scalar2(b1(1,iti1),auxvec(1))
4083 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4084 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4085 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4086 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4087 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4091 C-----------------------------------------------------------------------------
4092 subroutine vecpr(u,v,w)
4093 implicit real*8(a-h,o-z)
4094 dimension u(3),v(3),w(3)
4095 w(1)=u(2)*v(3)-u(3)*v(2)
4096 w(2)=-u(1)*v(3)+u(3)*v(1)
4097 w(3)=u(1)*v(2)-u(2)*v(1)
4100 C-----------------------------------------------------------------------------
4101 subroutine unormderiv(u,ugrad,unorm,ungrad)
4102 C This subroutine computes the derivatives of a normalized vector u, given
4103 C the derivatives computed without normalization conditions, ugrad. Returns
4106 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4107 double precision vec(3)
4108 double precision scalar
4110 c write (2,*) 'ugrad',ugrad
4113 vec(i)=scalar(ugrad(1,i),u(1))
4115 c write (2,*) 'vec',vec
4118 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4121 c write (2,*) 'ungrad',ungrad
4124 C-----------------------------------------------------------------------------
4125 subroutine escp_soft_sphere(evdw2,evdw2_14)
4127 C This subroutine calculates the excluded-volume interaction energy between
4128 C peptide-group centers and side chains and its gradient in virtual-bond and
4129 C side-chain vectors.
4131 implicit real*8 (a-h,o-z)
4132 include 'DIMENSIONS'
4133 include 'COMMON.GEO'
4134 include 'COMMON.VAR'
4135 include 'COMMON.LOCAL'
4136 include 'COMMON.CHAIN'
4137 include 'COMMON.DERIV'
4138 include 'COMMON.INTERACT'
4139 include 'COMMON.FFIELD'
4140 include 'COMMON.IOUNITS'
4141 include 'COMMON.CONTROL'
4146 cd print '(a)','Enter ESCP'
4147 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4148 do i=iatscp_s,iatscp_e
4150 xi=0.5D0*(c(1,i)+c(1,i+1))
4151 yi=0.5D0*(c(2,i)+c(2,i+1))
4152 zi=0.5D0*(c(3,i)+c(3,i+1))
4154 do iint=1,nscp_gr(i)
4156 do j=iscpstart(i,iint),iscpend(i,iint)
4158 C Uncomment following three lines for SC-p interactions
4162 C Uncomment following three lines for Ca-p interactions
4166 rij=xj*xj+yj*yj+zj*zj
4169 if (rij.lt.r0ijsq) then
4170 evdwij=0.25d0*(rij-r0ijsq)**2
4178 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4183 cgrad if (j.lt.i) then
4184 cd write (iout,*) 'j<i'
4185 C Uncomment following three lines for SC-p interactions
4187 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4190 cd write (iout,*) 'j>i'
4192 cgrad ggg(k)=-ggg(k)
4193 C Uncomment following line for SC-p interactions
4194 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4198 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4200 cgrad kstart=min0(i+1,j)
4201 cgrad kend=max0(i-1,j-1)
4202 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4203 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4204 cgrad do k=kstart,kend
4206 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4210 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4211 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4219 C-----------------------------------------------------------------------------
4220 subroutine escp(evdw2,evdw2_14)
4222 C This subroutine calculates the excluded-volume interaction energy between
4223 C peptide-group centers and side chains and its gradient in virtual-bond and
4224 C side-chain vectors.
4226 implicit real*8 (a-h,o-z)
4227 include 'DIMENSIONS'
4228 include 'COMMON.GEO'
4229 include 'COMMON.VAR'
4230 include 'COMMON.LOCAL'
4231 include 'COMMON.CHAIN'
4232 include 'COMMON.DERIV'
4233 include 'COMMON.INTERACT'
4234 include 'COMMON.FFIELD'
4235 include 'COMMON.IOUNITS'
4236 include 'COMMON.CONTROL'
4240 cd print '(a)','Enter ESCP'
4241 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4242 do i=iatscp_s,iatscp_e
4244 xi=0.5D0*(c(1,i)+c(1,i+1))
4245 yi=0.5D0*(c(2,i)+c(2,i+1))
4246 zi=0.5D0*(c(3,i)+c(3,i+1))
4248 do iint=1,nscp_gr(i)
4250 do j=iscpstart(i,iint),iscpend(i,iint)
4252 C Uncomment following three lines for SC-p interactions
4256 C Uncomment following three lines for Ca-p interactions
4260 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4262 e1=fac*fac*aad(itypj,iteli)
4263 e2=fac*bad(itypj,iteli)
4264 if (iabs(j-i) .le. 2) then
4267 evdw2_14=evdw2_14+e1+e2
4271 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4272 & 'evdw2',i,j,evdwij
4274 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4276 fac=-(evdwij+e1)*rrij
4280 cgrad if (j.lt.i) then
4281 cd write (iout,*) 'j<i'
4282 C Uncomment following three lines for SC-p interactions
4284 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4287 cd write (iout,*) 'j>i'
4289 cgrad ggg(k)=-ggg(k)
4290 C Uncomment following line for SC-p interactions
4291 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4292 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4296 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4298 cgrad kstart=min0(i+1,j)
4299 cgrad kend=max0(i-1,j-1)
4300 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4301 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4302 cgrad do k=kstart,kend
4304 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4308 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4309 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4317 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4318 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4319 gradx_scp(j,i)=expon*gradx_scp(j,i)
4322 C******************************************************************************
4326 C To save time the factor EXPON has been extracted from ALL components
4327 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4330 C******************************************************************************
4333 C--------------------------------------------------------------------------
4334 subroutine edis(ehpb)
4336 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4338 implicit real*8 (a-h,o-z)
4339 include 'DIMENSIONS'
4340 include 'COMMON.SBRIDGE'
4341 include 'COMMON.CHAIN'
4342 include 'COMMON.DERIV'
4343 include 'COMMON.VAR'
4344 include 'COMMON.INTERACT'
4345 include 'COMMON.IOUNITS'
4348 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4349 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4350 if (link_end.eq.0) return
4351 do i=link_start,link_end
4352 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4353 C CA-CA distance used in regularization of structure.
4356 C iii and jjj point to the residues for which the distance is assigned.
4357 if (ii.gt.nres) then
4364 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4365 c & dhpb(i),dhpb1(i),forcon(i)
4366 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4367 C distance and angle dependent SS bond potential.
4368 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4369 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4370 if (.not.dyn_ss .and. i.le.nss) then
4371 C 15/02/13 CC dynamic SSbond - additional check
4373 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4374 call ssbond_ene(iii,jjj,eij)
4377 cd write (iout,*) "eij",eij
4378 else if (ii.gt.nres .and. jj.gt.nres) then
4379 c Restraints from contact prediction
4381 if (dhpb1(i).gt.0.0d0) then
4382 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4383 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4384 c write (iout,*) "beta nmr",
4385 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4389 C Get the force constant corresponding to this distance.
4391 C Calculate the contribution to energy.
4392 ehpb=ehpb+waga*rdis*rdis
4393 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4395 C Evaluate gradient.
4400 ggg(j)=fac*(c(j,jj)-c(j,ii))
4403 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4404 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4407 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4408 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4411 C Calculate the distance between the two points and its difference from the
4414 if (dhpb1(i).gt.0.0d0) then
4415 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4416 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4417 c write (iout,*) "alph nmr",
4418 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4421 C Get the force constant corresponding to this distance.
4423 C Calculate the contribution to energy.
4424 ehpb=ehpb+waga*rdis*rdis
4425 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4427 C Evaluate gradient.
4431 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4432 cd & ' waga=',waga,' fac=',fac
4434 ggg(j)=fac*(c(j,jj)-c(j,ii))
4436 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4437 C If this is a SC-SC distance, we need to calculate the contributions to the
4438 C Cartesian gradient in the SC vectors (ghpbx).
4441 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4442 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4445 cgrad do j=iii,jjj-1
4447 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4451 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4452 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4459 C--------------------------------------------------------------------------
4460 subroutine ssbond_ene(i,j,eij)
4462 C Calculate the distance and angle dependent SS-bond potential energy
4463 C using a free-energy function derived based on RHF/6-31G** ab initio
4464 C calculations of diethyl disulfide.
4466 C A. Liwo and U. Kozlowska, 11/24/03
4468 implicit real*8 (a-h,o-z)
4469 include 'DIMENSIONS'
4470 include 'COMMON.SBRIDGE'
4471 include 'COMMON.CHAIN'
4472 include 'COMMON.DERIV'
4473 include 'COMMON.LOCAL'
4474 include 'COMMON.INTERACT'
4475 include 'COMMON.VAR'
4476 include 'COMMON.IOUNITS'
4477 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4482 dxi=dc_norm(1,nres+i)
4483 dyi=dc_norm(2,nres+i)
4484 dzi=dc_norm(3,nres+i)
4485 c dsci_inv=dsc_inv(itypi)
4486 dsci_inv=vbld_inv(nres+i)
4488 c dscj_inv=dsc_inv(itypj)
4489 dscj_inv=vbld_inv(nres+j)
4493 dxj=dc_norm(1,nres+j)
4494 dyj=dc_norm(2,nres+j)
4495 dzj=dc_norm(3,nres+j)
4496 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4501 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4502 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4503 om12=dxi*dxj+dyi*dyj+dzi*dzj
4505 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4506 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4512 deltat12=om2-om1+2.0d0
4514 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4515 & +akct*deltad*deltat12+ebr
4516 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4517 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4518 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4519 c & " deltat12",deltat12," eij",eij
4520 ed=2*akcm*deltad+akct*deltat12
4522 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4523 eom1=-2*akth*deltat1-pom1-om2*pom2
4524 eom2= 2*akth*deltat2+pom1-om1*pom2
4527 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4528 ghpbx(k,i)=ghpbx(k,i)-ggk
4529 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4530 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4531 ghpbx(k,j)=ghpbx(k,j)+ggk
4532 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4533 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4534 ghpbc(k,i)=ghpbc(k,i)-ggk
4535 ghpbc(k,j)=ghpbc(k,j)+ggk
4538 C Calculate the components of the gradient in DC and X
4542 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4547 C--------------------------------------------------------------------------
4548 subroutine ebond(estr)
4550 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4552 implicit real*8 (a-h,o-z)
4553 include 'DIMENSIONS'
4554 include 'COMMON.LOCAL'
4555 include 'COMMON.GEO'
4556 include 'COMMON.INTERACT'
4557 include 'COMMON.DERIV'
4558 include 'COMMON.VAR'
4559 include 'COMMON.CHAIN'
4560 include 'COMMON.IOUNITS'
4561 include 'COMMON.NAMES'
4562 include 'COMMON.FFIELD'
4563 include 'COMMON.CONTROL'
4564 include 'COMMON.SETUP'
4565 double precision u(3),ud(3)
4567 do i=ibondp_start,ibondp_end
4568 diff = vbld(i)-vbldp0
4569 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4572 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4574 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4578 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4580 do i=ibond_start,ibond_end
4585 diff=vbld(i+nres)-vbldsc0(1,iti)
4586 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4587 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4588 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4590 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4594 diff=vbld(i+nres)-vbldsc0(j,iti)
4595 ud(j)=aksc(j,iti)*diff
4596 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4610 uprod2=uprod2*u(k)*u(k)
4614 usumsqder=usumsqder+ud(j)*uprod2
4616 estr=estr+uprod/usum
4618 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4626 C--------------------------------------------------------------------------
4627 subroutine ebend(etheta)
4629 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4630 C angles gamma and its derivatives in consecutive thetas and gammas.
4632 implicit real*8 (a-h,o-z)
4633 include 'DIMENSIONS'
4634 include 'COMMON.LOCAL'
4635 include 'COMMON.GEO'
4636 include 'COMMON.INTERACT'
4637 include 'COMMON.DERIV'
4638 include 'COMMON.VAR'
4639 include 'COMMON.CHAIN'
4640 include 'COMMON.IOUNITS'
4641 include 'COMMON.NAMES'
4642 include 'COMMON.FFIELD'
4643 include 'COMMON.CONTROL'
4644 common /calcthet/ term1,term2,termm,diffak,ratak,
4645 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4646 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4647 double precision y(2),z(2)
4649 c time11=dexp(-2*time)
4652 c write (*,'(a,i2)') 'EBEND ICG=',icg
4653 do i=ithet_start,ithet_end
4654 C Zero the energy function and its derivative at 0 or pi.
4655 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4660 if (phii.ne.phii) phii=150.0
4673 if (phii1.ne.phii1) phii1=150.0
4685 C Calculate the "mean" value of theta from the part of the distribution
4686 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4687 C In following comments this theta will be referred to as t_c.
4688 thet_pred_mean=0.0d0
4692 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4694 dthett=thet_pred_mean*ssd
4695 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4696 C Derivatives of the "mean" values in gamma1 and gamma2.
4697 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4698 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4699 if (theta(i).gt.pi-delta) then
4700 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4702 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4703 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4704 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4706 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4708 else if (theta(i).lt.delta) then
4709 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4710 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4711 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4713 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4714 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4717 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4720 etheta=etheta+ethetai
4721 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4723 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4724 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4725 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4727 C Ufff.... We've done all this!!!
4730 C---------------------------------------------------------------------------
4731 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4733 implicit real*8 (a-h,o-z)
4734 include 'DIMENSIONS'
4735 include 'COMMON.LOCAL'
4736 include 'COMMON.IOUNITS'
4737 common /calcthet/ term1,term2,termm,diffak,ratak,
4738 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4739 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4740 C Calculate the contributions to both Gaussian lobes.
4741 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4742 C The "polynomial part" of the "standard deviation" of this part of
4746 sig=sig*thet_pred_mean+polthet(j,it)
4748 C Derivative of the "interior part" of the "standard deviation of the"
4749 C gamma-dependent Gaussian lobe in t_c.
4750 sigtc=3*polthet(3,it)
4752 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4755 C Set the parameters of both Gaussian lobes of the distribution.
4756 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4757 fac=sig*sig+sigc0(it)
4760 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4761 sigsqtc=-4.0D0*sigcsq*sigtc
4762 c print *,i,sig,sigtc,sigsqtc
4763 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4764 sigtc=-sigtc/(fac*fac)
4765 C Following variable is sigma(t_c)**(-2)
4766 sigcsq=sigcsq*sigcsq
4768 sig0inv=1.0D0/sig0i**2
4769 delthec=thetai-thet_pred_mean
4770 delthe0=thetai-theta0i
4771 term1=-0.5D0*sigcsq*delthec*delthec
4772 term2=-0.5D0*sig0inv*delthe0*delthe0
4773 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4774 C NaNs in taking the logarithm. We extract the largest exponent which is added
4775 C to the energy (this being the log of the distribution) at the end of energy
4776 C term evaluation for this virtual-bond angle.
4777 if (term1.gt.term2) then
4779 term2=dexp(term2-termm)
4783 term1=dexp(term1-termm)
4786 C The ratio between the gamma-independent and gamma-dependent lobes of
4787 C the distribution is a Gaussian function of thet_pred_mean too.
4788 diffak=gthet(2,it)-thet_pred_mean
4789 ratak=diffak/gthet(3,it)**2
4790 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4791 C Let's differentiate it in thet_pred_mean NOW.
4793 C Now put together the distribution terms to make complete distribution.
4794 termexp=term1+ak*term2
4795 termpre=sigc+ak*sig0i
4796 C Contribution of the bending energy from this theta is just the -log of
4797 C the sum of the contributions from the two lobes and the pre-exponential
4798 C factor. Simple enough, isn't it?
4799 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4800 C NOW the derivatives!!!
4801 C 6/6/97 Take into account the deformation.
4802 E_theta=(delthec*sigcsq*term1
4803 & +ak*delthe0*sig0inv*term2)/termexp
4804 E_tc=((sigtc+aktc*sig0i)/termpre
4805 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4806 & aktc*term2)/termexp)
4809 c-----------------------------------------------------------------------------
4810 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4811 implicit real*8 (a-h,o-z)
4812 include 'DIMENSIONS'
4813 include 'COMMON.LOCAL'
4814 include 'COMMON.IOUNITS'
4815 common /calcthet/ term1,term2,termm,diffak,ratak,
4816 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4817 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4818 delthec=thetai-thet_pred_mean
4819 delthe0=thetai-theta0i
4820 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4821 t3 = thetai-thet_pred_mean
4825 t14 = t12+t6*sigsqtc
4827 t21 = thetai-theta0i
4833 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4834 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4835 & *(-t12*t9-ak*sig0inv*t27)
4839 C--------------------------------------------------------------------------
4840 subroutine ebend(etheta)
4842 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4843 C angles gamma and its derivatives in consecutive thetas and gammas.
4844 C ab initio-derived potentials from
4845 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4847 implicit real*8 (a-h,o-z)
4848 include 'DIMENSIONS'
4849 include 'COMMON.LOCAL'
4850 include 'COMMON.GEO'
4851 include 'COMMON.INTERACT'
4852 include 'COMMON.DERIV'
4853 include 'COMMON.VAR'
4854 include 'COMMON.CHAIN'
4855 include 'COMMON.IOUNITS'
4856 include 'COMMON.NAMES'
4857 include 'COMMON.FFIELD'
4858 include 'COMMON.CONTROL'
4859 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4860 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4861 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4862 & sinph1ph2(maxdouble,maxdouble)
4863 logical lprn /.false./, lprn1 /.false./
4865 c write (iout,*) "EBEND ithet_start",ithet_start,
4866 c & " ithet_end",ithet_end
4867 do i=ithet_start,ithet_end
4868 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4869 &(itype(i).eq.ntyp1)) cycle
4873 theti2=0.5d0*theta(i)
4874 ityp2=ithetyp(itype(i-1))
4876 coskt(k)=dcos(k*theti2)
4877 sinkt(k)=dsin(k*theti2)
4880 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4883 if (phii.ne.phii) phii=150.0
4887 ityp1=ithetyp(itype(i-2))
4889 cosph1(k)=dcos(k*phii)
4890 sinph1(k)=dsin(k*phii)
4894 ityp1=ithetyp(itype(i-2))
4900 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4903 if (phii1.ne.phii1) phii1=150.0
4908 ityp3=ithetyp(itype(i))
4910 cosph2(k)=dcos(k*phii1)
4911 sinph2(k)=dsin(k*phii1)
4915 ityp3=ithetyp(itype(i))
4921 ethetai=aa0thet(ityp1,ityp2,ityp3)
4924 ccl=cosph1(l)*cosph2(k-l)
4925 ssl=sinph1(l)*sinph2(k-l)
4926 scl=sinph1(l)*cosph2(k-l)
4927 csl=cosph1(l)*sinph2(k-l)
4928 cosph1ph2(l,k)=ccl-ssl
4929 cosph1ph2(k,l)=ccl+ssl
4930 sinph1ph2(l,k)=scl+csl
4931 sinph1ph2(k,l)=scl-csl
4935 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4936 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4937 write (iout,*) "coskt and sinkt"
4939 write (iout,*) k,coskt(k),sinkt(k)
4943 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4944 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4947 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4948 & " ethetai",ethetai
4951 write (iout,*) "cosph and sinph"
4953 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4955 write (iout,*) "cosph1ph2 and sinph2ph2"
4958 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4959 & sinph1ph2(l,k),sinph1ph2(k,l)
4962 write(iout,*) "ethetai",ethetai
4966 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4967 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4968 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4969 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4970 ethetai=ethetai+sinkt(m)*aux
4971 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4972 dephii=dephii+k*sinkt(m)*(
4973 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4974 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4975 dephii1=dephii1+k*sinkt(m)*(
4976 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4977 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4979 & write (iout,*) "m",m," k",k," bbthet",
4980 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4981 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4982 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4983 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4987 & write(iout,*) "ethetai",ethetai
4991 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4992 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4993 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4994 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4995 ethetai=ethetai+sinkt(m)*aux
4996 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4997 dephii=dephii+l*sinkt(m)*(
4998 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4999 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5000 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5001 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5002 dephii1=dephii1+(k-l)*sinkt(m)*(
5003 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5004 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5005 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5006 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5008 write (iout,*) "m",m," k",k," l",l," ffthet",
5009 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5010 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5011 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5012 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5013 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5014 & cosph1ph2(k,l)*sinkt(m),
5015 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5022 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
5023 & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
5024 & phii1*rad2deg,ethetai
5026 etheta=etheta+ethetai
5027 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5028 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5029 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5035 c-----------------------------------------------------------------------------
5036 subroutine esc(escloc)
5037 C Calculate the local energy of a side chain and its derivatives in the
5038 C corresponding virtual-bond valence angles THETA and the spherical angles
5040 implicit real*8 (a-h,o-z)
5041 include 'DIMENSIONS'
5042 include 'COMMON.GEO'
5043 include 'COMMON.LOCAL'
5044 include 'COMMON.VAR'
5045 include 'COMMON.INTERACT'
5046 include 'COMMON.DERIV'
5047 include 'COMMON.CHAIN'
5048 include 'COMMON.IOUNITS'
5049 include 'COMMON.NAMES'
5050 include 'COMMON.FFIELD'
5051 include 'COMMON.CONTROL'
5052 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5053 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5054 common /sccalc/ time11,time12,time112,theti,it,nlobit
5057 c write (iout,'(a)') 'ESC'
5058 do i=loc_start,loc_end
5060 if (it.eq.10) goto 1
5062 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5063 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5064 theti=theta(i+1)-pipol
5069 if (x(2).gt.pi-delta) then
5073 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5075 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5076 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5078 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5079 & ddersc0(1),dersc(1))
5080 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5081 & ddersc0(3),dersc(3))
5083 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5085 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5086 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5087 & dersc0(2),esclocbi,dersc02)
5088 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5090 call splinthet(x(2),0.5d0*delta,ss,ssd)
5095 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5097 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5098 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5100 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5102 c write (iout,*) escloci
5103 else if (x(2).lt.delta) then
5107 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5109 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5110 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5112 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5113 & ddersc0(1),dersc(1))
5114 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5115 & ddersc0(3),dersc(3))
5117 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5119 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5120 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5121 & dersc0(2),esclocbi,dersc02)
5122 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5127 call splinthet(x(2),0.5d0*delta,ss,ssd)
5129 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5131 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5132 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5134 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5135 c write (iout,*) escloci
5137 call enesc(x,escloci,dersc,ddummy,.false.)
5140 escloc=escloc+escloci
5141 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5142 & 'escloc',i,escloci
5143 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5145 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5147 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5148 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5153 C---------------------------------------------------------------------------
5154 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5155 implicit real*8 (a-h,o-z)
5156 include 'DIMENSIONS'
5157 include 'COMMON.GEO'
5158 include 'COMMON.LOCAL'
5159 include 'COMMON.IOUNITS'
5160 common /sccalc/ time11,time12,time112,theti,it,nlobit
5161 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5162 double precision contr(maxlob,-1:1)
5164 c write (iout,*) 'it=',it,' nlobit=',nlobit
5168 if (mixed) ddersc(j)=0.0d0
5172 C Because of periodicity of the dependence of the SC energy in omega we have
5173 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5174 C To avoid underflows, first compute & store the exponents.
5182 z(k)=x(k)-censc(k,j,it)
5187 Axk=Axk+gaussc(l,k,j,it)*z(l)
5193 expfac=expfac+Ax(k,j,iii)*z(k)
5201 C As in the case of ebend, we want to avoid underflows in exponentiation and
5202 C subsequent NaNs and INFs in energy calculation.
5203 C Find the largest exponent
5207 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5211 cd print *,'it=',it,' emin=',emin
5213 C Compute the contribution to SC energy and derivatives
5218 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5219 if(adexp.ne.adexp) adexp=1.0
5222 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5224 cd print *,'j=',j,' expfac=',expfac
5225 escloc_i=escloc_i+expfac
5227 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5231 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5232 & +gaussc(k,2,j,it))*expfac
5239 dersc(1)=dersc(1)/cos(theti)**2
5240 ddersc(1)=ddersc(1)/cos(theti)**2
5243 escloci=-(dlog(escloc_i)-emin)
5245 dersc(j)=dersc(j)/escloc_i
5249 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5254 C------------------------------------------------------------------------------
5255 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5256 implicit real*8 (a-h,o-z)
5257 include 'DIMENSIONS'
5258 include 'COMMON.GEO'
5259 include 'COMMON.LOCAL'
5260 include 'COMMON.IOUNITS'
5261 common /sccalc/ time11,time12,time112,theti,it,nlobit
5262 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5263 double precision contr(maxlob)
5274 z(k)=x(k)-censc(k,j,it)
5280 Axk=Axk+gaussc(l,k,j,it)*z(l)
5286 expfac=expfac+Ax(k,j)*z(k)
5291 C As in the case of ebend, we want to avoid underflows in exponentiation and
5292 C subsequent NaNs and INFs in energy calculation.
5293 C Find the largest exponent
5296 if (emin.gt.contr(j)) emin=contr(j)
5300 C Compute the contribution to SC energy and derivatives
5304 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5305 escloc_i=escloc_i+expfac
5307 dersc(k)=dersc(k)+Ax(k,j)*expfac
5309 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5310 & +gaussc(1,2,j,it))*expfac
5314 dersc(1)=dersc(1)/cos(theti)**2
5315 dersc12=dersc12/cos(theti)**2
5316 escloci=-(dlog(escloc_i)-emin)
5318 dersc(j)=dersc(j)/escloc_i
5320 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5324 c----------------------------------------------------------------------------------
5325 subroutine esc(escloc)
5326 C Calculate the local energy of a side chain and its derivatives in the
5327 C corresponding virtual-bond valence angles THETA and the spherical angles
5328 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5329 C added by Urszula Kozlowska. 07/11/2007
5331 implicit real*8 (a-h,o-z)
5332 include 'DIMENSIONS'
5333 include 'COMMON.GEO'
5334 include 'COMMON.LOCAL'
5335 include 'COMMON.VAR'
5336 include 'COMMON.SCROT'
5337 include 'COMMON.INTERACT'
5338 include 'COMMON.DERIV'
5339 include 'COMMON.CHAIN'
5340 include 'COMMON.IOUNITS'
5341 include 'COMMON.NAMES'
5342 include 'COMMON.FFIELD'
5343 include 'COMMON.CONTROL'
5344 include 'COMMON.VECTORS'
5345 double precision x_prime(3),y_prime(3),z_prime(3)
5346 & , sumene,dsc_i,dp2_i,x(65),
5347 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5348 & de_dxx,de_dyy,de_dzz,de_dt
5349 double precision s1_t,s1_6_t,s2_t,s2_6_t
5351 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5352 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5353 & dt_dCi(3),dt_dCi1(3)
5354 common /sccalc/ time11,time12,time112,theti,it,nlobit
5357 c write(iout,*) "ESC: loc_start",loc_start," loc_end",loc_end
5358 do i=loc_start,loc_end
5359 costtab(i+1) =dcos(theta(i+1))
5360 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5361 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5362 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5363 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5364 cosfac=dsqrt(cosfac2)
5365 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5366 sinfac=dsqrt(sinfac2)
5368 if (it.eq.10) goto 1
5370 C Compute the axes of tghe local cartesian coordinates system; store in
5371 c x_prime, y_prime and z_prime
5378 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5379 C & dc_norm(3,i+nres)
5381 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5382 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5385 z_prime(j) = -uz(j,i-1)
5388 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5389 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5390 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5391 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5392 c & " xy",scalar(x_prime(1),y_prime(1)),
5393 c & " xz",scalar(x_prime(1),z_prime(1)),
5394 c & " yy",scalar(y_prime(1),y_prime(1)),
5395 c & " yz",scalar(y_prime(1),z_prime(1)),
5396 c & " zz",scalar(z_prime(1),z_prime(1))
5398 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5399 C to local coordinate system. Store in xx, yy, zz.
5405 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5406 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5407 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5414 C Compute the energy of the ith side cbain
5416 c write (2,*) "xx",xx," yy",yy," zz",zz
5419 x(j) = sc_parmin(j,it)
5422 Cc diagnostics - remove later
5424 yy1 = dsin(alph(2))*dcos(omeg(2))
5425 zz1 = -dsin(alph(2))*dsin(omeg(2))
5426 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5427 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5429 C," --- ", xx_w,yy_w,zz_w
5432 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5433 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5435 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5436 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5438 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5439 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5440 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5441 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5442 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5444 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5445 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5446 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5447 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5448 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5450 dsc_i = 0.743d0+x(61)
5452 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5453 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5454 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5455 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5456 s1=(1+x(63))/(0.1d0 + dscp1)
5457 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5458 s2=(1+x(65))/(0.1d0 + dscp2)
5459 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5460 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5461 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5462 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5464 c & dscp1,dscp2,sumene
5465 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5466 escloc = escloc + sumene
5467 c write (2,*) "i",i," escloc",sumene,escloc
5470 C This section to check the numerical derivatives of the energy of ith side
5471 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5472 C #define DEBUG in the code to turn it on.
5474 write (2,*) "sumene =",sumene
5478 write (2,*) xx,yy,zz
5479 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5480 de_dxx_num=(sumenep-sumene)/aincr
5482 write (2,*) "xx+ sumene from enesc=",sumenep
5485 write (2,*) xx,yy,zz
5486 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5487 de_dyy_num=(sumenep-sumene)/aincr
5489 write (2,*) "yy+ sumene from enesc=",sumenep
5492 write (2,*) xx,yy,zz
5493 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5494 de_dzz_num=(sumenep-sumene)/aincr
5496 write (2,*) "zz+ sumene from enesc=",sumenep
5497 costsave=cost2tab(i+1)
5498 sintsave=sint2tab(i+1)
5499 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5500 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5501 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5502 de_dt_num=(sumenep-sumene)/aincr
5503 write (2,*) " t+ sumene from enesc=",sumenep
5504 cost2tab(i+1)=costsave
5505 sint2tab(i+1)=sintsave
5506 C End of diagnostics section.
5509 C Compute the gradient of esc
5511 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5512 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5513 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5514 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5515 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5516 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5517 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5518 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5519 pom1=(sumene3*sint2tab(i+1)+sumene1)
5520 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5521 pom2=(sumene4*cost2tab(i+1)+sumene2)
5522 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5523 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5524 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5525 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5527 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5528 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5529 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5531 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5532 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5533 & +(pom1+pom2)*pom_dx
5535 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5538 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5539 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5540 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5542 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5543 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5544 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5545 & +x(59)*zz**2 +x(60)*xx*zz
5546 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5547 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5548 & +(pom1-pom2)*pom_dy
5550 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5553 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5554 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5555 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5556 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5557 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5558 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5559 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5560 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5562 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5565 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5566 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5567 & +pom1*pom_dt1+pom2*pom_dt2
5569 write(2,*), "de_dt = ", de_dt,de_dt_num
5573 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5574 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5575 cosfac2xx=cosfac2*xx
5576 sinfac2yy=sinfac2*yy
5578 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5580 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5582 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5583 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5584 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5585 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5586 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5587 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5588 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5589 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5590 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5591 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5595 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5596 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5599 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5600 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5601 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5603 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5604 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5608 dXX_Ctab(k,i)=dXX_Ci(k)
5609 dXX_C1tab(k,i)=dXX_Ci1(k)
5610 dYY_Ctab(k,i)=dYY_Ci(k)
5611 dYY_C1tab(k,i)=dYY_Ci1(k)
5612 dZZ_Ctab(k,i)=dZZ_Ci(k)
5613 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5614 dXX_XYZtab(k,i)=dXX_XYZ(k)
5615 dYY_XYZtab(k,i)=dYY_XYZ(k)
5616 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5620 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5621 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5622 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5623 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5624 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5626 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5627 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5628 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5629 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5630 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5631 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5632 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5633 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5635 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5636 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5638 C to check gradient call subroutine check_grad
5644 c------------------------------------------------------------------------------
5645 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5647 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5648 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5649 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5650 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5652 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5653 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5655 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5656 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5657 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5658 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5659 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5661 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5662 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5663 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5664 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5665 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5667 dsc_i = 0.743d0+x(61)
5669 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5670 & *(xx*cost2+yy*sint2))
5671 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5672 & *(xx*cost2-yy*sint2))
5673 s1=(1+x(63))/(0.1d0 + dscp1)
5674 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5675 s2=(1+x(65))/(0.1d0 + dscp2)
5676 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5677 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5678 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5683 c------------------------------------------------------------------------------
5684 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5686 C This procedure calculates two-body contact function g(rij) and its derivative:
5689 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5692 C where x=(rij-r0ij)/delta
5694 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5697 double precision rij,r0ij,eps0ij,fcont,fprimcont
5698 double precision x,x2,x4,delta
5702 if (x.lt.-1.0D0) then
5705 else if (x.le.1.0D0) then
5708 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5709 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5716 c------------------------------------------------------------------------------
5717 subroutine splinthet(theti,delta,ss,ssder)
5718 implicit real*8 (a-h,o-z)
5719 include 'DIMENSIONS'
5720 include 'COMMON.VAR'
5721 include 'COMMON.GEO'
5724 if (theti.gt.pipol) then
5725 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5727 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5732 c------------------------------------------------------------------------------
5733 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5735 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5736 double precision ksi,ksi2,ksi3,a1,a2,a3
5737 a1=fprim0*delta/(f1-f0)
5743 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5744 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5747 c------------------------------------------------------------------------------
5748 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5750 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5751 double precision ksi,ksi2,ksi3,a1,a2,a3
5756 a2=3*(f1x-f0x)-2*fprim0x*delta
5757 a3=fprim0x*delta-2*(f1x-f0x)
5758 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5761 C-----------------------------------------------------------------------------
5763 C-----------------------------------------------------------------------------
5764 subroutine etor(etors,edihcnstr)
5765 implicit real*8 (a-h,o-z)
5766 include 'DIMENSIONS'
5767 include 'COMMON.VAR'
5768 include 'COMMON.GEO'
5769 include 'COMMON.LOCAL'
5770 include 'COMMON.TORSION'
5771 include 'COMMON.INTERACT'
5772 include 'COMMON.DERIV'
5773 include 'COMMON.CHAIN'
5774 include 'COMMON.NAMES'
5775 include 'COMMON.IOUNITS'
5776 include 'COMMON.FFIELD'
5777 include 'COMMON.TORCNSTR'
5778 include 'COMMON.CONTROL'
5780 C Set lprn=.true. for debugging
5784 do i=iphi_start,iphi_end
5786 itori=itortyp(itype(i-2))
5787 itori1=itortyp(itype(i-1))
5790 C Proline-Proline pair is a special case...
5791 if (itori.eq.3 .and. itori1.eq.3) then
5792 if (phii.gt.-dwapi3) then
5794 fac=1.0D0/(1.0D0-cosphi)
5795 etorsi=v1(1,3,3)*fac
5796 etorsi=etorsi+etorsi
5797 etors=etors+etorsi-v1(1,3,3)
5798 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5799 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5802 v1ij=v1(j+1,itori,itori1)
5803 v2ij=v2(j+1,itori,itori1)
5806 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5807 if (energy_dec) etors_ii=etors_ii+
5808 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5809 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5813 v1ij=v1(j,itori,itori1)
5814 v2ij=v2(j,itori,itori1)
5817 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5818 if (energy_dec) etors_ii=etors_ii+
5819 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5820 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5823 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5826 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5827 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5828 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5829 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5830 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5832 ! 6/20/98 - dihedral angle constraints
5835 itori=idih_constr(i)
5838 if (difi.gt.drange(i)) then
5840 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5841 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5842 else if (difi.lt.-drange(i)) then
5844 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5845 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5847 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5848 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5850 ! write (iout,*) 'edihcnstr',edihcnstr
5853 c------------------------------------------------------------------------------
5854 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
5855 subroutine e_modeller(ehomology_constr)
5856 ehomology_constr=0.0d0
5857 write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
5860 C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
5862 c------------------------------------------------------------------------------
5863 subroutine etor_d(etors_d)
5867 c----------------------------------------------------------------------------
5869 subroutine etor(etors,edihcnstr)
5870 implicit real*8 (a-h,o-z)
5871 include 'DIMENSIONS'
5872 include 'COMMON.VAR'
5873 include 'COMMON.GEO'
5874 include 'COMMON.LOCAL'
5875 include 'COMMON.TORSION'
5876 include 'COMMON.INTERACT'
5877 include 'COMMON.DERIV'
5878 include 'COMMON.CHAIN'
5879 include 'COMMON.NAMES'
5880 include 'COMMON.IOUNITS'
5881 include 'COMMON.FFIELD'
5882 include 'COMMON.TORCNSTR'
5883 include 'COMMON.CONTROL'
5885 C Set lprn=.true. for debugging
5889 do i=iphi_start,iphi_end
5891 itori=itortyp(itype(i-2))
5892 itori1=itortyp(itype(i-1))
5895 C Regular cosine and sine terms
5896 do j=1,nterm(itori,itori1)
5897 v1ij=v1(j,itori,itori1)
5898 v2ij=v2(j,itori,itori1)
5901 etors=etors+v1ij*cosphi+v2ij*sinphi
5902 if (energy_dec) etors_ii=etors_ii+
5903 & v1ij*cosphi+v2ij*sinphi
5904 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5908 C E = SUM ----------------------------------- - v1
5909 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5911 cosphi=dcos(0.5d0*phii)
5912 sinphi=dsin(0.5d0*phii)
5913 do j=1,nlor(itori,itori1)
5914 vl1ij=vlor1(j,itori,itori1)
5915 vl2ij=vlor2(j,itori,itori1)
5916 vl3ij=vlor3(j,itori,itori1)
5917 pom=vl2ij*cosphi+vl3ij*sinphi
5918 pom1=1.0d0/(pom*pom+1.0d0)
5919 etors=etors+vl1ij*pom1
5920 if (energy_dec) etors_ii=etors_ii+
5923 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5925 C Subtract the constant term
5926 etors=etors-v0(itori,itori1)
5927 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5928 & 'etor',i,etors_ii-v0(itori,itori1)
5930 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5931 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5932 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5933 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5934 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5936 ! 6/20/98 - dihedral angle constraints
5938 c do i=1,ndih_constr
5939 do i=idihconstr_start,idihconstr_end
5940 itori=idih_constr(i)
5942 difi=pinorm(phii-phi0(i))
5943 if (difi.gt.drange(i)) then
5945 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5946 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5947 else if (difi.lt.-drange(i)) then
5949 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5950 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5954 c write (iout,*) "gloci", gloc(i-3,icg)
5955 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5956 cd & rad2deg*phi0(i), rad2deg*drange(i),
5957 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5959 cd write (iout,*) 'edihcnstr',edihcnstr
5962 c----------------------------------------------------------------------------
5963 c MODELLER restraint function
5964 subroutine e_modeller(ehomology_constr)
5965 implicit real*8 (a-h,o-z)
5966 include 'DIMENSIONS'
5968 integer nnn, i, j, k, ki, irec, l
5969 integer katy, odleglosci, test7
5970 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
5972 real*8 distance(max_template),distancek(max_template),
5973 & min_odl,godl(max_template),dih_diff(max_template)
5976 c FP - 30/10/2014 Temporary specifications for homology restraints
5978 double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,
5980 double precision, dimension (maxres) :: guscdiff,usc_diff
5981 double precision, dimension (max_template) ::
5982 & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3,
5986 include 'COMMON.SBRIDGE'
5987 include 'COMMON.CHAIN'
5988 include 'COMMON.GEO'
5989 include 'COMMON.DERIV'
5990 include 'COMMON.LOCAL'
5991 include 'COMMON.INTERACT'
5992 include 'COMMON.VAR'
5993 include 'COMMON.IOUNITS'
5995 include 'COMMON.CONTROL'
5997 c From subroutine Econstr_back
5999 include 'COMMON.NAMES'
6000 include 'COMMON.TIME1'
6005 distancek(i)=9999999.9
6011 c Pseudo-energy and gradient from homology restraints (MODELLER-like
6013 C AL 5/2/14 - Introduce list of restraints
6014 c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
6016 write(iout,*) "------- dist restrs start -------"
6018 do ii = link_start_homo,link_end_homo
6022 c write (iout,*) "dij(",i,j,") =",dij
6023 do k=1,constr_homology
6024 distance(k)=odl(k,ii)-dij
6025 c write (iout,*) "distance(",k,") =",distance(k)
6027 c For Gaussian-type Urestr
6029 distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument
6030 c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii)
6031 c write (iout,*) "distancek(",k,") =",distancek(k)
6032 c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
6034 c For Lorentzian-type Urestr
6036 if (waga_dist.lt.0.0d0) then
6037 sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii))
6038 distancek(k)=distance(k)**2/(sigma_odlir(k,ii)*
6039 & (distance(k)**2+sigma_odlir(k,ii)**2))
6043 min_odl=minval(distancek)
6044 c write (iout,* )"min_odl",min_odl
6046 write (iout,*) "ij dij",i,j,dij
6047 write (iout,*) "distance",(distance(k),k=1,constr_homology)
6048 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
6049 write (iout,* )"min_odl",min_odl
6052 do k=1,constr_homology
6053 c Nie wiem po co to liczycie jeszcze raz!
6054 c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
6055 c & (2*(sigma_odl(i,j,k))**2))
6056 if (waga_dist.ge.0.0d0) then
6058 c For Gaussian-type Urestr
6060 godl(k)=dexp(-distancek(k)+min_odl)
6061 odleg2=odleg2+godl(k)
6063 c For Lorentzian-type Urestr
6066 odleg2=odleg2+distancek(k)
6069 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
6070 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
6071 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
6072 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
6075 c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6076 c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6078 write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents
6079 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps
6081 if (waga_dist.ge.0.0d0) then
6083 c For Gaussian-type Urestr
6085 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
6087 c For Lorentzian-type Urestr
6090 odleg=odleg+odleg2/constr_homology
6093 c write (iout,*) "odleg",odleg ! sum of -ln-s
6096 c For Gaussian-type Urestr
6098 if (waga_dist.ge.0.0d0) sum_godl=odleg2
6100 do k=1,constr_homology
6101 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6102 c & *waga_dist)+min_odl
6103 c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
6105 if (waga_dist.ge.0.0d0) then
6106 c For Gaussian-type Urestr
6108 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd
6110 c For Lorentzian-type Urestr
6113 sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+
6114 & sigma_odlir(k,ii)**2)**2)
6116 sum_sgodl=sum_sgodl+sgodl
6118 c sgodl2=sgodl2+sgodl
6119 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
6120 c write(iout,*) "constr_homology=",constr_homology
6121 c write(iout,*) i, j, k, "TEST K"
6123 if (waga_dist.ge.0.0d0) then
6125 c For Gaussian-type Urestr
6127 grad_odl3=waga_homology(iset)*waga_dist
6128 & *sum_sgodl/(sum_godl*dij)
6130 c For Lorentzian-type Urestr
6133 c Original grad expr modified by analogy w Gaussian-type Urestr grad
6134 c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl
6135 grad_odl3=-waga_homology(iset)*waga_dist*
6136 & sum_sgodl/(constr_homology*dij)
6139 c grad_odl3=sum_sgodl/(sum_godl*dij)
6142 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
6143 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
6144 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
6146 ccc write(iout,*) godl, sgodl, grad_odl3
6148 c grad_odl=grad_odl+grad_odl3
6151 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
6152 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
6153 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
6154 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6155 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
6156 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
6157 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
6158 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
6159 c if (i.eq.25.and.j.eq.27) then
6160 c write(iout,*) "jik",jik,"i",i,"j",j
6161 c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl
6162 c write(iout,*) "grad_odl3",grad_odl3
6163 c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j)
6164 c write(iout,*) "ggodl",ggodl
6165 c write(iout,*) "ghpbc(",jik,i,")",
6166 c & ghpbc(jik,i),"ghpbc(",jik,j,")",
6170 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
6171 ccc & dLOG(odleg2),"-odleg=", -odleg
6173 enddo ! ii-loop for dist
6175 write(iout,*) "------- dist restrs end -------"
6176 c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or.
6177 c & waga_d.eq.1.0d0) call sum_gradient
6179 c Pseudo-energy and gradient from dihedral-angle restraints from
6180 c homology templates
6181 c write (iout,*) "End of distance loop"
6184 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
6186 write(iout,*) "------- dih restrs start -------"
6187 do i=idihconstr_start_homo,idihconstr_end_homo
6188 write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg)
6191 do i=idihconstr_start_homo,idihconstr_end_homo
6193 c betai=beta(i,i+1,i+2,i+3)
6195 c write (iout,*) "betai =",betai
6196 do k=1,constr_homology
6197 dih_diff(k)=pinorm(dih(k,i)-betai)
6198 c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
6199 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
6200 c & -(6.28318-dih_diff(i,k))
6201 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
6202 c & 6.28318+dih_diff(i,k)
6204 kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
6205 c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
6208 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
6211 c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
6212 c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
6214 write (iout,*) "i",i," betai",betai," kat2",kat2
6215 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
6217 if (kat2.le.1.0d-14) cycle
6218 kat=kat-dLOG(kat2/constr_homology)
6219 c write (iout,*) "kat",kat ! sum of -ln-s
6221 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
6222 ccc & dLOG(kat2), "-kat=", -kat
6224 c ----------------------------------------------------------------------
6226 c ----------------------------------------------------------------------
6230 do k=1,constr_homology
6231 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
6232 c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
6233 sum_sgdih=sum_sgdih+sgdih
6235 c grad_dih3=sum_sgdih/sum_gdih
6236 grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
6238 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
6239 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
6240 ccc & gloc(nphi+i-3,icg)
6241 gloc(i,icg)=gloc(i,icg)+grad_dih3
6243 c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
6245 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
6246 ccc & gloc(nphi+i-3,icg)
6248 enddo ! i-loop for dih
6250 write(iout,*) "------- dih restrs end -------"
6253 c Pseudo-energy and gradient for theta angle restraints from
6254 c homology templates
6255 c FP 01/15 - inserted from econstr_local_test.F, loop structure
6259 c For constr_homology reference structures (FP)
6261 c Uconst_back_tot=0.0d0
6264 c Econstr_back legacy
6266 c do i=ithet_start,ithet_end
6269 c do i=loc_start,loc_end
6272 duscdiffx(j,i)=0.0d0
6277 c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end
6278 c write (iout,*) "waga_theta",waga_theta
6279 if (waga_theta.gt.0.0d0) then
6281 write (iout,*) "usampl",usampl
6282 write(iout,*) "------- theta restrs start -------"
6283 c do i=ithet_start,ithet_end
6284 c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg)
6287 c write (iout,*) "maxres",maxres,"nres",nres
6289 do i=ithet_start,ithet_end
6292 c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
6294 c Deviation of theta angles wrt constr_homology ref structures
6296 utheta_i=0.0d0 ! argument of Gaussian for single k
6297 gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6298 c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
6299 c over residues in a fragment
6300 c write (iout,*) "theta(",i,")=",theta(i)
6301 do k=1,constr_homology
6303 c dtheta_i=theta(j)-thetaref(j,iref)
6304 c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
6305 theta_diff(k)=thetatpl(k,i)-theta(i)
6307 utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
6308 c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
6309 gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
6310 gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
6311 c Gradient for single Gaussian restraint in subr Econstr_back
6312 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
6315 c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
6316 c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
6319 c Gradient for multiple Gaussian restraint
6320 sum_gtheta=gutheta_i
6322 do k=1,constr_homology
6323 c New generalized expr for multiple Gaussian from Econstr_back
6324 sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
6326 c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
6327 sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
6329 c grad_theta3=sum_sgtheta/sum_gtheta 1/*theta(i)? s. line below
6330 c grad_theta3=sum_sgtheta/sum_gtheta
6332 c Final value of gradient using same var as in Econstr_back
6333 dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
6334 & *waga_homology(iset)
6335 c dutheta(i)=sum_sgtheta/sum_gtheta
6337 c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
6338 Eval=Eval-dLOG(gutheta_i/constr_homology)
6339 c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
6340 c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
6341 c Uconst_back=Uconst_back+utheta(i)
6342 enddo ! (i-loop for theta)
6344 write(iout,*) "------- theta restrs end -------"
6348 c Deviation of local SC geometry
6350 c Separation of two i-loops (instructed by AL - 11/3/2014)
6352 c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end
6353 c write (iout,*) "waga_d",waga_d
6356 write(iout,*) "------- SC restrs start -------"
6357 write (iout,*) "Initial duscdiff,duscdiffx"
6358 do i=loc_start,loc_end
6359 write (iout,*) i,(duscdiff(jik,i),jik=1,3),
6360 & (duscdiffx(jik,i),jik=1,3)
6363 do i=loc_start,loc_end
6364 usc_diff_i=0.0d0 ! argument of Gaussian for single k
6365 guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
6366 c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
6367 c write(iout,*) "xxtab, yytab, zztab"
6368 c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
6369 do k=1,constr_homology
6371 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6372 c Original sign inverted for calc of gradients (s. Econstr_back)
6373 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6374 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6375 c write(iout,*) "dxx, dyy, dzz"
6376 c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6378 usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
6379 c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
6380 c uscdiffk(k)=usc_diff(i)
6381 guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
6382 guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
6383 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
6384 c & xxref(j),yyref(j),zzref(j)
6389 c Generalized expression for multiple Gaussian acc to that for a single
6390 c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
6392 c Original implementation
6393 c sum_guscdiff=guscdiff(i)
6395 c sum_sguscdiff=0.0d0
6396 c do k=1,constr_homology
6397 c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
6398 c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
6399 c sum_sguscdiff=sum_sguscdiff+sguscdiff
6402 c Implementation of new expressions for gradient (Jan. 2015)
6404 c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
6405 do k=1,constr_homology
6407 c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
6408 c before. Now the drivatives should be correct
6410 dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
6411 c Original sign inverted for calc of gradients (s. Econstr_back)
6412 dyy=-yytpl(k,i)+yytab(i) ! ibid y
6413 dzz=-zztpl(k,i)+zztab(i) ! ibid z
6415 c New implementation
6417 sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
6418 & sigma_d(k,i) ! for the grad wrt r'
6419 c sum_sguscdiff=sum_sguscdiff+sum_guscdiff
6422 c New implementation
6423 sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
6425 duscdiff(jik,i-1)=duscdiff(jik,i-1)+
6426 & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+
6427 & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
6428 duscdiff(jik,i)=duscdiff(jik,i)+
6429 & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+
6430 & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
6431 duscdiffx(jik,i)=duscdiffx(jik,i)+
6432 & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+
6433 & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
6436 write(iout,*) "jik",jik,"i",i
6437 write(iout,*) "dxx, dyy, dzz"
6438 write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
6439 write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
6440 c write(iout,*) "sum_sguscdiff",sum_sguscdiff
6441 cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
6442 c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
6443 c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
6444 c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
6445 c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
6446 c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
6447 c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
6448 c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
6449 c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
6450 c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
6451 c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
6452 c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
6458 c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
6459 c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
6461 c write (iout,*) i," uscdiff",uscdiff(i)
6463 c Put together deviations from local geometry
6465 c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
6466 c & wfrag_back(3,i,iset)*uscdiff(i)
6467 Erot=Erot-dLOG(guscdiff(i)/constr_homology)
6468 c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
6469 c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
6470 c Uconst_back=Uconst_back+usc_diff(i)
6472 c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
6474 c New implment: multiplied by sum_sguscdiff
6477 enddo ! (i-loop for dscdiff)
6482 write(iout,*) "------- SC restrs end -------"
6483 write (iout,*) "------ After SC loop in e_modeller ------"
6484 do i=loc_start,loc_end
6485 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
6486 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
6488 if (waga_theta.eq.1.0d0) then
6489 write (iout,*) "in e_modeller after SC restr end: dutheta"
6490 do i=ithet_start,ithet_end
6491 write (iout,*) i,dutheta(i)
6494 if (waga_d.eq.1.0d0) then
6495 write (iout,*) "e_modeller after SC loop: duscdiff/x"
6497 write (iout,*) i,(duscdiff(j,i),j=1,3)
6498 write (iout,*) i,(duscdiffx(j,i),j=1,3)
6503 c Total energy from homology restraints
6505 write (iout,*) "odleg",odleg," kat",kat
6508 c Addition of energy of theta angle and SC local geom over constr_homologs ref strs
6510 c ehomology_constr=odleg+kat
6512 c For Lorentzian-type Urestr
6515 if (waga_dist.ge.0.0d0) then
6517 c For Gaussian-type Urestr
6519 ehomology_constr=(waga_dist*odleg+waga_angle*kat+
6520 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6521 c write (iout,*) "ehomology_constr=",ehomology_constr
6524 c For Lorentzian-type Urestr
6526 ehomology_constr=(-waga_dist*odleg+waga_angle*kat+
6527 & waga_theta*Eval+waga_d*Erot)*waga_homology(iset)
6528 c write (iout,*) "ehomology_constr=",ehomology_constr
6531 write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat,
6532 & "Eval",waga_theta,eval,
6533 & "Erot",waga_d,Erot
6534 write (iout,*) "ehomology_constr",ehomology_constr
6540 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
6541 747 format(a12,i4,i4,i4,f8.3,f8.3)
6542 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
6543 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
6544 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
6545 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
6548 c------------------------------------------------------------------------------
6549 subroutine etor_d(etors_d)
6550 C 6/23/01 Compute double torsional energy
6551 implicit real*8 (a-h,o-z)
6552 include 'DIMENSIONS'
6553 include 'COMMON.VAR'
6554 include 'COMMON.GEO'
6555 include 'COMMON.LOCAL'
6556 include 'COMMON.TORSION'
6557 include 'COMMON.INTERACT'
6558 include 'COMMON.DERIV'
6559 include 'COMMON.CHAIN'
6560 include 'COMMON.NAMES'
6561 include 'COMMON.IOUNITS'
6562 include 'COMMON.FFIELD'
6563 include 'COMMON.TORCNSTR'
6565 C Set lprn=.true. for debugging
6569 do i=iphid_start,iphid_end
6570 itori=itortyp(itype(i-2))
6571 itori1=itortyp(itype(i-1))
6572 itori2=itortyp(itype(i))
6577 do j=1,ntermd_1(itori,itori1,itori2)
6578 v1cij=v1c(1,j,itori,itori1,itori2)
6579 v1sij=v1s(1,j,itori,itori1,itori2)
6580 v2cij=v1c(2,j,itori,itori1,itori2)
6581 v2sij=v1s(2,j,itori,itori1,itori2)
6582 cosphi1=dcos(j*phii)
6583 sinphi1=dsin(j*phii)
6584 cosphi2=dcos(j*phii1)
6585 sinphi2=dsin(j*phii1)
6586 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6587 & v2cij*cosphi2+v2sij*sinphi2
6588 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6589 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6591 do k=2,ntermd_2(itori,itori1,itori2)
6593 v1cdij = v2c(k,l,itori,itori1,itori2)
6594 v2cdij = v2c(l,k,itori,itori1,itori2)
6595 v1sdij = v2s(k,l,itori,itori1,itori2)
6596 v2sdij = v2s(l,k,itori,itori1,itori2)
6597 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6598 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6599 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6600 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6601 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6602 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6603 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6604 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6605 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6606 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6609 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6610 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6611 c write (iout,*) "gloci", gloc(i-3,icg)
6616 c------------------------------------------------------------------------------
6617 subroutine eback_sc_corr(esccor)
6618 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6619 c conformational states; temporarily implemented as differences
6620 c between UNRES torsional potentials (dependent on three types of
6621 c residues) and the torsional potentials dependent on all 20 types
6622 c of residues computed from AM1 energy surfaces of terminally-blocked
6623 c amino-acid residues.
6624 implicit real*8 (a-h,o-z)
6625 include 'DIMENSIONS'
6626 include 'COMMON.VAR'
6627 include 'COMMON.GEO'
6628 include 'COMMON.LOCAL'
6629 include 'COMMON.TORSION'
6630 include 'COMMON.SCCOR'
6631 include 'COMMON.INTERACT'
6632 include 'COMMON.DERIV'
6633 include 'COMMON.CHAIN'
6634 include 'COMMON.NAMES'
6635 include 'COMMON.IOUNITS'
6636 include 'COMMON.FFIELD'
6637 include 'COMMON.CONTROL'
6639 C Set lprn=.true. for debugging
6642 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6644 do i=itau_start,itau_end
6646 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6647 isccori=isccortyp(itype(i-2))
6648 isccori1=isccortyp(itype(i-1))
6650 cccc Added 9 May 2012
6651 cc Tauangle is torsional engle depending on the value of first digit
6652 c(see comment below)
6653 cc Omicron is flat angle depending on the value of first digit
6654 c(see comment below)
6657 do intertyp=1,3 !intertyp
6658 cc Added 09 May 2012 (Adasko)
6659 cc Intertyp means interaction type of backbone mainchain correlation:
6660 c 1 = SC...Ca...Ca...Ca
6661 c 2 = Ca...Ca...Ca...SC
6662 c 3 = SC...Ca...Ca...SCi
6664 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6665 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6666 & (itype(i-1).eq.21)))
6667 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6668 & .or.(itype(i-2).eq.21)))
6669 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6670 & (itype(i-1).eq.21)))) cycle
6671 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6672 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6674 do j=1,nterm_sccor(isccori,isccori1)
6675 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6676 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6677 cosphi=dcos(j*tauangle(intertyp,i))
6678 sinphi=dsin(j*tauangle(intertyp,i))
6679 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6680 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6682 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6683 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6684 c &gloc_sc(intertyp,i-3,icg)
6686 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6687 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6688 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6689 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6690 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6694 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6698 c----------------------------------------------------------------------------
6699 subroutine multibody(ecorr)
6700 C This subroutine calculates multi-body contributions to energy following
6701 C the idea of Skolnick et al. If side chains I and J make a contact and
6702 C at the same time side chains I+1 and J+1 make a contact, an extra
6703 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6704 implicit real*8 (a-h,o-z)
6705 include 'DIMENSIONS'
6706 include 'COMMON.IOUNITS'
6707 include 'COMMON.DERIV'
6708 include 'COMMON.INTERACT'
6709 include 'COMMON.CONTACTS'
6710 double precision gx(3),gx1(3)
6713 C Set lprn=.true. for debugging
6717 write (iout,'(a)') 'Contact function values:'
6719 write (iout,'(i2,20(1x,i2,f10.5))')
6720 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6735 num_conti=num_cont(i)
6736 num_conti1=num_cont(i1)
6741 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6742 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6743 cd & ' ishift=',ishift
6744 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6745 C The system gains extra energy.
6746 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6747 endif ! j1==j+-ishift
6756 c------------------------------------------------------------------------------
6757 double precision function esccorr(i,j,k,l,jj,kk)
6758 implicit real*8 (a-h,o-z)
6759 include 'DIMENSIONS'
6760 include 'COMMON.IOUNITS'
6761 include 'COMMON.DERIV'
6762 include 'COMMON.INTERACT'
6763 include 'COMMON.CONTACTS'
6764 double precision gx(3),gx1(3)
6769 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6770 C Calculate the multi-body contribution to energy.
6771 C Calculate multi-body contributions to the gradient.
6772 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6773 cd & k,l,(gacont(m,kk,k),m=1,3)
6775 gx(m) =ekl*gacont(m,jj,i)
6776 gx1(m)=eij*gacont(m,kk,k)
6777 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6778 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6779 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6780 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6784 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6789 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6795 c------------------------------------------------------------------------------
6796 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6797 C This subroutine calculates multi-body contributions to hydrogen-bonding
6798 implicit real*8 (a-h,o-z)
6799 include 'DIMENSIONS'
6800 include 'COMMON.IOUNITS'
6803 parameter (max_cont=maxconts)
6804 parameter (max_dim=26)
6805 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6806 double precision zapas(max_dim,maxconts,max_fg_procs),
6807 & zapas_recv(max_dim,maxconts,max_fg_procs)
6808 common /przechowalnia/ zapas
6809 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6810 & status_array(MPI_STATUS_SIZE,maxconts*2)
6812 include 'COMMON.SETUP'
6813 include 'COMMON.FFIELD'
6814 include 'COMMON.DERIV'
6815 include 'COMMON.INTERACT'
6816 include 'COMMON.CONTACTS'
6817 include 'COMMON.CONTROL'
6818 include 'COMMON.LOCAL'
6819 double precision gx(3),gx1(3),time00
6822 C Set lprn=.true. for debugging
6827 if (nfgtasks.le.1) goto 30
6829 write (iout,'(a)') 'Contact function values before RECEIVE:'
6831 write (iout,'(2i3,50(1x,i2,f5.2))')
6832 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6833 & j=1,num_cont_hb(i))
6837 do i=1,ntask_cont_from
6840 do i=1,ntask_cont_to
6843 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6845 C Make the list of contacts to send to send to other procesors
6846 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6848 do i=iturn3_start,iturn3_end
6849 c write (iout,*) "make contact list turn3",i," num_cont",
6851 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6853 do i=iturn4_start,iturn4_end
6854 c write (iout,*) "make contact list turn4",i," num_cont",
6856 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6860 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6862 do j=1,num_cont_hb(i)
6865 iproc=iint_sent_local(k,jjc,ii)
6866 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6867 if (iproc.gt.0) then
6868 ncont_sent(iproc)=ncont_sent(iproc)+1
6869 nn=ncont_sent(iproc)
6871 zapas(2,nn,iproc)=jjc
6872 zapas(3,nn,iproc)=facont_hb(j,i)
6873 zapas(4,nn,iproc)=ees0p(j,i)
6874 zapas(5,nn,iproc)=ees0m(j,i)
6875 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6876 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6877 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6878 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6879 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6880 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6881 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6882 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6883 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6884 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6885 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6886 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6887 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6888 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6889 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6890 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6891 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6892 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6893 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6894 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6895 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6902 & "Numbers of contacts to be sent to other processors",
6903 & (ncont_sent(i),i=1,ntask_cont_to)
6904 write (iout,*) "Contacts sent"
6905 do ii=1,ntask_cont_to
6907 iproc=itask_cont_to(ii)
6908 write (iout,*) nn," contacts to processor",iproc,
6909 & " of CONT_TO_COMM group"
6911 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6919 CorrelID1=nfgtasks+fg_rank+1
6921 C Receive the numbers of needed contacts from other processors
6922 do ii=1,ntask_cont_from
6923 iproc=itask_cont_from(ii)
6925 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6926 & FG_COMM,req(ireq),IERR)
6928 c write (iout,*) "IRECV ended"
6930 C Send the number of contacts needed by other processors
6931 do ii=1,ntask_cont_to
6932 iproc=itask_cont_to(ii)
6934 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6935 & FG_COMM,req(ireq),IERR)
6937 c write (iout,*) "ISEND ended"
6938 c write (iout,*) "number of requests (nn)",ireq
6941 & call MPI_Waitall(ireq,req,status_array,ierr)
6943 c & "Numbers of contacts to be received from other processors",
6944 c & (ncont_recv(i),i=1,ntask_cont_from)
6948 do ii=1,ntask_cont_from
6949 iproc=itask_cont_from(ii)
6951 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6952 c & " of CONT_TO_COMM group"
6956 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6957 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6958 c write (iout,*) "ireq,req",ireq,req(ireq)
6961 C Send the contacts to processors that need them
6962 do ii=1,ntask_cont_to
6963 iproc=itask_cont_to(ii)
6965 c write (iout,*) nn," contacts to processor",iproc,
6966 c & " of CONT_TO_COMM group"
6969 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6970 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6971 c write (iout,*) "ireq,req",ireq,req(ireq)
6973 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6977 c write (iout,*) "number of requests (contacts)",ireq
6978 c write (iout,*) "req",(req(i),i=1,4)
6981 & call MPI_Waitall(ireq,req,status_array,ierr)
6982 do iii=1,ntask_cont_from
6983 iproc=itask_cont_from(iii)
6986 write (iout,*) "Received",nn," contacts from processor",iproc,
6987 & " of CONT_FROM_COMM group"
6990 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6995 ii=zapas_recv(1,i,iii)
6996 c Flag the received contacts to prevent double-counting
6997 jj=-zapas_recv(2,i,iii)
6998 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7000 nnn=num_cont_hb(ii)+1
7003 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7004 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7005 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7006 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7007 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7008 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7009 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7010 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7011 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7012 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7013 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7014 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7015 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7016 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7017 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7018 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7019 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7020 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7021 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7022 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7023 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7024 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7025 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7026 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7031 write (iout,'(a)') 'Contact function values after receive:'
7033 write (iout,'(2i3,50(1x,i3,f5.2))')
7034 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7035 & j=1,num_cont_hb(i))
7042 write (iout,'(a)') 'Contact function values:'
7044 write (iout,'(2i3,50(1x,i3,f5.2))')
7045 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7046 & j=1,num_cont_hb(i))
7050 C Remove the loop below after debugging !!!
7057 C Calculate the local-electrostatic correlation terms
7058 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7060 num_conti=num_cont_hb(i)
7061 num_conti1=num_cont_hb(i+1)
7068 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7069 c & ' jj=',jj,' kk=',kk
7070 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7071 & .or. j.lt.0 .and. j1.gt.0) .and.
7072 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7073 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7074 C The system gains extra energy.
7075 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7076 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7077 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7079 else if (j1.eq.j) then
7080 C Contacts I-J and I-(J+1) occur simultaneously.
7081 C The system loses extra energy.
7082 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7087 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7088 c & ' jj=',jj,' kk=',kk
7090 C Contacts I-J and (I+1)-J occur simultaneously.
7091 C The system loses extra energy.
7092 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7099 c------------------------------------------------------------------------------
7100 subroutine add_hb_contact(ii,jj,itask)
7101 implicit real*8 (a-h,o-z)
7102 include "DIMENSIONS"
7103 include "COMMON.IOUNITS"
7106 parameter (max_cont=maxconts)
7107 parameter (max_dim=26)
7108 include "COMMON.CONTACTS"
7109 double precision zapas(max_dim,maxconts,max_fg_procs),
7110 & zapas_recv(max_dim,maxconts,max_fg_procs)
7111 common /przechowalnia/ zapas
7112 integer i,j,ii,jj,iproc,itask(4),nn
7113 c write (iout,*) "itask",itask
7116 if (iproc.gt.0) then
7117 do j=1,num_cont_hb(ii)
7119 c write (iout,*) "i",ii," j",jj," jjc",jjc
7121 ncont_sent(iproc)=ncont_sent(iproc)+1
7122 nn=ncont_sent(iproc)
7123 zapas(1,nn,iproc)=ii
7124 zapas(2,nn,iproc)=jjc
7125 zapas(3,nn,iproc)=facont_hb(j,ii)
7126 zapas(4,nn,iproc)=ees0p(j,ii)
7127 zapas(5,nn,iproc)=ees0m(j,ii)
7128 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7129 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7130 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7131 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7132 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7133 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7134 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7135 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7136 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7137 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7138 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7139 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7140 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7141 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7142 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7143 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7144 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7145 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7146 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7147 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7148 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7156 c------------------------------------------------------------------------------
7157 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7159 C This subroutine calculates multi-body contributions to hydrogen-bonding
7160 implicit real*8 (a-h,o-z)
7161 include 'DIMENSIONS'
7162 include 'COMMON.IOUNITS'
7165 parameter (max_cont=maxconts)
7166 parameter (max_dim=70)
7167 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7168 double precision zapas(max_dim,maxconts,max_fg_procs),
7169 & zapas_recv(max_dim,maxconts,max_fg_procs)
7170 common /przechowalnia/ zapas
7171 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7172 & status_array(MPI_STATUS_SIZE,maxconts*2)
7174 include 'COMMON.SETUP'
7175 include 'COMMON.FFIELD'
7176 include 'COMMON.DERIV'
7177 include 'COMMON.LOCAL'
7178 include 'COMMON.INTERACT'
7179 include 'COMMON.CONTACTS'
7180 include 'COMMON.CHAIN'
7181 include 'COMMON.CONTROL'
7182 double precision gx(3),gx1(3)
7183 integer num_cont_hb_old(maxres)
7185 double precision eello4,eello5,eelo6,eello_turn6
7186 external eello4,eello5,eello6,eello_turn6
7187 C Set lprn=.true. for debugging
7192 num_cont_hb_old(i)=num_cont_hb(i)
7196 if (nfgtasks.le.1) goto 30
7198 write (iout,'(a)') 'Contact function values before RECEIVE:'
7200 write (iout,'(2i3,50(1x,i2,f5.2))')
7201 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7202 & j=1,num_cont_hb(i))
7206 do i=1,ntask_cont_from
7209 do i=1,ntask_cont_to
7212 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7214 C Make the list of contacts to send to send to other procesors
7215 do i=iturn3_start,iturn3_end
7216 c write (iout,*) "make contact list turn3",i," num_cont",
7218 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7220 do i=iturn4_start,iturn4_end
7221 c write (iout,*) "make contact list turn4",i," num_cont",
7223 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7227 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7229 do j=1,num_cont_hb(i)
7232 iproc=iint_sent_local(k,jjc,ii)
7233 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7234 if (iproc.ne.0) then
7235 ncont_sent(iproc)=ncont_sent(iproc)+1
7236 nn=ncont_sent(iproc)
7238 zapas(2,nn,iproc)=jjc
7239 zapas(3,nn,iproc)=d_cont(j,i)
7243 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7248 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7256 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7267 & "Numbers of contacts to be sent to other processors",
7268 & (ncont_sent(i),i=1,ntask_cont_to)
7269 write (iout,*) "Contacts sent"
7270 do ii=1,ntask_cont_to
7272 iproc=itask_cont_to(ii)
7273 write (iout,*) nn," contacts to processor",iproc,
7274 & " of CONT_TO_COMM group"
7276 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7284 CorrelID1=nfgtasks+fg_rank+1
7286 C Receive the numbers of needed contacts from other processors
7287 do ii=1,ntask_cont_from
7288 iproc=itask_cont_from(ii)
7290 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7291 & FG_COMM,req(ireq),IERR)
7293 c write (iout,*) "IRECV ended"
7295 C Send the number of contacts needed by other processors
7296 do ii=1,ntask_cont_to
7297 iproc=itask_cont_to(ii)
7299 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7300 & FG_COMM,req(ireq),IERR)
7302 c write (iout,*) "ISEND ended"
7303 c write (iout,*) "number of requests (nn)",ireq
7306 & call MPI_Waitall(ireq,req,status_array,ierr)
7308 c & "Numbers of contacts to be received from other processors",
7309 c & (ncont_recv(i),i=1,ntask_cont_from)
7313 do ii=1,ntask_cont_from
7314 iproc=itask_cont_from(ii)
7316 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7317 c & " of CONT_TO_COMM group"
7321 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7322 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7323 c write (iout,*) "ireq,req",ireq,req(ireq)
7326 C Send the contacts to processors that need them
7327 do ii=1,ntask_cont_to
7328 iproc=itask_cont_to(ii)
7330 c write (iout,*) nn," contacts to processor",iproc,
7331 c & " of CONT_TO_COMM group"
7334 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7335 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7336 c write (iout,*) "ireq,req",ireq,req(ireq)
7338 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7342 c write (iout,*) "number of requests (contacts)",ireq
7343 c write (iout,*) "req",(req(i),i=1,4)
7346 & call MPI_Waitall(ireq,req,status_array,ierr)
7347 do iii=1,ntask_cont_from
7348 iproc=itask_cont_from(iii)
7351 write (iout,*) "Received",nn," contacts from processor",iproc,
7352 & " of CONT_FROM_COMM group"
7355 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7360 ii=zapas_recv(1,i,iii)
7361 c Flag the received contacts to prevent double-counting
7362 jj=-zapas_recv(2,i,iii)
7363 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7365 nnn=num_cont_hb(ii)+1
7368 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7372 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7377 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7385 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7394 write (iout,'(a)') 'Contact function values after receive:'
7396 write (iout,'(2i3,50(1x,i3,5f6.3))')
7397 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7398 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7405 write (iout,'(a)') 'Contact function values:'
7407 write (iout,'(2i3,50(1x,i2,5f6.3))')
7408 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7409 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7415 C Remove the loop below after debugging !!!
7422 C Calculate the dipole-dipole interaction energies
7423 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7424 do i=iatel_s,iatel_e+1
7425 num_conti=num_cont_hb(i)
7434 C Calculate the local-electrostatic correlation terms
7435 c write (iout,*) "gradcorr5 in eello5 before loop"
7437 c write (iout,'(i5,3f10.5)')
7438 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7440 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7441 c write (iout,*) "corr loop i",i
7443 num_conti=num_cont_hb(i)
7444 num_conti1=num_cont_hb(i+1)
7451 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7452 c & ' jj=',jj,' kk=',kk
7453 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7454 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7455 & .or. j.lt.0 .and. j1.gt.0) .and.
7456 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7457 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7458 C The system gains extra energy.
7460 sqd1=dsqrt(d_cont(jj,i))
7461 sqd2=dsqrt(d_cont(kk,i1))
7462 sred_geom = sqd1*sqd2
7463 IF (sred_geom.lt.cutoff_corr) THEN
7464 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7466 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7467 cd & ' jj=',jj,' kk=',kk
7468 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7469 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7471 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7472 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7475 cd write (iout,*) 'sred_geom=',sred_geom,
7476 cd & ' ekont=',ekont,' fprim=',fprimcont,
7477 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7478 cd write (iout,*) "g_contij",g_contij
7479 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7480 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7481 call calc_eello(i,jp,i+1,jp1,jj,kk)
7482 if (wcorr4.gt.0.0d0)
7483 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7484 if (energy_dec.and.wcorr4.gt.0.0d0)
7485 1 write (iout,'(a6,4i5,0pf7.3)')
7486 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7487 c write (iout,*) "gradcorr5 before eello5"
7489 c write (iout,'(i5,3f10.5)')
7490 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7492 if (wcorr5.gt.0.0d0)
7493 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7494 c write (iout,*) "gradcorr5 after eello5"
7496 c write (iout,'(i5,3f10.5)')
7497 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7499 if (energy_dec.and.wcorr5.gt.0.0d0)
7500 1 write (iout,'(a6,4i5,0pf7.3)')
7501 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7502 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7503 cd write(2,*)'ijkl',i,jp,i+1,jp1
7504 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7505 & .or. wturn6.eq.0.0d0))then
7506 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7507 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7508 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7509 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7510 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7511 cd & 'ecorr6=',ecorr6
7512 cd write (iout,'(4e15.5)') sred_geom,
7513 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7514 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7515 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7516 else if (wturn6.gt.0.0d0
7517 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7518 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7519 eturn6=eturn6+eello_turn6(i,jj,kk)
7520 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7521 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7522 cd write (2,*) 'multibody_eello:eturn6',eturn6
7531 num_cont_hb(i)=num_cont_hb_old(i)
7533 c write (iout,*) "gradcorr5 in eello5"
7535 c write (iout,'(i5,3f10.5)')
7536 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7540 c------------------------------------------------------------------------------
7541 subroutine add_hb_contact_eello(ii,jj,itask)
7542 implicit real*8 (a-h,o-z)
7543 include "DIMENSIONS"
7544 include "COMMON.IOUNITS"
7547 parameter (max_cont=maxconts)
7548 parameter (max_dim=70)
7549 include "COMMON.CONTACTS"
7550 double precision zapas(max_dim,maxconts,max_fg_procs),
7551 & zapas_recv(max_dim,maxconts,max_fg_procs)
7552 common /przechowalnia/ zapas
7553 integer i,j,ii,jj,iproc,itask(4),nn
7554 c write (iout,*) "itask",itask
7557 if (iproc.gt.0) then
7558 do j=1,num_cont_hb(ii)
7560 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7562 ncont_sent(iproc)=ncont_sent(iproc)+1
7563 nn=ncont_sent(iproc)
7564 zapas(1,nn,iproc)=ii
7565 zapas(2,nn,iproc)=jjc
7566 zapas(3,nn,iproc)=d_cont(j,ii)
7570 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7575 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7583 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7595 c------------------------------------------------------------------------------
7596 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7597 implicit real*8 (a-h,o-z)
7598 include 'DIMENSIONS'
7599 include 'COMMON.IOUNITS'
7600 include 'COMMON.DERIV'
7601 include 'COMMON.INTERACT'
7602 include 'COMMON.CONTACTS'
7603 double precision gx(3),gx1(3)
7613 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7614 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7615 C Following 4 lines for diagnostics.
7620 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7621 c & 'Contacts ',i,j,
7622 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7623 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7625 C Calculate the multi-body contribution to energy.
7626 c ecorr=ecorr+ekont*ees
7627 C Calculate multi-body contributions to the gradient.
7628 coeffpees0pij=coeffp*ees0pij
7629 coeffmees0mij=coeffm*ees0mij
7630 coeffpees0pkl=coeffp*ees0pkl
7631 coeffmees0mkl=coeffm*ees0mkl
7633 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7634 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7635 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7636 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7637 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7638 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7639 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7640 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7641 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7642 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7643 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7644 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7645 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7646 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7647 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7648 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7649 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7650 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7651 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7652 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7653 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7654 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7655 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7656 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7657 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7662 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7663 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7664 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7665 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7670 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7671 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7672 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7673 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7676 c write (iout,*) "ehbcorr",ekont*ees
7681 C---------------------------------------------------------------------------
7682 subroutine dipole(i,j,jj)
7683 implicit real*8 (a-h,o-z)
7684 include 'DIMENSIONS'
7685 include 'COMMON.IOUNITS'
7686 include 'COMMON.CHAIN'
7687 include 'COMMON.FFIELD'
7688 include 'COMMON.DERIV'
7689 include 'COMMON.INTERACT'
7690 include 'COMMON.CONTACTS'
7691 include 'COMMON.TORSION'
7692 include 'COMMON.VAR'
7693 include 'COMMON.GEO'
7694 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7696 iti1 = itortyp(itype(i+1))
7697 if (j.lt.nres-1) then
7698 itj1 = itortyp(itype(j+1))
7703 dipi(iii,1)=Ub2(iii,i)
7704 dipderi(iii)=Ub2der(iii,i)
7705 dipi(iii,2)=b1(iii,iti1)
7706 dipj(iii,1)=Ub2(iii,j)
7707 dipderj(iii)=Ub2der(iii,j)
7708 dipj(iii,2)=b1(iii,itj1)
7712 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7715 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7722 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7726 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7731 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7732 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7734 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7736 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7738 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7743 C---------------------------------------------------------------------------
7744 subroutine calc_eello(i,j,k,l,jj,kk)
7746 C This subroutine computes matrices and vectors needed to calculate
7747 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7749 implicit real*8 (a-h,o-z)
7750 include 'DIMENSIONS'
7751 include 'COMMON.IOUNITS'
7752 include 'COMMON.CHAIN'
7753 include 'COMMON.DERIV'
7754 include 'COMMON.INTERACT'
7755 include 'COMMON.CONTACTS'
7756 include 'COMMON.TORSION'
7757 include 'COMMON.VAR'
7758 include 'COMMON.GEO'
7759 include 'COMMON.FFIELD'
7760 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7761 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7764 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7765 cd & ' jj=',jj,' kk=',kk
7766 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7767 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7768 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7771 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7772 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7775 call transpose2(aa1(1,1),aa1t(1,1))
7776 call transpose2(aa2(1,1),aa2t(1,1))
7779 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7780 & aa1tder(1,1,lll,kkk))
7781 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7782 & aa2tder(1,1,lll,kkk))
7786 C parallel orientation of the two CA-CA-CA frames.
7788 iti=itortyp(itype(i))
7792 itk1=itortyp(itype(k+1))
7793 itj=itortyp(itype(j))
7794 if (l.lt.nres-1) then
7795 itl1=itortyp(itype(l+1))
7799 C A1 kernel(j+1) A2T
7801 cd write (iout,'(3f10.5,5x,3f10.5)')
7802 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7804 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7805 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7806 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7807 C Following matrices are needed only for 6-th order cumulants
7808 IF (wcorr6.gt.0.0d0) THEN
7809 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7810 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7811 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7812 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7813 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7814 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7815 & ADtEAderx(1,1,1,1,1,1))
7817 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7818 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7819 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7820 & ADtEA1derx(1,1,1,1,1,1))
7822 C End 6-th order cumulants
7825 cd write (2,*) 'In calc_eello6'
7827 cd write (2,*) 'iii=',iii
7829 cd write (2,*) 'kkk=',kkk
7831 cd write (2,'(3(2f10.5),5x)')
7832 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7837 call transpose2(EUgder(1,1,k),auxmat(1,1))
7838 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7839 call transpose2(EUg(1,1,k),auxmat(1,1))
7840 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7841 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7845 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7846 & EAEAderx(1,1,lll,kkk,iii,1))
7850 C A1T kernel(i+1) A2
7851 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7852 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7853 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7854 C Following matrices are needed only for 6-th order cumulants
7855 IF (wcorr6.gt.0.0d0) THEN
7856 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7857 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7858 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7859 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7860 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7861 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7862 & ADtEAderx(1,1,1,1,1,2))
7863 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7864 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7865 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7866 & ADtEA1derx(1,1,1,1,1,2))
7868 C End 6-th order cumulants
7869 call transpose2(EUgder(1,1,l),auxmat(1,1))
7870 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7871 call transpose2(EUg(1,1,l),auxmat(1,1))
7872 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7873 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7877 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7878 & EAEAderx(1,1,lll,kkk,iii,2))
7883 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7884 C They are needed only when the fifth- or the sixth-order cumulants are
7886 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7887 call transpose2(AEA(1,1,1),auxmat(1,1))
7888 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7889 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7890 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7891 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7892 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7893 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7894 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7895 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7896 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7897 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7898 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7899 call transpose2(AEA(1,1,2),auxmat(1,1))
7900 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7901 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7902 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7903 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7904 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7905 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7906 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7907 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7908 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7909 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7910 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7911 C Calculate the Cartesian derivatives of the vectors.
7915 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7916 call matvec2(auxmat(1,1),b1(1,iti),
7917 & AEAb1derx(1,lll,kkk,iii,1,1))
7918 call matvec2(auxmat(1,1),Ub2(1,i),
7919 & AEAb2derx(1,lll,kkk,iii,1,1))
7920 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7921 & AEAb1derx(1,lll,kkk,iii,2,1))
7922 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7923 & AEAb2derx(1,lll,kkk,iii,2,1))
7924 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7925 call matvec2(auxmat(1,1),b1(1,itj),
7926 & AEAb1derx(1,lll,kkk,iii,1,2))
7927 call matvec2(auxmat(1,1),Ub2(1,j),
7928 & AEAb2derx(1,lll,kkk,iii,1,2))
7929 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7930 & AEAb1derx(1,lll,kkk,iii,2,2))
7931 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7932 & AEAb2derx(1,lll,kkk,iii,2,2))
7939 C Antiparallel orientation of the two CA-CA-CA frames.
7941 iti=itortyp(itype(i))
7945 itk1=itortyp(itype(k+1))
7946 itl=itortyp(itype(l))
7947 itj=itortyp(itype(j))
7948 if (j.lt.nres-1) then
7949 itj1=itortyp(itype(j+1))
7953 C A2 kernel(j-1)T A1T
7954 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7955 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7956 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7957 C Following matrices are needed only for 6-th order cumulants
7958 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7959 & j.eq.i+4 .and. l.eq.i+3)) THEN
7960 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7961 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7962 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7963 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7964 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7965 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7966 & ADtEAderx(1,1,1,1,1,1))
7967 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7968 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7969 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7970 & ADtEA1derx(1,1,1,1,1,1))
7972 C End 6-th order cumulants
7973 call transpose2(EUgder(1,1,k),auxmat(1,1))
7974 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7975 call transpose2(EUg(1,1,k),auxmat(1,1))
7976 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7977 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7981 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7982 & EAEAderx(1,1,lll,kkk,iii,1))
7986 C A2T kernel(i+1)T A1
7987 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7988 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7989 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7990 C Following matrices are needed only for 6-th order cumulants
7991 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7992 & j.eq.i+4 .and. l.eq.i+3)) THEN
7993 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7994 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7995 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7996 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7997 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7998 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7999 & ADtEAderx(1,1,1,1,1,2))
8000 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8001 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8002 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8003 & ADtEA1derx(1,1,1,1,1,2))
8005 C End 6-th order cumulants
8006 call transpose2(EUgder(1,1,j),auxmat(1,1))
8007 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8008 call transpose2(EUg(1,1,j),auxmat(1,1))
8009 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8010 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8014 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8015 & EAEAderx(1,1,lll,kkk,iii,2))
8020 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8021 C They are needed only when the fifth- or the sixth-order cumulants are
8023 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8024 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8025 call transpose2(AEA(1,1,1),auxmat(1,1))
8026 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8027 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8028 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8029 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8030 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8031 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8032 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8033 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8034 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8035 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8036 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8037 call transpose2(AEA(1,1,2),auxmat(1,1))
8038 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8039 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8040 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8041 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8042 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8043 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8044 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8045 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8046 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8047 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8048 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8049 C Calculate the Cartesian derivatives of the vectors.
8053 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8054 call matvec2(auxmat(1,1),b1(1,iti),
8055 & AEAb1derx(1,lll,kkk,iii,1,1))
8056 call matvec2(auxmat(1,1),Ub2(1,i),
8057 & AEAb2derx(1,lll,kkk,iii,1,1))
8058 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8059 & AEAb1derx(1,lll,kkk,iii,2,1))
8060 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8061 & AEAb2derx(1,lll,kkk,iii,2,1))
8062 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8063 call matvec2(auxmat(1,1),b1(1,itl),
8064 & AEAb1derx(1,lll,kkk,iii,1,2))
8065 call matvec2(auxmat(1,1),Ub2(1,l),
8066 & AEAb2derx(1,lll,kkk,iii,1,2))
8067 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
8068 & AEAb1derx(1,lll,kkk,iii,2,2))
8069 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8070 & AEAb2derx(1,lll,kkk,iii,2,2))
8079 C---------------------------------------------------------------------------
8080 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8081 & KK,KKderg,AKA,AKAderg,AKAderx)
8085 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8086 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8087 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8092 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8094 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8097 cd if (lprn) write (2,*) 'In kernel'
8099 cd if (lprn) write (2,*) 'kkk=',kkk
8101 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8102 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8104 cd write (2,*) 'lll=',lll
8105 cd write (2,*) 'iii=1'
8107 cd write (2,'(3(2f10.5),5x)')
8108 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8111 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8112 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8114 cd write (2,*) 'lll=',lll
8115 cd write (2,*) 'iii=2'
8117 cd write (2,'(3(2f10.5),5x)')
8118 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8125 C---------------------------------------------------------------------------
8126 double precision function eello4(i,j,k,l,jj,kk)
8127 implicit real*8 (a-h,o-z)
8128 include 'DIMENSIONS'
8129 include 'COMMON.IOUNITS'
8130 include 'COMMON.CHAIN'
8131 include 'COMMON.DERIV'
8132 include 'COMMON.INTERACT'
8133 include 'COMMON.CONTACTS'
8134 include 'COMMON.TORSION'
8135 include 'COMMON.VAR'
8136 include 'COMMON.GEO'
8137 double precision pizda(2,2),ggg1(3),ggg2(3)
8138 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8142 cd print *,'eello4:',i,j,k,l,jj,kk
8143 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8144 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8145 cold eij=facont_hb(jj,i)
8146 cold ekl=facont_hb(kk,k)
8148 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8149 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8150 gcorr_loc(k-1)=gcorr_loc(k-1)
8151 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8153 gcorr_loc(l-1)=gcorr_loc(l-1)
8154 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8156 gcorr_loc(j-1)=gcorr_loc(j-1)
8157 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8162 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8163 & -EAEAderx(2,2,lll,kkk,iii,1)
8164 cd derx(lll,kkk,iii)=0.0d0
8168 cd gcorr_loc(l-1)=0.0d0
8169 cd gcorr_loc(j-1)=0.0d0
8170 cd gcorr_loc(k-1)=0.0d0
8172 cd write (iout,*)'Contacts have occurred for peptide groups',
8173 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8174 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8175 if (j.lt.nres-1) then
8182 if (l.lt.nres-1) then
8190 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8191 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8192 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8193 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8194 cgrad ghalf=0.5d0*ggg1(ll)
8195 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8196 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8197 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8198 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8199 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8200 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8201 cgrad ghalf=0.5d0*ggg2(ll)
8202 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8203 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8204 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8205 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8206 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8207 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8211 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8216 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8221 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8226 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8230 cd write (2,*) iii,gcorr_loc(iii)
8233 cd write (2,*) 'ekont',ekont
8234 cd write (iout,*) 'eello4',ekont*eel4
8237 C---------------------------------------------------------------------------
8238 double precision function eello5(i,j,k,l,jj,kk)
8239 implicit real*8 (a-h,o-z)
8240 include 'DIMENSIONS'
8241 include 'COMMON.IOUNITS'
8242 include 'COMMON.CHAIN'
8243 include 'COMMON.DERIV'
8244 include 'COMMON.INTERACT'
8245 include 'COMMON.CONTACTS'
8246 include 'COMMON.TORSION'
8247 include 'COMMON.VAR'
8248 include 'COMMON.GEO'
8249 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8250 double precision ggg1(3),ggg2(3)
8251 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8256 C /l\ / \ \ / \ / \ / C
8257 C / \ / \ \ / \ / \ / C
8258 C j| o |l1 | o | o| o | | o |o C
8259 C \ |/k\| |/ \| / |/ \| |/ \| C
8260 C \i/ \ / \ / / \ / \ C
8262 C (I) (II) (III) (IV) C
8264 C eello5_1 eello5_2 eello5_3 eello5_4 C
8266 C Antiparallel chains C
8269 C /j\ / \ \ / \ / \ / C
8270 C / \ / \ \ / \ / \ / C
8271 C j1| o |l | o | o| o | | o |o C
8272 C \ |/k\| |/ \| / |/ \| |/ \| C
8273 C \i/ \ / \ / / \ / \ C
8275 C (I) (II) (III) (IV) C
8277 C eello5_1 eello5_2 eello5_3 eello5_4 C
8279 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8282 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8287 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8289 itk=itortyp(itype(k))
8290 itl=itortyp(itype(l))
8291 itj=itortyp(itype(j))
8296 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8297 cd & eel5_3_num,eel5_4_num)
8301 derx(lll,kkk,iii)=0.0d0
8305 cd eij=facont_hb(jj,i)
8306 cd ekl=facont_hb(kk,k)
8308 cd write (iout,*)'Contacts have occurred for peptide groups',
8309 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8311 C Contribution from the graph I.
8312 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8313 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8314 call transpose2(EUg(1,1,k),auxmat(1,1))
8315 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8316 vv(1)=pizda(1,1)-pizda(2,2)
8317 vv(2)=pizda(1,2)+pizda(2,1)
8318 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8319 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8320 C Explicit gradient in virtual-dihedral angles.
8321 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8322 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8323 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8324 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8325 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8326 vv(1)=pizda(1,1)-pizda(2,2)
8327 vv(2)=pizda(1,2)+pizda(2,1)
8328 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8329 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8330 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8331 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8332 vv(1)=pizda(1,1)-pizda(2,2)
8333 vv(2)=pizda(1,2)+pizda(2,1)
8335 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8336 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8337 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8339 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8340 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8341 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8343 C Cartesian gradient
8347 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8349 vv(1)=pizda(1,1)-pizda(2,2)
8350 vv(2)=pizda(1,2)+pizda(2,1)
8351 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8352 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8353 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8359 C Contribution from graph II
8360 call transpose2(EE(1,1,itk),auxmat(1,1))
8361 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8362 vv(1)=pizda(1,1)+pizda(2,2)
8363 vv(2)=pizda(2,1)-pizda(1,2)
8364 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8365 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8366 C Explicit gradient in virtual-dihedral angles.
8367 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8368 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8369 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8370 vv(1)=pizda(1,1)+pizda(2,2)
8371 vv(2)=pizda(2,1)-pizda(1,2)
8373 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8374 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8375 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8377 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8378 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8379 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8381 C Cartesian gradient
8385 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8387 vv(1)=pizda(1,1)+pizda(2,2)
8388 vv(2)=pizda(2,1)-pizda(1,2)
8389 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8390 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8391 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8399 C Parallel orientation
8400 C Contribution from graph III
8401 call transpose2(EUg(1,1,l),auxmat(1,1))
8402 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8403 vv(1)=pizda(1,1)-pizda(2,2)
8404 vv(2)=pizda(1,2)+pizda(2,1)
8405 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8406 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8407 C Explicit gradient in virtual-dihedral angles.
8408 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8409 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8410 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8411 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8412 vv(1)=pizda(1,1)-pizda(2,2)
8413 vv(2)=pizda(1,2)+pizda(2,1)
8414 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8415 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8416 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8417 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8418 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8419 vv(1)=pizda(1,1)-pizda(2,2)
8420 vv(2)=pizda(1,2)+pizda(2,1)
8421 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8422 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8423 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8424 C Cartesian gradient
8428 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8430 vv(1)=pizda(1,1)-pizda(2,2)
8431 vv(2)=pizda(1,2)+pizda(2,1)
8432 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8433 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8434 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8439 C Contribution from graph IV
8441 call transpose2(EE(1,1,itl),auxmat(1,1))
8442 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8443 vv(1)=pizda(1,1)+pizda(2,2)
8444 vv(2)=pizda(2,1)-pizda(1,2)
8445 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8446 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8447 C Explicit gradient in virtual-dihedral angles.
8448 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8449 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8450 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8451 vv(1)=pizda(1,1)+pizda(2,2)
8452 vv(2)=pizda(2,1)-pizda(1,2)
8453 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8454 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8455 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8456 C Cartesian gradient
8460 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8462 vv(1)=pizda(1,1)+pizda(2,2)
8463 vv(2)=pizda(2,1)-pizda(1,2)
8464 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8465 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8466 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8471 C Antiparallel orientation
8472 C Contribution from graph III
8474 call transpose2(EUg(1,1,j),auxmat(1,1))
8475 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8476 vv(1)=pizda(1,1)-pizda(2,2)
8477 vv(2)=pizda(1,2)+pizda(2,1)
8478 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8479 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8480 C Explicit gradient in virtual-dihedral angles.
8481 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8482 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8483 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8484 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8485 vv(1)=pizda(1,1)-pizda(2,2)
8486 vv(2)=pizda(1,2)+pizda(2,1)
8487 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8488 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8489 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8490 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8491 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8492 vv(1)=pizda(1,1)-pizda(2,2)
8493 vv(2)=pizda(1,2)+pizda(2,1)
8494 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8495 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8496 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8497 C Cartesian gradient
8501 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8503 vv(1)=pizda(1,1)-pizda(2,2)
8504 vv(2)=pizda(1,2)+pizda(2,1)
8505 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8506 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8507 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8512 C Contribution from graph IV
8514 call transpose2(EE(1,1,itj),auxmat(1,1))
8515 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8516 vv(1)=pizda(1,1)+pizda(2,2)
8517 vv(2)=pizda(2,1)-pizda(1,2)
8518 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8519 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8520 C Explicit gradient in virtual-dihedral angles.
8521 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8522 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8523 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8524 vv(1)=pizda(1,1)+pizda(2,2)
8525 vv(2)=pizda(2,1)-pizda(1,2)
8526 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8527 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8528 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8529 C Cartesian gradient
8533 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8535 vv(1)=pizda(1,1)+pizda(2,2)
8536 vv(2)=pizda(2,1)-pizda(1,2)
8537 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8538 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8539 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8545 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8546 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8547 cd write (2,*) 'ijkl',i,j,k,l
8548 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8549 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8551 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8552 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8553 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8554 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8555 if (j.lt.nres-1) then
8562 if (l.lt.nres-1) then
8572 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8573 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8574 C summed up outside the subrouine as for the other subroutines
8575 C handling long-range interactions. The old code is commented out
8576 C with "cgrad" to keep track of changes.
8578 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8579 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8580 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8581 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8582 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8583 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8584 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8585 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8586 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8587 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8589 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8590 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8591 cgrad ghalf=0.5d0*ggg1(ll)
8593 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8594 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8595 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8596 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8597 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8598 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8599 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8600 cgrad ghalf=0.5d0*ggg2(ll)
8602 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8603 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8604 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8605 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8606 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8607 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8612 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8613 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8618 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8619 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8625 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8630 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8634 cd write (2,*) iii,g_corr5_loc(iii)
8637 cd write (2,*) 'ekont',ekont
8638 cd write (iout,*) 'eello5',ekont*eel5
8641 c--------------------------------------------------------------------------
8642 double precision function eello6(i,j,k,l,jj,kk)
8643 implicit real*8 (a-h,o-z)
8644 include 'DIMENSIONS'
8645 include 'COMMON.IOUNITS'
8646 include 'COMMON.CHAIN'
8647 include 'COMMON.DERIV'
8648 include 'COMMON.INTERACT'
8649 include 'COMMON.CONTACTS'
8650 include 'COMMON.TORSION'
8651 include 'COMMON.VAR'
8652 include 'COMMON.GEO'
8653 include 'COMMON.FFIELD'
8654 double precision ggg1(3),ggg2(3)
8655 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8660 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8668 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8669 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8673 derx(lll,kkk,iii)=0.0d0
8677 cd eij=facont_hb(jj,i)
8678 cd ekl=facont_hb(kk,k)
8684 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8685 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8686 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8687 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8688 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8689 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8691 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8692 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8693 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8694 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8695 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8696 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8700 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8702 C If turn contributions are considered, they will be handled separately.
8703 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8704 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8705 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8706 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8707 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8708 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8709 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8711 if (j.lt.nres-1) then
8718 if (l.lt.nres-1) then
8726 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8727 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8728 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8729 cgrad ghalf=0.5d0*ggg1(ll)
8731 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8732 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8733 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8734 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8735 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8736 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8737 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8738 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8739 cgrad ghalf=0.5d0*ggg2(ll)
8740 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8742 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8743 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8744 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8745 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8746 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8747 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8752 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8753 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8758 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8759 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8765 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8770 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8774 cd write (2,*) iii,g_corr6_loc(iii)
8777 cd write (2,*) 'ekont',ekont
8778 cd write (iout,*) 'eello6',ekont*eel6
8781 c--------------------------------------------------------------------------
8782 double precision function eello6_graph1(i,j,k,l,imat,swap)
8783 implicit real*8 (a-h,o-z)
8784 include 'DIMENSIONS'
8785 include 'COMMON.IOUNITS'
8786 include 'COMMON.CHAIN'
8787 include 'COMMON.DERIV'
8788 include 'COMMON.INTERACT'
8789 include 'COMMON.CONTACTS'
8790 include 'COMMON.TORSION'
8791 include 'COMMON.VAR'
8792 include 'COMMON.GEO'
8793 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8797 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8799 C Parallel Antiparallel
8805 C \ j|/k\| / \ |/k\|l /
8810 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8811 itk=itortyp(itype(k))
8812 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8813 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8814 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8815 call transpose2(EUgC(1,1,k),auxmat(1,1))
8816 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8817 vv1(1)=pizda1(1,1)-pizda1(2,2)
8818 vv1(2)=pizda1(1,2)+pizda1(2,1)
8819 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8820 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8821 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8822 s5=scalar2(vv(1),Dtobr2(1,i))
8823 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8824 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8825 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8826 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8827 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8828 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8829 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8830 & +scalar2(vv(1),Dtobr2der(1,i)))
8831 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8832 vv1(1)=pizda1(1,1)-pizda1(2,2)
8833 vv1(2)=pizda1(1,2)+pizda1(2,1)
8834 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8835 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8837 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8838 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8839 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8840 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8841 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8843 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8844 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8845 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8846 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8847 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8849 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8850 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8851 vv1(1)=pizda1(1,1)-pizda1(2,2)
8852 vv1(2)=pizda1(1,2)+pizda1(2,1)
8853 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8854 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8855 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8856 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8865 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8866 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8867 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8868 call transpose2(EUgC(1,1,k),auxmat(1,1))
8869 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8871 vv1(1)=pizda1(1,1)-pizda1(2,2)
8872 vv1(2)=pizda1(1,2)+pizda1(2,1)
8873 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8874 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8875 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8876 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8877 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8878 s5=scalar2(vv(1),Dtobr2(1,i))
8879 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8885 c----------------------------------------------------------------------------
8886 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8887 implicit real*8 (a-h,o-z)
8888 include 'DIMENSIONS'
8889 include 'COMMON.IOUNITS'
8890 include 'COMMON.CHAIN'
8891 include 'COMMON.DERIV'
8892 include 'COMMON.INTERACT'
8893 include 'COMMON.CONTACTS'
8894 include 'COMMON.TORSION'
8895 include 'COMMON.VAR'
8896 include 'COMMON.GEO'
8898 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8899 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8902 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8904 C Parallel Antiparallel C
8910 C \ j|/k\| \ |/k\|l C
8915 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8916 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8917 C AL 7/4/01 s1 would occur in the sixth-order moment,
8918 C but not in a cluster cumulant
8920 s1=dip(1,jj,i)*dip(1,kk,k)
8922 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8923 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8924 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8925 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8926 call transpose2(EUg(1,1,k),auxmat(1,1))
8927 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8928 vv(1)=pizda(1,1)-pizda(2,2)
8929 vv(2)=pizda(1,2)+pizda(2,1)
8930 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8931 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8933 eello6_graph2=-(s1+s2+s3+s4)
8935 eello6_graph2=-(s2+s3+s4)
8938 C Derivatives in gamma(i-1)
8941 s1=dipderg(1,jj,i)*dip(1,kk,k)
8943 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8944 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8945 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8946 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8948 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8950 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8952 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8954 C Derivatives in gamma(k-1)
8956 s1=dip(1,jj,i)*dipderg(1,kk,k)
8958 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8959 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8960 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8961 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8962 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8963 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8964 vv(1)=pizda(1,1)-pizda(2,2)
8965 vv(2)=pizda(1,2)+pizda(2,1)
8966 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8968 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8970 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8972 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8973 C Derivatives in gamma(j-1) or gamma(l-1)
8976 s1=dipderg(3,jj,i)*dip(1,kk,k)
8978 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8979 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8980 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8981 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8982 vv(1)=pizda(1,1)-pizda(2,2)
8983 vv(2)=pizda(1,2)+pizda(2,1)
8984 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8987 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8989 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8992 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8993 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8995 C Derivatives in gamma(l-1) or gamma(j-1)
8998 s1=dip(1,jj,i)*dipderg(3,kk,k)
9000 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9001 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9002 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9003 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9004 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9005 vv(1)=pizda(1,1)-pizda(2,2)
9006 vv(2)=pizda(1,2)+pizda(2,1)
9007 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9010 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9012 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9015 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9016 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9018 C Cartesian derivatives.
9020 write (2,*) 'In eello6_graph2'
9022 write (2,*) 'iii=',iii
9024 write (2,*) 'kkk=',kkk
9026 write (2,'(3(2f10.5),5x)')
9027 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9037 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9039 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9042 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9044 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9045 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9047 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9048 call transpose2(EUg(1,1,k),auxmat(1,1))
9049 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9051 vv(1)=pizda(1,1)-pizda(2,2)
9052 vv(2)=pizda(1,2)+pizda(2,1)
9053 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9054 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9056 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9058 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9061 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9063 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9070 c----------------------------------------------------------------------------
9071 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9072 implicit real*8 (a-h,o-z)
9073 include 'DIMENSIONS'
9074 include 'COMMON.IOUNITS'
9075 include 'COMMON.CHAIN'
9076 include 'COMMON.DERIV'
9077 include 'COMMON.INTERACT'
9078 include 'COMMON.CONTACTS'
9079 include 'COMMON.TORSION'
9080 include 'COMMON.VAR'
9081 include 'COMMON.GEO'
9082 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9084 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9086 C Parallel Antiparallel C
9092 C j|/k\| / |/k\|l / C
9097 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9099 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9100 C energy moment and not to the cluster cumulant.
9101 iti=itortyp(itype(i))
9102 if (j.lt.nres-1) then
9103 itj1=itortyp(itype(j+1))
9107 itk=itortyp(itype(k))
9108 itk1=itortyp(itype(k+1))
9109 if (l.lt.nres-1) then
9110 itl1=itortyp(itype(l+1))
9115 s1=dip(4,jj,i)*dip(4,kk,k)
9117 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9118 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9119 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9120 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9121 call transpose2(EE(1,1,itk),auxmat(1,1))
9122 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9123 vv(1)=pizda(1,1)+pizda(2,2)
9124 vv(2)=pizda(2,1)-pizda(1,2)
9125 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9126 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9127 cd & "sum",-(s2+s3+s4)
9129 eello6_graph3=-(s1+s2+s3+s4)
9131 eello6_graph3=-(s2+s3+s4)
9134 C Derivatives in gamma(k-1)
9135 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9136 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9137 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9138 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9139 C Derivatives in gamma(l-1)
9140 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9141 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9142 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9143 vv(1)=pizda(1,1)+pizda(2,2)
9144 vv(2)=pizda(2,1)-pizda(1,2)
9145 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9146 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9147 C Cartesian derivatives.
9153 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9155 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9158 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9160 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9161 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
9163 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9164 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9166 vv(1)=pizda(1,1)+pizda(2,2)
9167 vv(2)=pizda(2,1)-pizda(1,2)
9168 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9170 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9172 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9175 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9177 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9179 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9185 c----------------------------------------------------------------------------
9186 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9187 implicit real*8 (a-h,o-z)
9188 include 'DIMENSIONS'
9189 include 'COMMON.IOUNITS'
9190 include 'COMMON.CHAIN'
9191 include 'COMMON.DERIV'
9192 include 'COMMON.INTERACT'
9193 include 'COMMON.CONTACTS'
9194 include 'COMMON.TORSION'
9195 include 'COMMON.VAR'
9196 include 'COMMON.GEO'
9197 include 'COMMON.FFIELD'
9198 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9199 & auxvec1(2),auxmat1(2,2)
9201 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9203 C Parallel Antiparallel C
9209 C \ j|/k\| \ |/k\|l C
9214 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9216 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9217 C energy moment and not to the cluster cumulant.
9218 cd write (2,*) 'eello_graph4: wturn6',wturn6
9219 iti=itortyp(itype(i))
9220 itj=itortyp(itype(j))
9221 if (j.lt.nres-1) then
9222 itj1=itortyp(itype(j+1))
9226 itk=itortyp(itype(k))
9227 if (k.lt.nres-1) then
9228 itk1=itortyp(itype(k+1))
9232 itl=itortyp(itype(l))
9233 if (l.lt.nres-1) then
9234 itl1=itortyp(itype(l+1))
9238 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9239 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9240 cd & ' itl',itl,' itl1',itl1
9243 s1=dip(3,jj,i)*dip(3,kk,k)
9245 s1=dip(2,jj,j)*dip(2,kk,l)
9248 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9249 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9251 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9252 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9254 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9255 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9257 call transpose2(EUg(1,1,k),auxmat(1,1))
9258 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9259 vv(1)=pizda(1,1)-pizda(2,2)
9260 vv(2)=pizda(2,1)+pizda(1,2)
9261 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9262 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9264 eello6_graph4=-(s1+s2+s3+s4)
9266 eello6_graph4=-(s2+s3+s4)
9268 C Derivatives in gamma(i-1)
9272 s1=dipderg(2,jj,i)*dip(3,kk,k)
9274 s1=dipderg(4,jj,j)*dip(2,kk,l)
9277 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9279 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9280 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9282 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9283 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9285 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9286 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9287 cd write (2,*) 'turn6 derivatives'
9289 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9291 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9295 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9297 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9301 C Derivatives in gamma(k-1)
9304 s1=dip(3,jj,i)*dipderg(2,kk,k)
9306 s1=dip(2,jj,j)*dipderg(4,kk,l)
9309 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9310 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9312 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9313 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9315 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9316 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9318 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9319 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9320 vv(1)=pizda(1,1)-pizda(2,2)
9321 vv(2)=pizda(2,1)+pizda(1,2)
9322 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9323 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9325 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9327 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9331 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9333 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9336 C Derivatives in gamma(j-1) or gamma(l-1)
9337 if (l.eq.j+1 .and. l.gt.1) then
9338 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9339 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9340 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9341 vv(1)=pizda(1,1)-pizda(2,2)
9342 vv(2)=pizda(2,1)+pizda(1,2)
9343 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9344 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9345 else if (j.gt.1) then
9346 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9347 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9348 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9349 vv(1)=pizda(1,1)-pizda(2,2)
9350 vv(2)=pizda(2,1)+pizda(1,2)
9351 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9352 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9353 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9355 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9358 C Cartesian derivatives.
9365 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9367 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9371 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9373 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9377 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9379 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9381 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9382 & b1(1,itj1),auxvec(1))
9383 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9385 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9386 & b1(1,itl1),auxvec(1))
9387 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9389 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9391 vv(1)=pizda(1,1)-pizda(2,2)
9392 vv(2)=pizda(2,1)+pizda(1,2)
9393 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9395 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9397 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9400 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9403 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9406 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9408 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9410 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9414 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9416 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9419 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9421 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9429 c----------------------------------------------------------------------------
9430 double precision function eello_turn6(i,jj,kk)
9431 implicit real*8 (a-h,o-z)
9432 include 'DIMENSIONS'
9433 include 'COMMON.IOUNITS'
9434 include 'COMMON.CHAIN'
9435 include 'COMMON.DERIV'
9436 include 'COMMON.INTERACT'
9437 include 'COMMON.CONTACTS'
9438 include 'COMMON.TORSION'
9439 include 'COMMON.VAR'
9440 include 'COMMON.GEO'
9441 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9442 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9444 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9445 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9446 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9447 C the respective energy moment and not to the cluster cumulant.
9456 iti=itortyp(itype(i))
9457 itk=itortyp(itype(k))
9458 itk1=itortyp(itype(k+1))
9459 itl=itortyp(itype(l))
9460 itj=itortyp(itype(j))
9461 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9462 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9463 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9468 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9470 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9474 derx_turn(lll,kkk,iii)=0.0d0
9481 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9483 cd write (2,*) 'eello6_5',eello6_5
9485 call transpose2(AEA(1,1,1),auxmat(1,1))
9486 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9487 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9488 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9490 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9491 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9492 s2 = scalar2(b1(1,itk),vtemp1(1))
9494 call transpose2(AEA(1,1,2),atemp(1,1))
9495 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9496 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9497 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9499 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9500 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9501 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9503 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9504 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9505 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9506 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9507 ss13 = scalar2(b1(1,itk),vtemp4(1))
9508 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9510 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9516 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9517 C Derivatives in gamma(i+2)
9521 call transpose2(AEA(1,1,1),auxmatd(1,1))
9522 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9523 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9524 call transpose2(AEAderg(1,1,2),atempd(1,1))
9525 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9526 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9528 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9529 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9530 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9536 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9537 C Derivatives in gamma(i+3)
9539 call transpose2(AEA(1,1,1),auxmatd(1,1))
9540 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9541 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9542 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9544 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9545 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9546 s2d = scalar2(b1(1,itk),vtemp1d(1))
9548 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9549 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9551 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9553 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9554 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9555 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9563 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9564 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9566 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9567 & -0.5d0*ekont*(s2d+s12d)
9569 C Derivatives in gamma(i+4)
9570 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9571 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9572 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9574 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9575 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9576 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9584 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9586 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9588 C Derivatives in gamma(i+5)
9590 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9591 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9592 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9594 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9595 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9596 s2d = scalar2(b1(1,itk),vtemp1d(1))
9598 call transpose2(AEA(1,1,2),atempd(1,1))
9599 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9600 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9602 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9603 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9605 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9606 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9607 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9615 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9616 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9618 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9619 & -0.5d0*ekont*(s2d+s12d)
9621 C Cartesian derivatives
9626 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9627 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9628 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9630 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9631 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9633 s2d = scalar2(b1(1,itk),vtemp1d(1))
9635 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9636 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9637 s8d = -(atempd(1,1)+atempd(2,2))*
9638 & scalar2(cc(1,1,itl),vtemp2(1))
9640 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9642 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9643 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9650 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9653 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9657 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9658 & - 0.5d0*(s8d+s12d)
9660 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9669 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9671 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9672 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9673 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9674 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9675 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9677 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9678 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9679 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9683 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9684 cd & 16*eel_turn6_num
9686 if (j.lt.nres-1) then
9693 if (l.lt.nres-1) then
9701 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9702 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9703 cgrad ghalf=0.5d0*ggg1(ll)
9705 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9706 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9707 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9708 & +ekont*derx_turn(ll,2,1)
9709 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9710 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9711 & +ekont*derx_turn(ll,4,1)
9712 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9713 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9714 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9715 cgrad ghalf=0.5d0*ggg2(ll)
9717 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9718 & +ekont*derx_turn(ll,2,2)
9719 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9720 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9721 & +ekont*derx_turn(ll,4,2)
9722 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9723 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9724 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9729 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9734 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9740 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9745 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9749 cd write (2,*) iii,g_corr6_loc(iii)
9751 eello_turn6=ekont*eel_turn6
9752 cd write (2,*) 'ekont',ekont
9753 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9757 C-----------------------------------------------------------------------------
9758 double precision function scalar(u,v)
9759 !DIR$ INLINEALWAYS scalar
9761 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9764 double precision u(3),v(3)
9765 cd double precision sc
9773 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9776 crc-------------------------------------------------
9777 SUBROUTINE MATVEC2(A1,V1,V2)
9778 !DIR$ INLINEALWAYS MATVEC2
9780 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9782 implicit real*8 (a-h,o-z)
9783 include 'DIMENSIONS'
9784 DIMENSION A1(2,2),V1(2),V2(2)
9788 c 3 VI=VI+A1(I,K)*V1(K)
9792 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9793 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9798 C---------------------------------------
9799 SUBROUTINE MATMAT2(A1,A2,A3)
9801 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9803 implicit real*8 (a-h,o-z)
9804 include 'DIMENSIONS'
9805 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9806 c DIMENSION AI3(2,2)
9810 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9816 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9817 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9818 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9819 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9827 c-------------------------------------------------------------------------
9828 double precision function scalar2(u,v)
9829 !DIR$ INLINEALWAYS scalar2
9831 double precision u(2),v(2)
9834 scalar2=u(1)*v(1)+u(2)*v(2)
9838 C-----------------------------------------------------------------------------
9840 subroutine transpose2(a,at)
9841 !DIR$ INLINEALWAYS transpose2
9843 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9846 double precision a(2,2),at(2,2)
9853 c--------------------------------------------------------------------------
9854 subroutine transpose(n,a,at)
9857 double precision a(n,n),at(n,n)
9865 C---------------------------------------------------------------------------
9866 subroutine prodmat3(a1,a2,kk,transp,prod)
9867 !DIR$ INLINEALWAYS prodmat3
9869 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9873 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9875 crc double precision auxmat(2,2),prod_(2,2)
9878 crc call transpose2(kk(1,1),auxmat(1,1))
9879 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9880 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9882 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9883 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9884 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9885 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9886 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9887 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9888 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9889 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9892 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9893 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9895 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9896 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9897 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9898 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9899 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9900 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9901 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9902 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9905 c call transpose2(a2(1,1),a2t(1,1))
9908 crc print *,((prod_(i,j),i=1,2),j=1,2)
9909 crc print *,((prod(i,j),i=1,2),j=1,2)