1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
37 if (fg_rank.eq.0) then
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
39 c print *,"Processor",myrank," BROADCAST iorder"
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
41 C FG slaves as WEIGHTS array.
62 C FG Master broadcasts the WEIGHTS_ array
63 call MPI_Bcast(weights_(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
66 C FG slaves receive the WEIGHTS array
67 call MPI_Bcast(weights(1),n_ene,
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
92 c call chainbuild_cart
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
98 c call int_from_cart1(.false.)
109 C Compute the side-chain and electrostatic interaction energy
111 goto (101,102,103,104,105,106) ipot
112 C Lennard-Jones potential.
113 101 call elj(evdw,evdw_p,evdw_m)
114 cd print '(a)','Exit ELJ'
116 C Lennard-Jones-Kihara potential (shifted).
117 102 call eljk(evdw,evdw_p,evdw_m)
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
120 103 call ebp(evdw,evdw_p,evdw_m)
122 C Gay-Berne potential (shifted LJ, angular dependence).
123 104 call egb(evdw,evdw_p,evdw_m)
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
126 105 call egbv(evdw,evdw_p,evdw_m)
128 C Soft-sphere potential
129 106 call e_softsphere(evdw)
131 C Calculate electrostatic (H-bonding) energy of the main chain.
135 C BARTEK for dfa test!
136 if (wdfa_dist.gt.0) call edfad(edfadis)
137 c print*, 'edfad is finished!', edfadis
138 if (wdfa_tor.gt.0) call edfat(edfator)
139 c print*, 'edfat is finished!', edfator
140 if (wdfa_nei.gt.0) call edfan(edfanei)
141 c print*, 'edfan is finished!', edfanei
142 if (wdfa_beta.gt.0) call edfab(edfabet)
143 c print*, 'edfab is finished!', edfabet
144 c print *,"Processor",myrank," computed USCSC"
155 time_vec=time_vec+MPI_Wtime()-time01
157 time_vec=time_vec+tcpu()-time01
160 c print *,"Processor",myrank," left VEC_AND_DERIV"
163 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
164 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
165 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
166 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
168 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
169 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
170 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
171 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
173 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
182 c write (iout,*) "Soft-spheer ELEC potential"
183 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
186 c print *,"Processor",myrank," computed UELEC"
188 C Calculate excluded-volume interaction energy between peptide groups
193 call escp(evdw2,evdw2_14)
199 c write (iout,*) "Soft-sphere SCP potential"
200 call escp_soft_sphere(evdw2,evdw2_14)
203 c Calculate the bond-stretching energy
207 C Calculate the disulfide-bridge and other energy and the contributions
208 C from other distance constraints.
209 cd print *,'Calling EHPB'
211 cd print *,'EHPB exitted succesfully.'
213 C Calculate the virtual-bond-angle energy.
215 if (wang.gt.0d0) then
220 c print *,"Processor",myrank," computed UB"
222 C Calculate the SC local energy.
225 c print *,"Processor",myrank," computed USC"
227 C Calculate the virtual-bond torsional energy.
229 cd print *,'nterm=',nterm
231 call etor(etors,edihcnstr)
236 c print *,"Processor",myrank," computed Utor"
238 C 6/23/01 Calculate double-torsional energy
240 if (wtor_d.gt.0) then
245 c print *,"Processor",myrank," computed Utord"
247 C 21/5/07 Calculate local sicdechain correlation energy
249 if (wsccor.gt.0.0d0) then
250 call eback_sc_corr(esccor)
254 c print *,"Processor",myrank," computed Usccorr"
256 C 12/1/95 Multi-body terms
260 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
261 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
262 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
263 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
264 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
271 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
272 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
273 cd write (iout,*) "multibody_hb ecorr",ecorr
275 c print *,"Processor",myrank," computed Ucorr"
277 C If performing constraint dynamics, call the constraint energy
278 C after the equilibration time
279 if(usampl.and.totT.gt.eq_time) then
288 time_enecalc=time_enecalc+MPI_Wtime()-time00
290 time_enecalc=time_enecalc+tcpu()-time00
293 c print *,"Processor",myrank," computed Uconstr"
306 energia(2)=evdw2-evdw2_14
323 energia(8)=eello_turn3
324 energia(9)=eello_turn4
331 energia(19)=edihcnstr
333 energia(20)=Uconst+Uconst_back
341 c print *," Processor",myrank," calls SUM_ENERGY"
342 call sum_energy(energia,.true.)
343 c print *," Processor",myrank," left SUM_ENERGY"
346 time_sumene=time_sumene+MPI_Wtime()-time00
348 time_sumene=time_sumene+tcpu()-time00
353 c-------------------------------------------------------------------------------
354 subroutine sum_energy(energia,reduce)
355 implicit real*8 (a-h,o-z)
360 cMS$ATTRIBUTES C :: proc_proc
366 include 'COMMON.SETUP'
367 include 'COMMON.IOUNITS'
368 double precision energia(0:n_ene),enebuff(0:n_ene+1)
369 include 'COMMON.FFIELD'
370 include 'COMMON.DERIV'
371 include 'COMMON.INTERACT'
372 include 'COMMON.SBRIDGE'
373 include 'COMMON.CHAIN'
375 include 'COMMON.CONTROL'
376 include 'COMMON.TIME1'
379 if (nfgtasks.gt.1 .and. reduce) then
381 write (iout,*) "energies before REDUCE"
382 call enerprint(energia)
386 enebuff(i)=energia(i)
389 call MPI_Barrier(FG_COMM,IERR)
390 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
392 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
393 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
395 write (iout,*) "energies after REDUCE"
396 call enerprint(energia)
399 time_Reduce=time_Reduce+MPI_Wtime()-time00
401 if (fg_rank.eq.0) then
404 evdw=energia(22)+wsct*energia(23)
409 evdw2=energia(2)+energia(18)
425 eello_turn3=energia(8)
426 eello_turn4=energia(9)
433 edihcnstr=energia(19)
442 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
443 & +wang*ebe+wtor*etors+wscloc*escloc
444 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
445 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
446 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
447 & +wbond*estr+Uconst+wsccor*esccor
448 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
451 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
452 & +wang*ebe+wtor*etors+wscloc*escloc
453 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
454 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
455 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
456 & +wbond*estr+Uconst+wsccor*esccor
457 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
464 if (isnan(etot).ne.0) energia(0)=1.0d+99
466 if (isnan(etot)) energia(0)=1.0d+99
471 idumm=proc_proc(etot,i)
473 call proc_proc(etot,i)
475 if(i.eq.1)energia(0)=1.0d+99
482 c-------------------------------------------------------------------------------
483 subroutine sum_gradient
484 implicit real*8 (a-h,o-z)
489 cMS$ATTRIBUTES C :: proc_proc
495 double precision gradbufc(3,maxres),gradbufx(3,maxres),
496 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
497 include 'COMMON.SETUP'
498 include 'COMMON.IOUNITS'
499 include 'COMMON.FFIELD'
500 include 'COMMON.DERIV'
501 include 'COMMON.INTERACT'
502 include 'COMMON.SBRIDGE'
503 include 'COMMON.CHAIN'
505 include 'COMMON.CONTROL'
506 include 'COMMON.TIME1'
507 include 'COMMON.MAXGRAD'
508 include 'COMMON.SCCOR'
517 write (iout,*) "sum_gradient gvdwc, gvdwx"
519 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
520 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
521 & (gvdwcT(j,i),j=1,3)
526 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
527 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
528 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
531 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
532 C in virtual-bond-vector coordinates
535 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
537 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
538 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
540 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
542 c write (iout,'(i5,3f10.5,2x,f10.5)')
543 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
545 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
547 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
548 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
557 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
558 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
559 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
560 & wel_loc*gel_loc_long(j,i)+
561 & wcorr*gradcorr_long(j,i)+
562 & wcorr5*gradcorr5_long(j,i)+
563 & wcorr6*gradcorr6_long(j,i)+
564 & wturn6*gcorr6_turn_long(j,i)+
565 & wstrain*ghpbc(j,i)+
566 & wdfa_dist*gdfad(j,i)+
567 & wdfa_tor*gdfat(j,i)+
568 & wdfa_nei*gdfan(j,i)+
569 & wdfa_beta*gdfab(j,i)
575 gradbufc(j,i)=wsc*gvdwc(j,i)+
576 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
577 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
578 & wel_loc*gel_loc_long(j,i)+
579 & wcorr*gradcorr_long(j,i)+
580 & wcorr5*gradcorr5_long(j,i)+
581 & wcorr6*gradcorr6_long(j,i)+
582 & wturn6*gcorr6_turn_long(j,i)+
583 & wstrain*ghpbc(j,i)+
584 & wdfa_dist*gdfad(j,i)+
585 & wdfa_tor*gdfat(j,i)+
586 & wdfa_nei*gdfan(j,i)+
587 & wdfa_beta*gdfab(j,i)
594 gradbufc(j,i)=wsc*gvdwc(j,i)+
595 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
596 & welec*gelc_long(j,i)+
598 & wel_loc*gel_loc_long(j,i)+
599 & wcorr*gradcorr_long(j,i)+
600 & wcorr5*gradcorr5_long(j,i)+
601 & wcorr6*gradcorr6_long(j,i)+
602 & wturn6*gcorr6_turn_long(j,i)+
603 & wstrain*ghpbc(j,i)+
604 & wdfa_dist*gdfad(j,i)+
605 & wdfa_tor*gdfat(j,i)+
606 & wdfa_nei*gdfan(j,i)+
607 & wdfa_beta*gdfab(j,i)
612 if (nfgtasks.gt.1) then
615 write (iout,*) "gradbufc before allreduce"
617 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
623 gradbufc_sum(j,i)=gradbufc(j,i)
626 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
627 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
628 c time_reduce=time_reduce+MPI_Wtime()-time00
630 c write (iout,*) "gradbufc_sum after allreduce"
632 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
637 c time_allreduce=time_allreduce+MPI_Wtime()-time00
645 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
646 write (iout,*) (i," jgrad_start",jgrad_start(i),
647 & " jgrad_end ",jgrad_end(i),
648 & i=igrad_start,igrad_end)
651 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
652 c do not parallelize this part.
654 c do i=igrad_start,igrad_end
655 c do j=jgrad_start(i),jgrad_end(i)
657 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
662 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
666 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
670 write (iout,*) "gradbufc after summing"
672 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
679 write (iout,*) "gradbufc"
681 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
687 gradbufc_sum(j,i)=gradbufc(j,i)
692 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
696 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
701 c gradbufc(k,i)=0.0d0
705 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
710 write (iout,*) "gradbufc after summing"
712 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
720 gradbufc(k,nres)=0.0d0
725 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
726 & wel_loc*gel_loc(j,i)+
727 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
728 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
729 & wel_loc*gel_loc_long(j,i)+
730 & wcorr*gradcorr_long(j,i)+
731 & wcorr5*gradcorr5_long(j,i)+
732 & wcorr6*gradcorr6_long(j,i)+
733 & wturn6*gcorr6_turn_long(j,i))+
735 & wcorr*gradcorr(j,i)+
736 & wturn3*gcorr3_turn(j,i)+
737 & wturn4*gcorr4_turn(j,i)+
738 & wcorr5*gradcorr5(j,i)+
739 & wcorr6*gradcorr6(j,i)+
740 & wturn6*gcorr6_turn(j,i)+
741 & wsccor*gsccorc(j,i)
742 & +wscloc*gscloc(j,i)
744 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
745 & wel_loc*gel_loc(j,i)+
746 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
747 & welec*gelc_long(j,i)+
748 & wel_loc*gel_loc_long(j,i)+
749 & wcorr*gcorr_long(j,i)+
750 & wcorr5*gradcorr5_long(j,i)+
751 & wcorr6*gradcorr6_long(j,i)+
752 & wturn6*gcorr6_turn_long(j,i))+
754 & wcorr*gradcorr(j,i)+
755 & wturn3*gcorr3_turn(j,i)+
756 & wturn4*gcorr4_turn(j,i)+
757 & wcorr5*gradcorr5(j,i)+
758 & wcorr6*gradcorr6(j,i)+
759 & wturn6*gcorr6_turn(j,i)+
760 & wsccor*gsccorc(j,i)
761 & +wscloc*gscloc(j,i)
764 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
765 & wscp*gradx_scp(j,i)+
767 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
768 & wsccor*gsccorx(j,i)
769 & +wscloc*gsclocx(j,i)
771 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
773 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
774 & wsccor*gsccorx(j,i)
775 & +wscloc*gsclocx(j,i)
780 write (iout,*) "gloc before adding corr"
782 write (iout,*) i,gloc(i,icg)
786 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
787 & +wcorr5*g_corr5_loc(i)
788 & +wcorr6*g_corr6_loc(i)
789 & +wturn4*gel_loc_turn4(i)
790 & +wturn3*gel_loc_turn3(i)
791 & +wturn6*gel_loc_turn6(i)
792 & +wel_loc*gel_loc_loc(i)
793 & +wsccor*gsccor_loc(i)
796 write (iout,*) "gloc after adding corr"
798 write (iout,*) i,gloc(i,icg)
802 if (nfgtasks.gt.1) then
805 gradbufc(j,i)=gradc(j,i,icg)
806 gradbufx(j,i)=gradx(j,i,icg)
810 glocbuf(i)=gloc(i,icg)
813 write (iout,*) "gloc_sc before reduce"
816 write (iout,*) i,j,gloc_sc(j,i,icg)
822 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
826 call MPI_Barrier(FG_COMM,IERR)
827 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
829 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
830 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
831 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
832 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
833 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
834 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
835 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
836 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
837 time_reduce=time_reduce+MPI_Wtime()-time00
839 write (iout,*) "gloc_sc after reduce"
842 write (iout,*) i,j,gloc_sc(j,i,icg)
847 write (iout,*) "gloc after reduce"
849 write (iout,*) i,gloc(i,icg)
854 if (gnorm_check) then
856 c Compute the maximum elements of the gradient
866 gcorr3_turn_max=0.0d0
867 gcorr4_turn_max=0.0d0
870 gcorr6_turn_max=0.0d0
880 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
881 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
883 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
884 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
886 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
887 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
888 & gvdwc_scp_max=gvdwc_scp_norm
889 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
890 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
891 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
892 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
893 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
894 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
895 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
896 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
897 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
898 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
899 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
900 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
901 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
903 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
904 & gcorr3_turn_max=gcorr3_turn_norm
905 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
907 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
908 & gcorr4_turn_max=gcorr4_turn_norm
909 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
910 if (gradcorr5_norm.gt.gradcorr5_max)
911 & gradcorr5_max=gradcorr5_norm
912 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
913 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
914 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
916 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
917 & gcorr6_turn_max=gcorr6_turn_norm
918 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
919 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
920 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
921 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
922 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
923 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
925 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
926 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
928 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
929 if (gradx_scp_norm.gt.gradx_scp_max)
930 & gradx_scp_max=gradx_scp_norm
931 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
932 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
933 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
934 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
935 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
936 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
937 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
938 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
942 open(istat,file=statname,position="append")
944 open(istat,file=statname,access="append")
946 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
947 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
948 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
949 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
950 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
951 & gsccorx_max,gsclocx_max
953 if (gvdwc_max.gt.1.0d4) then
954 write (iout,*) "gvdwc gvdwx gradb gradbx"
956 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
957 & gradb(j,i),gradbx(j,i),j=1,3)
959 call pdbout(0.0d0,'cipiszcze',iout)
965 write (iout,*) "gradc gradx gloc"
967 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
968 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
973 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
975 time_sumgradient=time_sumgradient+tcpu()-time01
980 c-------------------------------------------------------------------------------
981 subroutine rescale_weights(t_bath)
982 implicit real*8 (a-h,o-z)
984 include 'COMMON.IOUNITS'
985 include 'COMMON.FFIELD'
986 include 'COMMON.SBRIDGE'
987 double precision kfac /2.4d0/
988 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
990 c facT=2*temp0/(t_bath+temp0)
991 if (rescale_mode.eq.0) then
997 else if (rescale_mode.eq.1) then
998 facT=kfac/(kfac-1.0d0+t_bath/temp0)
999 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1000 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1001 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1002 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1003 else if (rescale_mode.eq.2) then
1009 facT=licznik/dlog(dexp(x)+dexp(-x))
1010 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1011 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1012 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1013 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1015 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1016 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1018 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1022 welec=weights(3)*fact
1023 wcorr=weights(4)*fact3
1024 wcorr5=weights(5)*fact4
1025 wcorr6=weights(6)*fact5
1026 wel_loc=weights(7)*fact2
1027 wturn3=weights(8)*fact2
1028 wturn4=weights(9)*fact3
1029 wturn6=weights(10)*fact5
1030 wtor=weights(13)*fact
1031 wtor_d=weights(14)*fact2
1032 wsccor=weights(21)*fact
1035 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1039 C------------------------------------------------------------------------
1040 subroutine enerprint(energia)
1041 implicit real*8 (a-h,o-z)
1042 include 'DIMENSIONS'
1043 include 'COMMON.IOUNITS'
1044 include 'COMMON.FFIELD'
1045 include 'COMMON.SBRIDGE'
1047 double precision energia(0:n_ene)
1050 evdw=energia(22)+wsct*energia(23)
1056 evdw2=energia(2)+energia(18)
1068 eello_turn3=energia(8)
1069 eello_turn4=energia(9)
1070 eello_turn6=energia(10)
1076 edihcnstr=energia(19)
1081 edfadis = energia(24)
1082 edfator = energia(25)
1083 edfanei = energia(26)
1084 edfabet = energia(27)
1086 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1087 & estr,wbond,ebe,wang,
1088 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1090 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1091 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1092 & edihcnstr,ebr*nss,
1093 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1094 10 format (/'Virtual-chain energies:'//
1095 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1096 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1097 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1098 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1099 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1100 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1101 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1102 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1103 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1104 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1105 & ' (SS bridges & dist. cnstr.)'/
1106 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1107 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1108 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1109 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1110 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1111 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1112 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1113 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1114 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1115 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1116 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1117 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1118 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1119 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1120 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1121 & 'ETOT= ',1pE16.6,' (total)')
1123 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1124 & estr,wbond,ebe,wang,
1125 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1127 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1128 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1130 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1131 10 format (/'Virtual-chain energies:'//
1132 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1133 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1134 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1135 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1136 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1137 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1138 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1139 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1140 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1141 & ' (SS bridges & dist. cnstr.)'/
1142 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1143 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1144 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1145 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1146 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1147 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1148 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1149 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1150 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1151 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1152 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1153 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1154 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1155 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1156 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1157 & 'ETOT= ',1pE16.6,' (total)')
1161 C-----------------------------------------------------------------------
1162 subroutine elj(evdw,evdw_p,evdw_m)
1164 C This subroutine calculates the interaction energy of nonbonded side chains
1165 C assuming the LJ potential of interaction.
1167 implicit real*8 (a-h,o-z)
1168 include 'DIMENSIONS'
1169 parameter (accur=1.0d-10)
1170 include 'COMMON.GEO'
1171 include 'COMMON.VAR'
1172 include 'COMMON.LOCAL'
1173 include 'COMMON.CHAIN'
1174 include 'COMMON.DERIV'
1175 include 'COMMON.INTERACT'
1176 include 'COMMON.TORSION'
1177 include 'COMMON.SBRIDGE'
1178 include 'COMMON.NAMES'
1179 include 'COMMON.IOUNITS'
1180 include 'COMMON.CONTACTS'
1182 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1184 do i=iatsc_s,iatsc_e
1193 C Calculate SC interaction energy.
1195 do iint=1,nint_gr(i)
1196 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1197 cd & 'iend=',iend(i,iint)
1198 do j=istart(i,iint),iend(i,iint)
1203 C Change 12/1/95 to calculate four-body interactions
1204 rij=xj*xj+yj*yj+zj*zj
1206 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1207 eps0ij=eps(itypi,itypj)
1209 e1=fac*fac*aa(itypi,itypj)
1210 e2=fac*bb(itypi,itypj)
1212 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1213 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1214 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1215 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1216 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1217 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1219 if (bb(itypi,itypj).gt.0) then
1220 evdw_p=evdw_p+evdwij
1222 evdw_m=evdw_m+evdwij
1228 C Calculate the components of the gradient in DC and X
1230 fac=-rrij*(e1+evdwij)
1235 if (bb(itypi,itypj).gt.0.0d0) then
1237 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1238 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1239 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1240 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1244 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1245 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1246 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1247 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1252 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1253 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1254 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1255 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1260 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1264 C 12/1/95, revised on 5/20/97
1266 C Calculate the contact function. The ith column of the array JCONT will
1267 C contain the numbers of atoms that make contacts with the atom I (of numbers
1268 C greater than I). The arrays FACONT and GACONT will contain the values of
1269 C the contact function and its derivative.
1271 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1272 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1273 C Uncomment next line, if the correlation interactions are contact function only
1274 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1276 sigij=sigma(itypi,itypj)
1277 r0ij=rs0(itypi,itypj)
1279 C Check whether the SC's are not too far to make a contact.
1282 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1283 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1285 if (fcont.gt.0.0D0) then
1286 C If the SC-SC distance if close to sigma, apply spline.
1287 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1288 cAdam & fcont1,fprimcont1)
1289 cAdam fcont1=1.0d0-fcont1
1290 cAdam if (fcont1.gt.0.0d0) then
1291 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1292 cAdam fcont=fcont*fcont1
1294 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1295 cga eps0ij=1.0d0/dsqrt(eps0ij)
1297 cga gg(k)=gg(k)*eps0ij
1299 cga eps0ij=-evdwij*eps0ij
1300 C Uncomment for AL's type of SC correlation interactions.
1301 cadam eps0ij=-evdwij
1302 num_conti=num_conti+1
1303 jcont(num_conti,i)=j
1304 facont(num_conti,i)=fcont*eps0ij
1305 fprimcont=eps0ij*fprimcont/rij
1307 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1308 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1309 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1310 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1311 gacont(1,num_conti,i)=-fprimcont*xj
1312 gacont(2,num_conti,i)=-fprimcont*yj
1313 gacont(3,num_conti,i)=-fprimcont*zj
1314 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1315 cd write (iout,'(2i3,3f10.5)')
1316 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1322 num_cont(i)=num_conti
1326 gvdwc(j,i)=expon*gvdwc(j,i)
1327 gvdwx(j,i)=expon*gvdwx(j,i)
1330 C******************************************************************************
1334 C To save time, the factor of EXPON has been extracted from ALL components
1335 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1338 C******************************************************************************
1341 C-----------------------------------------------------------------------------
1342 subroutine eljk(evdw,evdw_p,evdw_m)
1344 C This subroutine calculates the interaction energy of nonbonded side chains
1345 C assuming the LJK potential of interaction.
1347 implicit real*8 (a-h,o-z)
1348 include 'DIMENSIONS'
1349 include 'COMMON.GEO'
1350 include 'COMMON.VAR'
1351 include 'COMMON.LOCAL'
1352 include 'COMMON.CHAIN'
1353 include 'COMMON.DERIV'
1354 include 'COMMON.INTERACT'
1355 include 'COMMON.IOUNITS'
1356 include 'COMMON.NAMES'
1359 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1361 do i=iatsc_s,iatsc_e
1368 C Calculate SC interaction energy.
1370 do iint=1,nint_gr(i)
1371 do j=istart(i,iint),iend(i,iint)
1376 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1377 fac_augm=rrij**expon
1378 e_augm=augm(itypi,itypj)*fac_augm
1379 r_inv_ij=dsqrt(rrij)
1381 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1382 fac=r_shift_inv**expon
1383 e1=fac*fac*aa(itypi,itypj)
1384 e2=fac*bb(itypi,itypj)
1386 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1387 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1388 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1389 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1390 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1391 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1392 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1394 if (bb(itypi,itypj).gt.0) then
1395 evdw_p=evdw_p+evdwij
1397 evdw_m=evdw_m+evdwij
1403 C Calculate the components of the gradient in DC and X
1405 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1410 if (bb(itypi,itypj).gt.0.0d0) then
1412 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1413 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1414 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1415 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1419 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1420 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1421 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1422 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1427 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1428 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1429 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1430 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1435 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1443 gvdwc(j,i)=expon*gvdwc(j,i)
1444 gvdwx(j,i)=expon*gvdwx(j,i)
1449 C-----------------------------------------------------------------------------
1450 subroutine ebp(evdw,evdw_p,evdw_m)
1452 C This subroutine calculates the interaction energy of nonbonded side chains
1453 C assuming the Berne-Pechukas potential of interaction.
1455 implicit real*8 (a-h,o-z)
1456 include 'DIMENSIONS'
1457 include 'COMMON.GEO'
1458 include 'COMMON.VAR'
1459 include 'COMMON.LOCAL'
1460 include 'COMMON.CHAIN'
1461 include 'COMMON.DERIV'
1462 include 'COMMON.NAMES'
1463 include 'COMMON.INTERACT'
1464 include 'COMMON.IOUNITS'
1465 include 'COMMON.CALC'
1466 common /srutu/ icall
1467 c double precision rrsave(maxdim)
1470 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1472 c if (icall.eq.0) then
1478 do i=iatsc_s,iatsc_e
1484 dxi=dc_norm(1,nres+i)
1485 dyi=dc_norm(2,nres+i)
1486 dzi=dc_norm(3,nres+i)
1487 c dsci_inv=dsc_inv(itypi)
1488 dsci_inv=vbld_inv(i+nres)
1490 C Calculate SC interaction energy.
1492 do iint=1,nint_gr(i)
1493 do j=istart(i,iint),iend(i,iint)
1496 c dscj_inv=dsc_inv(itypj)
1497 dscj_inv=vbld_inv(j+nres)
1498 chi1=chi(itypi,itypj)
1499 chi2=chi(itypj,itypi)
1506 alf12=0.5D0*(alf1+alf2)
1507 C For diagnostics only!!!
1520 dxj=dc_norm(1,nres+j)
1521 dyj=dc_norm(2,nres+j)
1522 dzj=dc_norm(3,nres+j)
1523 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1524 cd if (icall.eq.0) then
1530 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1532 C Calculate whole angle-dependent part of epsilon and contributions
1533 C to its derivatives
1534 fac=(rrij*sigsq)**expon2
1535 e1=fac*fac*aa(itypi,itypj)
1536 e2=fac*bb(itypi,itypj)
1537 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1538 eps2der=evdwij*eps3rt
1539 eps3der=evdwij*eps2rt
1540 evdwij=evdwij*eps2rt*eps3rt
1542 if (bb(itypi,itypj).gt.0) then
1543 evdw_p=evdw_p+evdwij
1545 evdw_m=evdw_m+evdwij
1551 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1552 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1553 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1554 cd & restyp(itypi),i,restyp(itypj),j,
1555 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1556 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1557 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1560 C Calculate gradient components.
1561 e1=e1*eps1*eps2rt**2*eps3rt**2
1562 fac=-expon*(e1+evdwij)
1565 C Calculate radial part of the gradient
1569 C Calculate the angular part of the gradient and sum add the contributions
1570 C to the appropriate components of the Cartesian gradient.
1572 if (bb(itypi,itypj).gt.0) then
1586 C-----------------------------------------------------------------------------
1587 subroutine egb(evdw,evdw_p,evdw_m)
1589 C This subroutine calculates the interaction energy of nonbonded side chains
1590 C assuming the Gay-Berne potential of interaction.
1592 implicit real*8 (a-h,o-z)
1593 include 'DIMENSIONS'
1594 include 'COMMON.GEO'
1595 include 'COMMON.VAR'
1596 include 'COMMON.LOCAL'
1597 include 'COMMON.CHAIN'
1598 include 'COMMON.DERIV'
1599 include 'COMMON.NAMES'
1600 include 'COMMON.INTERACT'
1601 include 'COMMON.IOUNITS'
1602 include 'COMMON.CALC'
1603 include 'COMMON.CONTROL'
1606 ccccc energy_dec=.false.
1607 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1612 c if (icall.eq.0) lprn=.false.
1614 do i=iatsc_s,iatsc_e
1620 dxi=dc_norm(1,nres+i)
1621 dyi=dc_norm(2,nres+i)
1622 dzi=dc_norm(3,nres+i)
1623 c dsci_inv=dsc_inv(itypi)
1624 dsci_inv=vbld_inv(i+nres)
1625 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1626 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1628 C Calculate SC interaction energy.
1630 do iint=1,nint_gr(i)
1631 do j=istart(i,iint),iend(i,iint)
1634 c dscj_inv=dsc_inv(itypj)
1635 dscj_inv=vbld_inv(j+nres)
1636 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1637 c & 1.0d0/vbld(j+nres)
1638 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1639 sig0ij=sigma(itypi,itypj)
1640 chi1=chi(itypi,itypj)
1641 chi2=chi(itypj,itypi)
1648 alf12=0.5D0*(alf1+alf2)
1649 C For diagnostics only!!!
1662 dxj=dc_norm(1,nres+j)
1663 dyj=dc_norm(2,nres+j)
1664 dzj=dc_norm(3,nres+j)
1665 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1666 c write (iout,*) "j",j," dc_norm",
1667 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1668 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1670 C Calculate angle-dependent terms of energy and contributions to their
1674 sig=sig0ij*dsqrt(sigsq)
1675 rij_shift=1.0D0/rij-sig+sig0ij
1676 c for diagnostics; uncomment
1677 c rij_shift=1.2*sig0ij
1678 C I hate to put IF's in the loops, but here don't have another choice!!!!
1679 if (rij_shift.le.0.0D0) then
1681 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1682 cd & restyp(itypi),i,restyp(itypj),j,
1683 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1687 c---------------------------------------------------------------
1688 rij_shift=1.0D0/rij_shift
1689 fac=rij_shift**expon
1690 e1=fac*fac*aa(itypi,itypj)
1691 e2=fac*bb(itypi,itypj)
1692 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1693 eps2der=evdwij*eps3rt
1694 eps3der=evdwij*eps2rt
1695 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1696 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1697 evdwij=evdwij*eps2rt*eps3rt
1699 if (bb(itypi,itypj).gt.0) then
1700 evdw_p=evdw_p+evdwij
1702 evdw_m=evdw_m+evdwij
1708 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1709 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1710 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1711 & restyp(itypi),i,restyp(itypj),j,
1712 & epsi,sigm,chi1,chi2,chip1,chip2,
1713 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1714 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1718 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1721 C Calculate gradient components.
1722 e1=e1*eps1*eps2rt**2*eps3rt**2
1723 fac=-expon*(e1+evdwij)*rij_shift
1727 C Calculate the radial part of the gradient
1731 C Calculate angular part of the gradient.
1733 if (bb(itypi,itypj).gt.0) then
1744 c write (iout,*) "Number of loop steps in EGB:",ind
1745 cccc energy_dec=.false.
1748 C-----------------------------------------------------------------------------
1749 subroutine egbv(evdw,evdw_p,evdw_m)
1751 C This subroutine calculates the interaction energy of nonbonded side chains
1752 C assuming the Gay-Berne-Vorobjev potential of interaction.
1754 implicit real*8 (a-h,o-z)
1755 include 'DIMENSIONS'
1756 include 'COMMON.GEO'
1757 include 'COMMON.VAR'
1758 include 'COMMON.LOCAL'
1759 include 'COMMON.CHAIN'
1760 include 'COMMON.DERIV'
1761 include 'COMMON.NAMES'
1762 include 'COMMON.INTERACT'
1763 include 'COMMON.IOUNITS'
1764 include 'COMMON.CALC'
1765 common /srutu/ icall
1768 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1771 c if (icall.eq.0) lprn=.true.
1773 do i=iatsc_s,iatsc_e
1779 dxi=dc_norm(1,nres+i)
1780 dyi=dc_norm(2,nres+i)
1781 dzi=dc_norm(3,nres+i)
1782 c dsci_inv=dsc_inv(itypi)
1783 dsci_inv=vbld_inv(i+nres)
1785 C Calculate SC interaction energy.
1787 do iint=1,nint_gr(i)
1788 do j=istart(i,iint),iend(i,iint)
1791 c dscj_inv=dsc_inv(itypj)
1792 dscj_inv=vbld_inv(j+nres)
1793 sig0ij=sigma(itypi,itypj)
1794 r0ij=r0(itypi,itypj)
1795 chi1=chi(itypi,itypj)
1796 chi2=chi(itypj,itypi)
1803 alf12=0.5D0*(alf1+alf2)
1804 C For diagnostics only!!!
1817 dxj=dc_norm(1,nres+j)
1818 dyj=dc_norm(2,nres+j)
1819 dzj=dc_norm(3,nres+j)
1820 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1822 C Calculate angle-dependent terms of energy and contributions to their
1826 sig=sig0ij*dsqrt(sigsq)
1827 rij_shift=1.0D0/rij-sig+r0ij
1828 C I hate to put IF's in the loops, but here don't have another choice!!!!
1829 if (rij_shift.le.0.0D0) then
1834 c---------------------------------------------------------------
1835 rij_shift=1.0D0/rij_shift
1836 fac=rij_shift**expon
1837 e1=fac*fac*aa(itypi,itypj)
1838 e2=fac*bb(itypi,itypj)
1839 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1840 eps2der=evdwij*eps3rt
1841 eps3der=evdwij*eps2rt
1842 fac_augm=rrij**expon
1843 e_augm=augm(itypi,itypj)*fac_augm
1844 evdwij=evdwij*eps2rt*eps3rt
1846 if (bb(itypi,itypj).gt.0) then
1847 evdw_p=evdw_p+evdwij+e_augm
1849 evdw_m=evdw_m+evdwij+e_augm
1852 evdw=evdw+evdwij+e_augm
1855 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1856 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1857 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1858 & restyp(itypi),i,restyp(itypj),j,
1859 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1860 & chi1,chi2,chip1,chip2,
1861 & eps1,eps2rt**2,eps3rt**2,
1862 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1865 C Calculate gradient components.
1866 e1=e1*eps1*eps2rt**2*eps3rt**2
1867 fac=-expon*(e1+evdwij)*rij_shift
1869 fac=rij*fac-2*expon*rrij*e_augm
1870 C Calculate the radial part of the gradient
1874 C Calculate angular part of the gradient.
1876 if (bb(itypi,itypj).gt.0) then
1888 C-----------------------------------------------------------------------------
1889 subroutine sc_angular
1890 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1891 C om12. Called by ebp, egb, and egbv.
1893 include 'COMMON.CALC'
1894 include 'COMMON.IOUNITS'
1898 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1899 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1900 om12=dxi*dxj+dyi*dyj+dzi*dzj
1902 C Calculate eps1(om12) and its derivative in om12
1903 faceps1=1.0D0-om12*chiom12
1904 faceps1_inv=1.0D0/faceps1
1905 eps1=dsqrt(faceps1_inv)
1906 C Following variable is eps1*deps1/dom12
1907 eps1_om12=faceps1_inv*chiom12
1912 c write (iout,*) "om12",om12," eps1",eps1
1913 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1918 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1919 sigsq=1.0D0-facsig*faceps1_inv
1920 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1921 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1922 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1928 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1929 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1931 C Calculate eps2 and its derivatives in om1, om2, and om12.
1934 chipom12=chip12*om12
1935 facp=1.0D0-om12*chipom12
1937 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1938 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1939 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1940 C Following variable is the square root of eps2
1941 eps2rt=1.0D0-facp1*facp_inv
1942 C Following three variables are the derivatives of the square root of eps
1943 C in om1, om2, and om12.
1944 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1945 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1946 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1947 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1948 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1949 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1950 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1951 c & " eps2rt_om12",eps2rt_om12
1952 C Calculate whole angle-dependent part of epsilon and contributions
1953 C to its derivatives
1957 C----------------------------------------------------------------------------
1958 subroutine sc_grad_T
1959 implicit real*8 (a-h,o-z)
1960 include 'DIMENSIONS'
1961 include 'COMMON.CHAIN'
1962 include 'COMMON.DERIV'
1963 include 'COMMON.CALC'
1964 include 'COMMON.IOUNITS'
1965 double precision dcosom1(3),dcosom2(3)
1966 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1967 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1968 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1969 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1973 c eom12=evdwij*eps1_om12
1975 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1976 c & " sigder",sigder
1977 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1978 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1980 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1981 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1984 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1986 c write (iout,*) "gg",(gg(k),k=1,3)
1988 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1989 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1990 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1991 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1992 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1993 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1994 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1995 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1996 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1997 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2000 C Calculate the components of the gradient in DC and X
2004 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2008 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2009 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2014 C----------------------------------------------------------------------------
2016 implicit real*8 (a-h,o-z)
2017 include 'DIMENSIONS'
2018 include 'COMMON.CHAIN'
2019 include 'COMMON.DERIV'
2020 include 'COMMON.CALC'
2021 include 'COMMON.IOUNITS'
2022 double precision dcosom1(3),dcosom2(3)
2023 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2024 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2025 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2026 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2030 c eom12=evdwij*eps1_om12
2032 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2033 c & " sigder",sigder
2034 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2035 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2037 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2038 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2041 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2043 c write (iout,*) "gg",(gg(k),k=1,3)
2045 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2046 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2047 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2048 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2049 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2050 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2051 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2052 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2053 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2054 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2057 C Calculate the components of the gradient in DC and X
2061 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2065 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2066 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2070 C-----------------------------------------------------------------------
2071 subroutine e_softsphere(evdw)
2073 C This subroutine calculates the interaction energy of nonbonded side chains
2074 C assuming the LJ potential of interaction.
2076 implicit real*8 (a-h,o-z)
2077 include 'DIMENSIONS'
2078 parameter (accur=1.0d-10)
2079 include 'COMMON.GEO'
2080 include 'COMMON.VAR'
2081 include 'COMMON.LOCAL'
2082 include 'COMMON.CHAIN'
2083 include 'COMMON.DERIV'
2084 include 'COMMON.INTERACT'
2085 include 'COMMON.TORSION'
2086 include 'COMMON.SBRIDGE'
2087 include 'COMMON.NAMES'
2088 include 'COMMON.IOUNITS'
2089 include 'COMMON.CONTACTS'
2091 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2093 do i=iatsc_s,iatsc_e
2100 C Calculate SC interaction energy.
2102 do iint=1,nint_gr(i)
2103 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2104 cd & 'iend=',iend(i,iint)
2105 do j=istart(i,iint),iend(i,iint)
2110 rij=xj*xj+yj*yj+zj*zj
2111 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2112 r0ij=r0(itypi,itypj)
2114 c print *,i,j,r0ij,dsqrt(rij)
2115 if (rij.lt.r0ijsq) then
2116 evdwij=0.25d0*(rij-r0ijsq)**2
2124 C Calculate the components of the gradient in DC and X
2130 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2131 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2132 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2133 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2137 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2145 C--------------------------------------------------------------------------
2146 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2149 C Soft-sphere potential of p-p interaction
2151 implicit real*8 (a-h,o-z)
2152 include 'DIMENSIONS'
2153 include 'COMMON.CONTROL'
2154 include 'COMMON.IOUNITS'
2155 include 'COMMON.GEO'
2156 include 'COMMON.VAR'
2157 include 'COMMON.LOCAL'
2158 include 'COMMON.CHAIN'
2159 include 'COMMON.DERIV'
2160 include 'COMMON.INTERACT'
2161 include 'COMMON.CONTACTS'
2162 include 'COMMON.TORSION'
2163 include 'COMMON.VECTORS'
2164 include 'COMMON.FFIELD'
2166 cd write(iout,*) 'In EELEC_soft_sphere'
2173 do i=iatel_s,iatel_e
2177 xmedi=c(1,i)+0.5d0*dxi
2178 ymedi=c(2,i)+0.5d0*dyi
2179 zmedi=c(3,i)+0.5d0*dzi
2181 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2182 do j=ielstart(i),ielend(i)
2186 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2187 r0ij=rpp(iteli,itelj)
2192 xj=c(1,j)+0.5D0*dxj-xmedi
2193 yj=c(2,j)+0.5D0*dyj-ymedi
2194 zj=c(3,j)+0.5D0*dzj-zmedi
2195 rij=xj*xj+yj*yj+zj*zj
2196 if (rij.lt.r0ijsq) then
2197 evdw1ij=0.25d0*(rij-r0ijsq)**2
2205 C Calculate contributions to the Cartesian gradient.
2211 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2212 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2215 * Loop over residues i+1 thru j-1.
2219 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2224 cgrad do i=nnt,nct-1
2226 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2228 cgrad do j=i+1,nct-1
2230 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2236 c------------------------------------------------------------------------------
2237 subroutine vec_and_deriv
2238 implicit real*8 (a-h,o-z)
2239 include 'DIMENSIONS'
2243 include 'COMMON.IOUNITS'
2244 include 'COMMON.GEO'
2245 include 'COMMON.VAR'
2246 include 'COMMON.LOCAL'
2247 include 'COMMON.CHAIN'
2248 include 'COMMON.VECTORS'
2249 include 'COMMON.SETUP'
2250 include 'COMMON.TIME1'
2251 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2252 C Compute the local reference systems. For reference system (i), the
2253 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2254 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2256 do i=ivec_start,ivec_end
2260 if (i.eq.nres-1) then
2261 C Case of the last full residue
2262 C Compute the Z-axis
2263 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2264 costh=dcos(pi-theta(nres))
2265 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2269 C Compute the derivatives of uz
2271 uzder(2,1,1)=-dc_norm(3,i-1)
2272 uzder(3,1,1)= dc_norm(2,i-1)
2273 uzder(1,2,1)= dc_norm(3,i-1)
2275 uzder(3,2,1)=-dc_norm(1,i-1)
2276 uzder(1,3,1)=-dc_norm(2,i-1)
2277 uzder(2,3,1)= dc_norm(1,i-1)
2280 uzder(2,1,2)= dc_norm(3,i)
2281 uzder(3,1,2)=-dc_norm(2,i)
2282 uzder(1,2,2)=-dc_norm(3,i)
2284 uzder(3,2,2)= dc_norm(1,i)
2285 uzder(1,3,2)= dc_norm(2,i)
2286 uzder(2,3,2)=-dc_norm(1,i)
2288 C Compute the Y-axis
2291 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2293 C Compute the derivatives of uy
2296 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2297 & -dc_norm(k,i)*dc_norm(j,i-1)
2298 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2300 uyder(j,j,1)=uyder(j,j,1)-costh
2301 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2306 uygrad(l,k,j,i)=uyder(l,k,j)
2307 uzgrad(l,k,j,i)=uzder(l,k,j)
2311 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2312 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2313 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2314 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2317 C Compute the Z-axis
2318 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2319 costh=dcos(pi-theta(i+2))
2320 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2324 C Compute the derivatives of uz
2326 uzder(2,1,1)=-dc_norm(3,i+1)
2327 uzder(3,1,1)= dc_norm(2,i+1)
2328 uzder(1,2,1)= dc_norm(3,i+1)
2330 uzder(3,2,1)=-dc_norm(1,i+1)
2331 uzder(1,3,1)=-dc_norm(2,i+1)
2332 uzder(2,3,1)= dc_norm(1,i+1)
2335 uzder(2,1,2)= dc_norm(3,i)
2336 uzder(3,1,2)=-dc_norm(2,i)
2337 uzder(1,2,2)=-dc_norm(3,i)
2339 uzder(3,2,2)= dc_norm(1,i)
2340 uzder(1,3,2)= dc_norm(2,i)
2341 uzder(2,3,2)=-dc_norm(1,i)
2343 C Compute the Y-axis
2346 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2348 C Compute the derivatives of uy
2351 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2352 & -dc_norm(k,i)*dc_norm(j,i+1)
2353 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2355 uyder(j,j,1)=uyder(j,j,1)-costh
2356 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2361 uygrad(l,k,j,i)=uyder(l,k,j)
2362 uzgrad(l,k,j,i)=uzder(l,k,j)
2366 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2367 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2368 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2369 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2373 vbld_inv_temp(1)=vbld_inv(i+1)
2374 if (i.lt.nres-1) then
2375 vbld_inv_temp(2)=vbld_inv(i+2)
2377 vbld_inv_temp(2)=vbld_inv(i)
2382 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2383 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2388 #if defined(PARVEC) && defined(MPI)
2389 if (nfgtasks1.gt.1) then
2391 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2392 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2393 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2394 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2395 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2397 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2398 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2400 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2401 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2402 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2403 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2404 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2405 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2406 time_gather=time_gather+MPI_Wtime()-time00
2408 c if (fg_rank.eq.0) then
2409 c write (iout,*) "Arrays UY and UZ"
2411 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2418 C-----------------------------------------------------------------------------
2419 subroutine check_vecgrad
2420 implicit real*8 (a-h,o-z)
2421 include 'DIMENSIONS'
2422 include 'COMMON.IOUNITS'
2423 include 'COMMON.GEO'
2424 include 'COMMON.VAR'
2425 include 'COMMON.LOCAL'
2426 include 'COMMON.CHAIN'
2427 include 'COMMON.VECTORS'
2428 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2429 dimension uyt(3,maxres),uzt(3,maxres)
2430 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2431 double precision delta /1.0d-7/
2434 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2435 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2436 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2437 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2438 cd & (dc_norm(if90,i),if90=1,3)
2439 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2440 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2441 cd write(iout,'(a)')
2447 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2448 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2461 cd write (iout,*) 'i=',i
2463 erij(k)=dc_norm(k,i)
2467 dc_norm(k,i)=erij(k)
2469 dc_norm(j,i)=dc_norm(j,i)+delta
2470 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2472 c dc_norm(k,i)=dc_norm(k,i)/fac
2474 c write (iout,*) (dc_norm(k,i),k=1,3)
2475 c write (iout,*) (erij(k),k=1,3)
2478 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2479 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2480 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2481 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2483 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2484 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2485 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2488 dc_norm(k,i)=erij(k)
2491 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2492 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2493 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2494 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2495 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2496 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2497 cd write (iout,'(a)')
2502 C--------------------------------------------------------------------------
2503 subroutine set_matrices
2504 implicit real*8 (a-h,o-z)
2505 include 'DIMENSIONS'
2508 include "COMMON.SETUP"
2510 integer status(MPI_STATUS_SIZE)
2512 include 'COMMON.IOUNITS'
2513 include 'COMMON.GEO'
2514 include 'COMMON.VAR'
2515 include 'COMMON.LOCAL'
2516 include 'COMMON.CHAIN'
2517 include 'COMMON.DERIV'
2518 include 'COMMON.INTERACT'
2519 include 'COMMON.CONTACTS'
2520 include 'COMMON.TORSION'
2521 include 'COMMON.VECTORS'
2522 include 'COMMON.FFIELD'
2523 double precision auxvec(2),auxmat(2,2)
2525 C Compute the virtual-bond-torsional-angle dependent quantities needed
2526 C to calculate the el-loc multibody terms of various order.
2529 do i=ivec_start+2,ivec_end+2
2533 if (i .lt. nres+1) then
2570 if (i .gt. 3 .and. i .lt. nres+1) then
2571 obrot_der(1,i-2)=-sin1
2572 obrot_der(2,i-2)= cos1
2573 Ugder(1,1,i-2)= sin1
2574 Ugder(1,2,i-2)=-cos1
2575 Ugder(2,1,i-2)=-cos1
2576 Ugder(2,2,i-2)=-sin1
2579 obrot2_der(1,i-2)=-dwasin2
2580 obrot2_der(2,i-2)= dwacos2
2581 Ug2der(1,1,i-2)= dwasin2
2582 Ug2der(1,2,i-2)=-dwacos2
2583 Ug2der(2,1,i-2)=-dwacos2
2584 Ug2der(2,2,i-2)=-dwasin2
2586 obrot_der(1,i-2)=0.0d0
2587 obrot_der(2,i-2)=0.0d0
2588 Ugder(1,1,i-2)=0.0d0
2589 Ugder(1,2,i-2)=0.0d0
2590 Ugder(2,1,i-2)=0.0d0
2591 Ugder(2,2,i-2)=0.0d0
2592 obrot2_der(1,i-2)=0.0d0
2593 obrot2_der(2,i-2)=0.0d0
2594 Ug2der(1,1,i-2)=0.0d0
2595 Ug2der(1,2,i-2)=0.0d0
2596 Ug2der(2,1,i-2)=0.0d0
2597 Ug2der(2,2,i-2)=0.0d0
2599 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2600 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2601 iti = itortyp(itype(i-2))
2605 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2606 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2607 iti1 = itortyp(itype(i-1))
2611 cd write (iout,*) '*******i',i,' iti1',iti
2612 cd write (iout,*) 'b1',b1(:,iti)
2613 cd write (iout,*) 'b2',b2(:,iti)
2614 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2615 c if (i .gt. iatel_s+2) then
2616 if (i .gt. nnt+2) then
2617 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2618 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2619 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2621 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2622 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2623 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2624 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2625 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2636 DtUg2(l,k,i-2)=0.0d0
2640 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2641 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2643 muder(k,i-2)=Ub2der(k,i-2)
2645 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2646 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2647 iti1 = itortyp(itype(i-1))
2652 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2654 cd write (iout,*) 'mu ',mu(:,i-2)
2655 cd write (iout,*) 'mu1',mu1(:,i-2)
2656 cd write (iout,*) 'mu2',mu2(:,i-2)
2657 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2659 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2660 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2661 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2662 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2663 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2664 C Vectors and matrices dependent on a single virtual-bond dihedral.
2665 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2666 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2667 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2668 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2669 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2670 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2671 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2672 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2673 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2676 C Matrices dependent on two consecutive virtual-bond dihedrals.
2677 C The order of matrices is from left to right.
2678 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2680 c do i=max0(ivec_start,2),ivec_end
2682 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2683 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2684 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2685 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2686 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2687 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2688 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2689 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2692 #if defined(MPI) && defined(PARMAT)
2694 c if (fg_rank.eq.0) then
2695 write (iout,*) "Arrays UG and UGDER before GATHER"
2697 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2698 & ((ug(l,k,i),l=1,2),k=1,2),
2699 & ((ugder(l,k,i),l=1,2),k=1,2)
2701 write (iout,*) "Arrays UG2 and UG2DER"
2703 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2704 & ((ug2(l,k,i),l=1,2),k=1,2),
2705 & ((ug2der(l,k,i),l=1,2),k=1,2)
2707 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2709 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2710 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2711 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2713 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2715 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2716 & costab(i),sintab(i),costab2(i),sintab2(i)
2718 write (iout,*) "Array MUDER"
2720 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2724 if (nfgtasks.gt.1) then
2726 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2727 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2728 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2730 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2731 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2733 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2734 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2740 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2742 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2745 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2746 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2748 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2749 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2750 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2751 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2752 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2753 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2754 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2755 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2756 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2757 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2758 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2759 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2760 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2762 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2763 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2765 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2766 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2768 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2769 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2771 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2772 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2774 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2775 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2777 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2778 & ivec_count(fg_rank1),
2779 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2781 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2782 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2784 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2785 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2787 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2788 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2790 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2791 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2793 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2794 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2796 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2797 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2799 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2800 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2802 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2803 & ivec_count(fg_rank1),
2804 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2806 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2807 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2809 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2810 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2812 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2816 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2818 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2819 & ivec_count(fg_rank1),
2820 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2822 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2823 & ivec_count(fg_rank1),
2824 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2826 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2827 & ivec_count(fg_rank1),
2828 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2829 & MPI_MAT2,FG_COMM1,IERR)
2830 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2831 & ivec_count(fg_rank1),
2832 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2833 & MPI_MAT2,FG_COMM1,IERR)
2836 c Passes matrix info through the ring
2839 if (irecv.lt.0) irecv=nfgtasks1-1
2842 if (inext.ge.nfgtasks1) inext=0
2844 c write (iout,*) "isend",isend," irecv",irecv
2846 lensend=lentyp(isend)
2847 lenrecv=lentyp(irecv)
2848 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2849 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2850 c & MPI_ROTAT1(lensend),inext,2200+isend,
2851 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2852 c & iprev,2200+irecv,FG_COMM,status,IERR)
2853 c write (iout,*) "Gather ROTAT1"
2855 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2856 c & MPI_ROTAT2(lensend),inext,3300+isend,
2857 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2858 c & iprev,3300+irecv,FG_COMM,status,IERR)
2859 c write (iout,*) "Gather ROTAT2"
2861 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2862 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2863 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2864 & iprev,4400+irecv,FG_COMM,status,IERR)
2865 c write (iout,*) "Gather ROTAT_OLD"
2867 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2868 & MPI_PRECOMP11(lensend),inext,5500+isend,
2869 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2870 & iprev,5500+irecv,FG_COMM,status,IERR)
2871 c write (iout,*) "Gather PRECOMP11"
2873 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2874 & MPI_PRECOMP12(lensend),inext,6600+isend,
2875 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2876 & iprev,6600+irecv,FG_COMM,status,IERR)
2877 c write (iout,*) "Gather PRECOMP12"
2879 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2881 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2882 & MPI_ROTAT2(lensend),inext,7700+isend,
2883 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2884 & iprev,7700+irecv,FG_COMM,status,IERR)
2885 c write (iout,*) "Gather PRECOMP21"
2887 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2888 & MPI_PRECOMP22(lensend),inext,8800+isend,
2889 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2890 & iprev,8800+irecv,FG_COMM,status,IERR)
2891 c write (iout,*) "Gather PRECOMP22"
2893 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2894 & MPI_PRECOMP23(lensend),inext,9900+isend,
2895 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2896 & MPI_PRECOMP23(lenrecv),
2897 & iprev,9900+irecv,FG_COMM,status,IERR)
2898 c write (iout,*) "Gather PRECOMP23"
2903 if (irecv.lt.0) irecv=nfgtasks1-1
2906 time_gather=time_gather+MPI_Wtime()-time00
2909 c if (fg_rank.eq.0) then
2910 write (iout,*) "Arrays UG and UGDER"
2912 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2913 & ((ug(l,k,i),l=1,2),k=1,2),
2914 & ((ugder(l,k,i),l=1,2),k=1,2)
2916 write (iout,*) "Arrays UG2 and UG2DER"
2918 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2919 & ((ug2(l,k,i),l=1,2),k=1,2),
2920 & ((ug2der(l,k,i),l=1,2),k=1,2)
2922 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2924 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2925 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2926 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2928 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2930 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2931 & costab(i),sintab(i),costab2(i),sintab2(i)
2933 write (iout,*) "Array MUDER"
2935 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2941 cd iti = itortyp(itype(i))
2944 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2945 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2950 C--------------------------------------------------------------------------
2951 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2953 C This subroutine calculates the average interaction energy and its gradient
2954 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2955 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2956 C The potential depends both on the distance of peptide-group centers and on
2957 C the orientation of the CA-CA virtual bonds.
2959 implicit real*8 (a-h,o-z)
2963 include 'DIMENSIONS'
2964 include 'COMMON.CONTROL'
2965 include 'COMMON.SETUP'
2966 include 'COMMON.IOUNITS'
2967 include 'COMMON.GEO'
2968 include 'COMMON.VAR'
2969 include 'COMMON.LOCAL'
2970 include 'COMMON.CHAIN'
2971 include 'COMMON.DERIV'
2972 include 'COMMON.INTERACT'
2973 include 'COMMON.CONTACTS'
2974 include 'COMMON.TORSION'
2975 include 'COMMON.VECTORS'
2976 include 'COMMON.FFIELD'
2977 include 'COMMON.TIME1'
2978 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2979 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2980 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2981 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2982 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2983 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2985 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2987 double precision scal_el /1.0d0/
2989 double precision scal_el /0.5d0/
2992 C 13-go grudnia roku pamietnego...
2993 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2994 & 0.0d0,1.0d0,0.0d0,
2995 & 0.0d0,0.0d0,1.0d0/
2996 cd write(iout,*) 'In EELEC'
2998 cd write(iout,*) 'Type',i
2999 cd write(iout,*) 'B1',B1(:,i)
3000 cd write(iout,*) 'B2',B2(:,i)
3001 cd write(iout,*) 'CC',CC(:,:,i)
3002 cd write(iout,*) 'DD',DD(:,:,i)
3003 cd write(iout,*) 'EE',EE(:,:,i)
3005 cd call check_vecgrad
3007 if (icheckgrad.eq.1) then
3009 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3011 dc_norm(k,i)=dc(k,i)*fac
3013 c write (iout,*) 'i',i,' fac',fac
3016 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3017 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3018 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3019 c call vec_and_deriv
3025 time_mat=time_mat+MPI_Wtime()-time01
3029 cd write (iout,*) 'i=',i
3031 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3034 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3035 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3048 cd print '(a)','Enter EELEC'
3049 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3051 gel_loc_loc(i)=0.0d0
3056 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3058 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3060 do i=iturn3_start,iturn3_end
3064 dx_normi=dc_norm(1,i)
3065 dy_normi=dc_norm(2,i)
3066 dz_normi=dc_norm(3,i)
3067 xmedi=c(1,i)+0.5d0*dxi
3068 ymedi=c(2,i)+0.5d0*dyi
3069 zmedi=c(3,i)+0.5d0*dzi
3071 call eelecij(i,i+2,ees,evdw1,eel_loc)
3072 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3073 num_cont_hb(i)=num_conti
3075 do i=iturn4_start,iturn4_end
3079 dx_normi=dc_norm(1,i)
3080 dy_normi=dc_norm(2,i)
3081 dz_normi=dc_norm(3,i)
3082 xmedi=c(1,i)+0.5d0*dxi
3083 ymedi=c(2,i)+0.5d0*dyi
3084 zmedi=c(3,i)+0.5d0*dzi
3085 num_conti=num_cont_hb(i)
3086 call eelecij(i,i+3,ees,evdw1,eel_loc)
3087 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3088 num_cont_hb(i)=num_conti
3091 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3093 do i=iatel_s,iatel_e
3097 dx_normi=dc_norm(1,i)
3098 dy_normi=dc_norm(2,i)
3099 dz_normi=dc_norm(3,i)
3100 xmedi=c(1,i)+0.5d0*dxi
3101 ymedi=c(2,i)+0.5d0*dyi
3102 zmedi=c(3,i)+0.5d0*dzi
3103 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3104 num_conti=num_cont_hb(i)
3105 do j=ielstart(i),ielend(i)
3106 call eelecij(i,j,ees,evdw1,eel_loc)
3108 num_cont_hb(i)=num_conti
3110 c write (iout,*) "Number of loop steps in EELEC:",ind
3112 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3113 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3115 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3116 ccc eel_loc=eel_loc+eello_turn3
3117 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3120 C-------------------------------------------------------------------------------
3121 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3122 implicit real*8 (a-h,o-z)
3123 include 'DIMENSIONS'
3127 include 'COMMON.CONTROL'
3128 include 'COMMON.IOUNITS'
3129 include 'COMMON.GEO'
3130 include 'COMMON.VAR'
3131 include 'COMMON.LOCAL'
3132 include 'COMMON.CHAIN'
3133 include 'COMMON.DERIV'
3134 include 'COMMON.INTERACT'
3135 include 'COMMON.CONTACTS'
3136 include 'COMMON.TORSION'
3137 include 'COMMON.VECTORS'
3138 include 'COMMON.FFIELD'
3139 include 'COMMON.TIME1'
3140 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3141 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3142 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3143 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3144 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3145 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3147 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3149 double precision scal_el /1.0d0/
3151 double precision scal_el /0.5d0/
3154 C 13-go grudnia roku pamietnego...
3155 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3156 & 0.0d0,1.0d0,0.0d0,
3157 & 0.0d0,0.0d0,1.0d0/
3158 c time00=MPI_Wtime()
3159 cd write (iout,*) "eelecij",i,j
3163 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3164 aaa=app(iteli,itelj)
3165 bbb=bpp(iteli,itelj)
3166 ael6i=ael6(iteli,itelj)
3167 ael3i=ael3(iteli,itelj)
3171 dx_normj=dc_norm(1,j)
3172 dy_normj=dc_norm(2,j)
3173 dz_normj=dc_norm(3,j)
3174 xj=c(1,j)+0.5D0*dxj-xmedi
3175 yj=c(2,j)+0.5D0*dyj-ymedi
3176 zj=c(3,j)+0.5D0*dzj-zmedi
3177 rij=xj*xj+yj*yj+zj*zj
3183 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3184 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3185 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3186 fac=cosa-3.0D0*cosb*cosg
3188 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3189 if (j.eq.i+2) ev1=scal_el*ev1
3194 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3197 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3198 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3201 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3202 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3203 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3204 cd & xmedi,ymedi,zmedi,xj,yj,zj
3206 if (energy_dec) then
3207 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3208 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3212 C Calculate contributions to the Cartesian gradient.
3215 facvdw=-6*rrmij*(ev1+evdwij)
3216 facel=-3*rrmij*(el1+eesij)
3222 * Radial derivatives. First process both termini of the fragment (i,j)
3228 c ghalf=0.5D0*ggg(k)
3229 c gelc(k,i)=gelc(k,i)+ghalf
3230 c gelc(k,j)=gelc(k,j)+ghalf
3232 c 9/28/08 AL Gradient compotents will be summed only at the end
3234 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3235 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3238 * Loop over residues i+1 thru j-1.
3242 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3249 c ghalf=0.5D0*ggg(k)
3250 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3251 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3253 c 9/28/08 AL Gradient compotents will be summed only at the end
3255 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3256 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3259 * Loop over residues i+1 thru j-1.
3263 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3270 fac=-3*rrmij*(facvdw+facvdw+facel)
3275 * Radial derivatives. First process both termini of the fragment (i,j)
3281 c ghalf=0.5D0*ggg(k)
3282 c gelc(k,i)=gelc(k,i)+ghalf
3283 c gelc(k,j)=gelc(k,j)+ghalf
3285 c 9/28/08 AL Gradient compotents will be summed only at the end
3287 gelc_long(k,j)=gelc(k,j)+ggg(k)
3288 gelc_long(k,i)=gelc(k,i)-ggg(k)
3291 * Loop over residues i+1 thru j-1.
3295 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3298 c 9/28/08 AL Gradient compotents will be summed only at the end
3303 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3304 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3310 ecosa=2.0D0*fac3*fac1+fac4
3313 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3314 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3316 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3317 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3319 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3320 cd & (dcosg(k),k=1,3)
3322 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3325 c ghalf=0.5D0*ggg(k)
3326 c gelc(k,i)=gelc(k,i)+ghalf
3327 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3328 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3329 c gelc(k,j)=gelc(k,j)+ghalf
3330 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3331 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3335 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3340 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3341 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3343 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3344 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3345 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3346 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3348 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3349 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3350 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3352 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3353 C energy of a peptide unit is assumed in the form of a second-order
3354 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3355 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3356 C are computed for EVERY pair of non-contiguous peptide groups.
3358 if (j.lt.nres-1) then
3369 muij(kkk)=mu(k,i)*mu(l,j)
3372 cd write (iout,*) 'EELEC: i',i,' j',j
3373 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3374 cd write(iout,*) 'muij',muij
3375 ury=scalar(uy(1,i),erij)
3376 urz=scalar(uz(1,i),erij)
3377 vry=scalar(uy(1,j),erij)
3378 vrz=scalar(uz(1,j),erij)
3379 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3380 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3381 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3382 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3383 fac=dsqrt(-ael6i)*r3ij
3388 cd write (iout,'(4i5,4f10.5)')
3389 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3390 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3391 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3392 cd & uy(:,j),uz(:,j)
3393 cd write (iout,'(4f10.5)')
3394 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3395 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3396 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3397 cd write (iout,'(9f10.5/)')
3398 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3399 C Derivatives of the elements of A in virtual-bond vectors
3400 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3402 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3403 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3404 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3405 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3406 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3407 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3408 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3409 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3410 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3411 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3412 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3413 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3415 C Compute radial contributions to the gradient
3433 C Add the contributions coming from er
3436 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3437 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3438 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3439 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3442 C Derivatives in DC(i)
3443 cgrad ghalf1=0.5d0*agg(k,1)
3444 cgrad ghalf2=0.5d0*agg(k,2)
3445 cgrad ghalf3=0.5d0*agg(k,3)
3446 cgrad ghalf4=0.5d0*agg(k,4)
3447 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3448 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3449 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3450 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3451 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3452 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3453 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3454 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3455 C Derivatives in DC(i+1)
3456 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3457 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3458 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3459 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3460 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3461 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3462 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3463 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3464 C Derivatives in DC(j)
3465 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3466 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3467 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3468 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3469 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3470 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3471 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3472 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3473 C Derivatives in DC(j+1) or DC(nres-1)
3474 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3475 & -3.0d0*vryg(k,3)*ury)
3476 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3477 & -3.0d0*vrzg(k,3)*ury)
3478 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3479 & -3.0d0*vryg(k,3)*urz)
3480 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3481 & -3.0d0*vrzg(k,3)*urz)
3482 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3484 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3497 aggi(k,l)=-aggi(k,l)
3498 aggi1(k,l)=-aggi1(k,l)
3499 aggj(k,l)=-aggj(k,l)
3500 aggj1(k,l)=-aggj1(k,l)
3503 if (j.lt.nres-1) then
3509 aggi(k,l)=-aggi(k,l)
3510 aggi1(k,l)=-aggi1(k,l)
3511 aggj(k,l)=-aggj(k,l)
3512 aggj1(k,l)=-aggj1(k,l)
3523 aggi(k,l)=-aggi(k,l)
3524 aggi1(k,l)=-aggi1(k,l)
3525 aggj(k,l)=-aggj(k,l)
3526 aggj1(k,l)=-aggj1(k,l)
3531 IF (wel_loc.gt.0.0d0) THEN
3532 C Contribution to the local-electrostatic energy coming from the i-j pair
3533 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3535 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3537 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3538 & 'eelloc',i,j,eel_loc_ij
3540 eel_loc=eel_loc+eel_loc_ij
3541 C Partial derivatives in virtual-bond dihedral angles gamma
3543 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3544 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3545 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3546 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3547 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3548 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3549 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3551 ggg(l)=agg(l,1)*muij(1)+
3552 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3553 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3554 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3555 cgrad ghalf=0.5d0*ggg(l)
3556 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3557 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3561 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3564 C Remaining derivatives of eello
3566 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3567 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3568 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3569 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3570 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3571 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3572 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3573 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3576 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3577 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3578 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3579 & .and. num_conti.le.maxconts) then
3580 c write (iout,*) i,j," entered corr"
3582 C Calculate the contact function. The ith column of the array JCONT will
3583 C contain the numbers of atoms that make contacts with the atom I (of numbers
3584 C greater than I). The arrays FACONT and GACONT will contain the values of
3585 C the contact function and its derivative.
3586 c r0ij=1.02D0*rpp(iteli,itelj)
3587 c r0ij=1.11D0*rpp(iteli,itelj)
3588 r0ij=2.20D0*rpp(iteli,itelj)
3589 c r0ij=1.55D0*rpp(iteli,itelj)
3590 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3591 if (fcont.gt.0.0D0) then
3592 num_conti=num_conti+1
3593 if (num_conti.gt.maxconts) then
3594 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3595 & ' will skip next contacts for this conf.'
3597 jcont_hb(num_conti,i)=j
3598 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3599 cd & " jcont_hb",jcont_hb(num_conti,i)
3600 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3601 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3602 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3604 d_cont(num_conti,i)=rij
3605 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3606 C --- Electrostatic-interaction matrix ---
3607 a_chuj(1,1,num_conti,i)=a22
3608 a_chuj(1,2,num_conti,i)=a23
3609 a_chuj(2,1,num_conti,i)=a32
3610 a_chuj(2,2,num_conti,i)=a33
3611 C --- Gradient of rij
3613 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3620 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3621 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3622 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3623 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3624 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3629 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3630 C Calculate contact energies
3632 wij=cosa-3.0D0*cosb*cosg
3635 c fac3=dsqrt(-ael6i)/r0ij**3
3636 fac3=dsqrt(-ael6i)*r3ij
3637 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3638 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3639 if (ees0tmp.gt.0) then
3640 ees0pij=dsqrt(ees0tmp)
3644 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3645 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3646 if (ees0tmp.gt.0) then
3647 ees0mij=dsqrt(ees0tmp)
3652 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3653 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3654 C Diagnostics. Comment out or remove after debugging!
3655 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3656 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3657 c ees0m(num_conti,i)=0.0D0
3659 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3660 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3661 C Angular derivatives of the contact function
3662 ees0pij1=fac3/ees0pij
3663 ees0mij1=fac3/ees0mij
3664 fac3p=-3.0D0*fac3*rrmij
3665 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3666 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3668 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3669 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3670 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3671 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3672 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3673 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3674 ecosap=ecosa1+ecosa2
3675 ecosbp=ecosb1+ecosb2
3676 ecosgp=ecosg1+ecosg2
3677 ecosam=ecosa1-ecosa2
3678 ecosbm=ecosb1-ecosb2
3679 ecosgm=ecosg1-ecosg2
3688 facont_hb(num_conti,i)=fcont
3689 fprimcont=fprimcont/rij
3690 cd facont_hb(num_conti,i)=1.0D0
3691 C Following line is for diagnostics.
3694 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3695 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3698 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3699 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3701 gggp(1)=gggp(1)+ees0pijp*xj
3702 gggp(2)=gggp(2)+ees0pijp*yj
3703 gggp(3)=gggp(3)+ees0pijp*zj
3704 gggm(1)=gggm(1)+ees0mijp*xj
3705 gggm(2)=gggm(2)+ees0mijp*yj
3706 gggm(3)=gggm(3)+ees0mijp*zj
3707 C Derivatives due to the contact function
3708 gacont_hbr(1,num_conti,i)=fprimcont*xj
3709 gacont_hbr(2,num_conti,i)=fprimcont*yj
3710 gacont_hbr(3,num_conti,i)=fprimcont*zj
3713 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3714 c following the change of gradient-summation algorithm.
3716 cgrad ghalfp=0.5D0*gggp(k)
3717 cgrad ghalfm=0.5D0*gggm(k)
3718 gacontp_hb1(k,num_conti,i)=!ghalfp
3719 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3720 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3721 gacontp_hb2(k,num_conti,i)=!ghalfp
3722 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3723 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3724 gacontp_hb3(k,num_conti,i)=gggp(k)
3725 gacontm_hb1(k,num_conti,i)=!ghalfm
3726 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3727 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3728 gacontm_hb2(k,num_conti,i)=!ghalfm
3729 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3730 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3731 gacontm_hb3(k,num_conti,i)=gggm(k)
3733 C Diagnostics. Comment out or remove after debugging!
3735 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3736 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3737 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3738 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3739 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3740 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3743 endif ! num_conti.le.maxconts
3746 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3749 ghalf=0.5d0*agg(l,k)
3750 aggi(l,k)=aggi(l,k)+ghalf
3751 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3752 aggj(l,k)=aggj(l,k)+ghalf
3755 if (j.eq.nres-1 .and. i.lt.j-2) then
3758 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3763 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3766 C-----------------------------------------------------------------------------
3767 subroutine eturn3(i,eello_turn3)
3768 C Third- and fourth-order contributions from turns
3769 implicit real*8 (a-h,o-z)
3770 include 'DIMENSIONS'
3771 include 'COMMON.IOUNITS'
3772 include 'COMMON.GEO'
3773 include 'COMMON.VAR'
3774 include 'COMMON.LOCAL'
3775 include 'COMMON.CHAIN'
3776 include 'COMMON.DERIV'
3777 include 'COMMON.INTERACT'
3778 include 'COMMON.CONTACTS'
3779 include 'COMMON.TORSION'
3780 include 'COMMON.VECTORS'
3781 include 'COMMON.FFIELD'
3782 include 'COMMON.CONTROL'
3784 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3785 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3786 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3787 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3788 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3789 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3790 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3793 c write (iout,*) "eturn3",i,j,j1,j2
3798 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3800 C Third-order contributions
3807 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3808 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3809 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3810 call transpose2(auxmat(1,1),auxmat1(1,1))
3811 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3812 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3813 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3814 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3815 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3816 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3817 cd & ' eello_turn3_num',4*eello_turn3_num
3818 C Derivatives in gamma(i)
3819 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3820 call transpose2(auxmat2(1,1),auxmat3(1,1))
3821 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3822 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3823 C Derivatives in gamma(i+1)
3824 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3825 call transpose2(auxmat2(1,1),auxmat3(1,1))
3826 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3827 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3828 & +0.5d0*(pizda(1,1)+pizda(2,2))
3829 C Cartesian derivatives
3831 c ghalf1=0.5d0*agg(l,1)
3832 c ghalf2=0.5d0*agg(l,2)
3833 c ghalf3=0.5d0*agg(l,3)
3834 c ghalf4=0.5d0*agg(l,4)
3835 a_temp(1,1)=aggi(l,1)!+ghalf1
3836 a_temp(1,2)=aggi(l,2)!+ghalf2
3837 a_temp(2,1)=aggi(l,3)!+ghalf3
3838 a_temp(2,2)=aggi(l,4)!+ghalf4
3839 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3840 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3841 & +0.5d0*(pizda(1,1)+pizda(2,2))
3842 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3843 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3844 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3845 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3846 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3847 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3848 & +0.5d0*(pizda(1,1)+pizda(2,2))
3849 a_temp(1,1)=aggj(l,1)!+ghalf1
3850 a_temp(1,2)=aggj(l,2)!+ghalf2
3851 a_temp(2,1)=aggj(l,3)!+ghalf3
3852 a_temp(2,2)=aggj(l,4)!+ghalf4
3853 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3854 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3855 & +0.5d0*(pizda(1,1)+pizda(2,2))
3856 a_temp(1,1)=aggj1(l,1)
3857 a_temp(1,2)=aggj1(l,2)
3858 a_temp(2,1)=aggj1(l,3)
3859 a_temp(2,2)=aggj1(l,4)
3860 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3861 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3862 & +0.5d0*(pizda(1,1)+pizda(2,2))
3866 C-------------------------------------------------------------------------------
3867 subroutine eturn4(i,eello_turn4)
3868 C Third- and fourth-order contributions from turns
3869 implicit real*8 (a-h,o-z)
3870 include 'DIMENSIONS'
3871 include 'COMMON.IOUNITS'
3872 include 'COMMON.GEO'
3873 include 'COMMON.VAR'
3874 include 'COMMON.LOCAL'
3875 include 'COMMON.CHAIN'
3876 include 'COMMON.DERIV'
3877 include 'COMMON.INTERACT'
3878 include 'COMMON.CONTACTS'
3879 include 'COMMON.TORSION'
3880 include 'COMMON.VECTORS'
3881 include 'COMMON.FFIELD'
3882 include 'COMMON.CONTROL'
3884 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3885 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3886 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3887 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3888 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3889 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3890 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3893 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3895 C Fourth-order contributions
3903 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3904 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3905 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3910 iti1=itortyp(itype(i+1))
3911 iti2=itortyp(itype(i+2))
3912 iti3=itortyp(itype(i+3))
3913 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3914 call transpose2(EUg(1,1,i+1),e1t(1,1))
3915 call transpose2(Eug(1,1,i+2),e2t(1,1))
3916 call transpose2(Eug(1,1,i+3),e3t(1,1))
3917 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3918 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3919 s1=scalar2(b1(1,iti2),auxvec(1))
3920 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3921 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3922 s2=scalar2(b1(1,iti1),auxvec(1))
3923 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3924 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3925 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3926 eello_turn4=eello_turn4-(s1+s2+s3)
3927 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3928 & 'eturn4',i,j,-(s1+s2+s3)
3929 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3930 cd & ' eello_turn4_num',8*eello_turn4_num
3931 C Derivatives in gamma(i)
3932 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3933 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3934 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3935 s1=scalar2(b1(1,iti2),auxvec(1))
3936 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3937 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3938 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3939 C Derivatives in gamma(i+1)
3940 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3941 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3942 s2=scalar2(b1(1,iti1),auxvec(1))
3943 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3944 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3945 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3946 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3947 C Derivatives in gamma(i+2)
3948 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3949 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3950 s1=scalar2(b1(1,iti2),auxvec(1))
3951 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3952 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3953 s2=scalar2(b1(1,iti1),auxvec(1))
3954 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3955 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3956 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3957 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3958 C Cartesian derivatives
3959 C Derivatives of this turn contributions in DC(i+2)
3960 if (j.lt.nres-1) then
3962 a_temp(1,1)=agg(l,1)
3963 a_temp(1,2)=agg(l,2)
3964 a_temp(2,1)=agg(l,3)
3965 a_temp(2,2)=agg(l,4)
3966 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3967 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3968 s1=scalar2(b1(1,iti2),auxvec(1))
3969 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3970 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3971 s2=scalar2(b1(1,iti1),auxvec(1))
3972 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3973 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3974 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3976 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3979 C Remaining derivatives of this turn contribution
3981 a_temp(1,1)=aggi(l,1)
3982 a_temp(1,2)=aggi(l,2)
3983 a_temp(2,1)=aggi(l,3)
3984 a_temp(2,2)=aggi(l,4)
3985 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3986 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3987 s1=scalar2(b1(1,iti2),auxvec(1))
3988 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3989 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3990 s2=scalar2(b1(1,iti1),auxvec(1))
3991 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3992 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3993 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3994 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3995 a_temp(1,1)=aggi1(l,1)
3996 a_temp(1,2)=aggi1(l,2)
3997 a_temp(2,1)=aggi1(l,3)
3998 a_temp(2,2)=aggi1(l,4)
3999 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4000 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4001 s1=scalar2(b1(1,iti2),auxvec(1))
4002 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4003 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4004 s2=scalar2(b1(1,iti1),auxvec(1))
4005 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4006 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4007 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4008 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4009 a_temp(1,1)=aggj(l,1)
4010 a_temp(1,2)=aggj(l,2)
4011 a_temp(2,1)=aggj(l,3)
4012 a_temp(2,2)=aggj(l,4)
4013 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4014 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4015 s1=scalar2(b1(1,iti2),auxvec(1))
4016 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4017 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4018 s2=scalar2(b1(1,iti1),auxvec(1))
4019 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4020 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4021 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4022 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4023 a_temp(1,1)=aggj1(l,1)
4024 a_temp(1,2)=aggj1(l,2)
4025 a_temp(2,1)=aggj1(l,3)
4026 a_temp(2,2)=aggj1(l,4)
4027 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4028 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4029 s1=scalar2(b1(1,iti2),auxvec(1))
4030 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4031 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4032 s2=scalar2(b1(1,iti1),auxvec(1))
4033 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4034 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4035 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4036 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4037 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4041 C-----------------------------------------------------------------------------
4042 subroutine vecpr(u,v,w)
4043 implicit real*8(a-h,o-z)
4044 dimension u(3),v(3),w(3)
4045 w(1)=u(2)*v(3)-u(3)*v(2)
4046 w(2)=-u(1)*v(3)+u(3)*v(1)
4047 w(3)=u(1)*v(2)-u(2)*v(1)
4050 C-----------------------------------------------------------------------------
4051 subroutine unormderiv(u,ugrad,unorm,ungrad)
4052 C This subroutine computes the derivatives of a normalized vector u, given
4053 C the derivatives computed without normalization conditions, ugrad. Returns
4056 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4057 double precision vec(3)
4058 double precision scalar
4060 c write (2,*) 'ugrad',ugrad
4063 vec(i)=scalar(ugrad(1,i),u(1))
4065 c write (2,*) 'vec',vec
4068 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4071 c write (2,*) 'ungrad',ungrad
4074 C-----------------------------------------------------------------------------
4075 subroutine escp_soft_sphere(evdw2,evdw2_14)
4077 C This subroutine calculates the excluded-volume interaction energy between
4078 C peptide-group centers and side chains and its gradient in virtual-bond and
4079 C side-chain vectors.
4081 implicit real*8 (a-h,o-z)
4082 include 'DIMENSIONS'
4083 include 'COMMON.GEO'
4084 include 'COMMON.VAR'
4085 include 'COMMON.LOCAL'
4086 include 'COMMON.CHAIN'
4087 include 'COMMON.DERIV'
4088 include 'COMMON.INTERACT'
4089 include 'COMMON.FFIELD'
4090 include 'COMMON.IOUNITS'
4091 include 'COMMON.CONTROL'
4096 cd print '(a)','Enter ESCP'
4097 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4098 do i=iatscp_s,iatscp_e
4100 xi=0.5D0*(c(1,i)+c(1,i+1))
4101 yi=0.5D0*(c(2,i)+c(2,i+1))
4102 zi=0.5D0*(c(3,i)+c(3,i+1))
4104 do iint=1,nscp_gr(i)
4106 do j=iscpstart(i,iint),iscpend(i,iint)
4108 C Uncomment following three lines for SC-p interactions
4112 C Uncomment following three lines for Ca-p interactions
4116 rij=xj*xj+yj*yj+zj*zj
4119 if (rij.lt.r0ijsq) then
4120 evdwij=0.25d0*(rij-r0ijsq)**2
4128 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4133 cgrad if (j.lt.i) then
4134 cd write (iout,*) 'j<i'
4135 C Uncomment following three lines for SC-p interactions
4137 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4140 cd write (iout,*) 'j>i'
4142 cgrad ggg(k)=-ggg(k)
4143 C Uncomment following line for SC-p interactions
4144 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4148 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4150 cgrad kstart=min0(i+1,j)
4151 cgrad kend=max0(i-1,j-1)
4152 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4153 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4154 cgrad do k=kstart,kend
4156 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4160 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4161 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4169 C-----------------------------------------------------------------------------
4170 subroutine escp(evdw2,evdw2_14)
4172 C This subroutine calculates the excluded-volume interaction energy between
4173 C peptide-group centers and side chains and its gradient in virtual-bond and
4174 C side-chain vectors.
4176 implicit real*8 (a-h,o-z)
4177 include 'DIMENSIONS'
4178 include 'COMMON.GEO'
4179 include 'COMMON.VAR'
4180 include 'COMMON.LOCAL'
4181 include 'COMMON.CHAIN'
4182 include 'COMMON.DERIV'
4183 include 'COMMON.INTERACT'
4184 include 'COMMON.FFIELD'
4185 include 'COMMON.IOUNITS'
4186 include 'COMMON.CONTROL'
4190 cd print '(a)','Enter ESCP'
4191 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4192 do i=iatscp_s,iatscp_e
4194 xi=0.5D0*(c(1,i)+c(1,i+1))
4195 yi=0.5D0*(c(2,i)+c(2,i+1))
4196 zi=0.5D0*(c(3,i)+c(3,i+1))
4198 do iint=1,nscp_gr(i)
4200 do j=iscpstart(i,iint),iscpend(i,iint)
4202 C Uncomment following three lines for SC-p interactions
4206 C Uncomment following three lines for Ca-p interactions
4210 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4212 e1=fac*fac*aad(itypj,iteli)
4213 e2=fac*bad(itypj,iteli)
4214 if (iabs(j-i) .le. 2) then
4217 evdw2_14=evdw2_14+e1+e2
4221 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4222 & 'evdw2',i,j,evdwij
4224 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4226 fac=-(evdwij+e1)*rrij
4230 cgrad if (j.lt.i) then
4231 cd write (iout,*) 'j<i'
4232 C Uncomment following three lines for SC-p interactions
4234 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4237 cd write (iout,*) 'j>i'
4239 cgrad ggg(k)=-ggg(k)
4240 C Uncomment following line for SC-p interactions
4241 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4242 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4246 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4248 cgrad kstart=min0(i+1,j)
4249 cgrad kend=max0(i-1,j-1)
4250 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4251 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4252 cgrad do k=kstart,kend
4254 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4258 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4259 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4267 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4268 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4269 gradx_scp(j,i)=expon*gradx_scp(j,i)
4272 C******************************************************************************
4276 C To save time the factor EXPON has been extracted from ALL components
4277 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4280 C******************************************************************************
4283 C--------------------------------------------------------------------------
4284 subroutine edis(ehpb)
4286 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4288 implicit real*8 (a-h,o-z)
4289 include 'DIMENSIONS'
4290 include 'COMMON.SBRIDGE'
4291 include 'COMMON.CHAIN'
4292 include 'COMMON.DERIV'
4293 include 'COMMON.VAR'
4294 include 'COMMON.INTERACT'
4295 include 'COMMON.IOUNITS'
4298 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4299 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4300 if (link_end.eq.0) return
4301 do i=link_start,link_end
4302 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4303 C CA-CA distance used in regularization of structure.
4306 C iii and jjj point to the residues for which the distance is assigned.
4307 if (ii.gt.nres) then
4314 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4315 c & dhpb(i),dhpb1(i),forcon(i)
4316 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4317 C distance and angle dependent SS bond potential.
4318 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4319 call ssbond_ene(iii,jjj,eij)
4321 cd write (iout,*) "eij",eij
4322 else if (ii.gt.nres .and. jj.gt.nres) then
4323 c Restraints from contact prediction
4325 if (dhpb1(i).gt.0.0d0) then
4326 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4327 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4328 c write (iout,*) "beta nmr",
4329 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4333 C Get the force constant corresponding to this distance.
4335 C Calculate the contribution to energy.
4336 ehpb=ehpb+waga*rdis*rdis
4337 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4339 C Evaluate gradient.
4344 ggg(j)=fac*(c(j,jj)-c(j,ii))
4347 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4348 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4351 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4352 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4355 C Calculate the distance between the two points and its difference from the
4358 if (dhpb1(i).gt.0.0d0) then
4359 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4360 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4361 c write (iout,*) "alph nmr",
4362 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4365 C Get the force constant corresponding to this distance.
4367 C Calculate the contribution to energy.
4368 ehpb=ehpb+waga*rdis*rdis
4369 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4371 C Evaluate gradient.
4375 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4376 cd & ' waga=',waga,' fac=',fac
4378 ggg(j)=fac*(c(j,jj)-c(j,ii))
4380 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4381 C If this is a SC-SC distance, we need to calculate the contributions to the
4382 C Cartesian gradient in the SC vectors (ghpbx).
4385 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4386 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4389 cgrad do j=iii,jjj-1
4391 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4395 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4396 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4403 C--------------------------------------------------------------------------
4404 subroutine ssbond_ene(i,j,eij)
4406 C Calculate the distance and angle dependent SS-bond potential energy
4407 C using a free-energy function derived based on RHF/6-31G** ab initio
4408 C calculations of diethyl disulfide.
4410 C A. Liwo and U. Kozlowska, 11/24/03
4412 implicit real*8 (a-h,o-z)
4413 include 'DIMENSIONS'
4414 include 'COMMON.SBRIDGE'
4415 include 'COMMON.CHAIN'
4416 include 'COMMON.DERIV'
4417 include 'COMMON.LOCAL'
4418 include 'COMMON.INTERACT'
4419 include 'COMMON.VAR'
4420 include 'COMMON.IOUNITS'
4421 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4426 dxi=dc_norm(1,nres+i)
4427 dyi=dc_norm(2,nres+i)
4428 dzi=dc_norm(3,nres+i)
4429 c dsci_inv=dsc_inv(itypi)
4430 dsci_inv=vbld_inv(nres+i)
4432 c dscj_inv=dsc_inv(itypj)
4433 dscj_inv=vbld_inv(nres+j)
4437 dxj=dc_norm(1,nres+j)
4438 dyj=dc_norm(2,nres+j)
4439 dzj=dc_norm(3,nres+j)
4440 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4445 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4446 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4447 om12=dxi*dxj+dyi*dyj+dzi*dzj
4449 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4450 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4456 deltat12=om2-om1+2.0d0
4458 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4459 & +akct*deltad*deltat12
4460 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4461 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4462 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4463 c & " deltat12",deltat12," eij",eij
4464 ed=2*akcm*deltad+akct*deltat12
4466 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4467 eom1=-2*akth*deltat1-pom1-om2*pom2
4468 eom2= 2*akth*deltat2+pom1-om1*pom2
4471 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4472 ghpbx(k,i)=ghpbx(k,i)-ggk
4473 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4474 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4475 ghpbx(k,j)=ghpbx(k,j)+ggk
4476 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4477 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4478 ghpbc(k,i)=ghpbc(k,i)-ggk
4479 ghpbc(k,j)=ghpbc(k,j)+ggk
4482 C Calculate the components of the gradient in DC and X
4486 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4491 C--------------------------------------------------------------------------
4492 subroutine ebond(estr)
4494 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4496 implicit real*8 (a-h,o-z)
4497 include 'DIMENSIONS'
4498 include 'COMMON.LOCAL'
4499 include 'COMMON.GEO'
4500 include 'COMMON.INTERACT'
4501 include 'COMMON.DERIV'
4502 include 'COMMON.VAR'
4503 include 'COMMON.CHAIN'
4504 include 'COMMON.IOUNITS'
4505 include 'COMMON.NAMES'
4506 include 'COMMON.FFIELD'
4507 include 'COMMON.CONTROL'
4508 include 'COMMON.SETUP'
4509 double precision u(3),ud(3)
4511 do i=ibondp_start,ibondp_end
4512 diff = vbld(i)-vbldp0
4513 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4516 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4518 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4522 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4524 do i=ibond_start,ibond_end
4529 diff=vbld(i+nres)-vbldsc0(1,iti)
4530 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4531 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4532 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4534 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4538 diff=vbld(i+nres)-vbldsc0(j,iti)
4539 ud(j)=aksc(j,iti)*diff
4540 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4554 uprod2=uprod2*u(k)*u(k)
4558 usumsqder=usumsqder+ud(j)*uprod2
4560 estr=estr+uprod/usum
4562 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4570 C--------------------------------------------------------------------------
4571 subroutine ebend(etheta)
4573 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4574 C angles gamma and its derivatives in consecutive thetas and gammas.
4576 implicit real*8 (a-h,o-z)
4577 include 'DIMENSIONS'
4578 include 'COMMON.LOCAL'
4579 include 'COMMON.GEO'
4580 include 'COMMON.INTERACT'
4581 include 'COMMON.DERIV'
4582 include 'COMMON.VAR'
4583 include 'COMMON.CHAIN'
4584 include 'COMMON.IOUNITS'
4585 include 'COMMON.NAMES'
4586 include 'COMMON.FFIELD'
4587 include 'COMMON.CONTROL'
4588 common /calcthet/ term1,term2,termm,diffak,ratak,
4589 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4590 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4591 double precision y(2),z(2)
4593 c time11=dexp(-2*time)
4596 c write (*,'(a,i2)') 'EBEND ICG=',icg
4597 do i=ithet_start,ithet_end
4598 C Zero the energy function and its derivative at 0 or pi.
4599 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4604 if (phii.ne.phii) phii=150.0
4617 if (phii1.ne.phii1) phii1=150.0
4629 C Calculate the "mean" value of theta from the part of the distribution
4630 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4631 C In following comments this theta will be referred to as t_c.
4632 thet_pred_mean=0.0d0
4636 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4638 dthett=thet_pred_mean*ssd
4639 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4640 C Derivatives of the "mean" values in gamma1 and gamma2.
4641 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4642 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4643 if (theta(i).gt.pi-delta) then
4644 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4646 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4647 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4648 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4650 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4652 else if (theta(i).lt.delta) then
4653 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4654 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4655 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4657 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4658 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4661 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4664 etheta=etheta+ethetai
4665 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4667 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4668 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4669 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4671 C Ufff.... We've done all this!!!
4674 C---------------------------------------------------------------------------
4675 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4677 implicit real*8 (a-h,o-z)
4678 include 'DIMENSIONS'
4679 include 'COMMON.LOCAL'
4680 include 'COMMON.IOUNITS'
4681 common /calcthet/ term1,term2,termm,diffak,ratak,
4682 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4683 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4684 C Calculate the contributions to both Gaussian lobes.
4685 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4686 C The "polynomial part" of the "standard deviation" of this part of
4690 sig=sig*thet_pred_mean+polthet(j,it)
4692 C Derivative of the "interior part" of the "standard deviation of the"
4693 C gamma-dependent Gaussian lobe in t_c.
4694 sigtc=3*polthet(3,it)
4696 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4699 C Set the parameters of both Gaussian lobes of the distribution.
4700 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4701 fac=sig*sig+sigc0(it)
4704 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4705 sigsqtc=-4.0D0*sigcsq*sigtc
4706 c print *,i,sig,sigtc,sigsqtc
4707 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4708 sigtc=-sigtc/(fac*fac)
4709 C Following variable is sigma(t_c)**(-2)
4710 sigcsq=sigcsq*sigcsq
4712 sig0inv=1.0D0/sig0i**2
4713 delthec=thetai-thet_pred_mean
4714 delthe0=thetai-theta0i
4715 term1=-0.5D0*sigcsq*delthec*delthec
4716 term2=-0.5D0*sig0inv*delthe0*delthe0
4717 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4718 C NaNs in taking the logarithm. We extract the largest exponent which is added
4719 C to the energy (this being the log of the distribution) at the end of energy
4720 C term evaluation for this virtual-bond angle.
4721 if (term1.gt.term2) then
4723 term2=dexp(term2-termm)
4727 term1=dexp(term1-termm)
4730 C The ratio between the gamma-independent and gamma-dependent lobes of
4731 C the distribution is a Gaussian function of thet_pred_mean too.
4732 diffak=gthet(2,it)-thet_pred_mean
4733 ratak=diffak/gthet(3,it)**2
4734 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4735 C Let's differentiate it in thet_pred_mean NOW.
4737 C Now put together the distribution terms to make complete distribution.
4738 termexp=term1+ak*term2
4739 termpre=sigc+ak*sig0i
4740 C Contribution of the bending energy from this theta is just the -log of
4741 C the sum of the contributions from the two lobes and the pre-exponential
4742 C factor. Simple enough, isn't it?
4743 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4744 C NOW the derivatives!!!
4745 C 6/6/97 Take into account the deformation.
4746 E_theta=(delthec*sigcsq*term1
4747 & +ak*delthe0*sig0inv*term2)/termexp
4748 E_tc=((sigtc+aktc*sig0i)/termpre
4749 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4750 & aktc*term2)/termexp)
4753 c-----------------------------------------------------------------------------
4754 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4755 implicit real*8 (a-h,o-z)
4756 include 'DIMENSIONS'
4757 include 'COMMON.LOCAL'
4758 include 'COMMON.IOUNITS'
4759 common /calcthet/ term1,term2,termm,diffak,ratak,
4760 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4761 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4762 delthec=thetai-thet_pred_mean
4763 delthe0=thetai-theta0i
4764 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4765 t3 = thetai-thet_pred_mean
4769 t14 = t12+t6*sigsqtc
4771 t21 = thetai-theta0i
4777 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4778 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4779 & *(-t12*t9-ak*sig0inv*t27)
4783 C--------------------------------------------------------------------------
4784 subroutine ebend(etheta)
4786 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4787 C angles gamma and its derivatives in consecutive thetas and gammas.
4788 C ab initio-derived potentials from
4789 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4791 implicit real*8 (a-h,o-z)
4792 include 'DIMENSIONS'
4793 include 'COMMON.LOCAL'
4794 include 'COMMON.GEO'
4795 include 'COMMON.INTERACT'
4796 include 'COMMON.DERIV'
4797 include 'COMMON.VAR'
4798 include 'COMMON.CHAIN'
4799 include 'COMMON.IOUNITS'
4800 include 'COMMON.NAMES'
4801 include 'COMMON.FFIELD'
4802 include 'COMMON.CONTROL'
4803 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4804 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4805 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4806 & sinph1ph2(maxdouble,maxdouble)
4807 logical lprn /.false./, lprn1 /.false./
4809 do i=ithet_start,ithet_end
4813 theti2=0.5d0*theta(i)
4814 ityp2=ithetyp(itype(i-1))
4816 coskt(k)=dcos(k*theti2)
4817 sinkt(k)=dsin(k*theti2)
4822 if (phii.ne.phii) phii=150.0
4826 ityp1=ithetyp(itype(i-2))
4828 cosph1(k)=dcos(k*phii)
4829 sinph1(k)=dsin(k*phii)
4842 if (phii1.ne.phii1) phii1=150.0
4847 ityp3=ithetyp(itype(i))
4849 cosph2(k)=dcos(k*phii1)
4850 sinph2(k)=dsin(k*phii1)
4860 ethetai=aa0thet(ityp1,ityp2,ityp3)
4863 ccl=cosph1(l)*cosph2(k-l)
4864 ssl=sinph1(l)*sinph2(k-l)
4865 scl=sinph1(l)*cosph2(k-l)
4866 csl=cosph1(l)*sinph2(k-l)
4867 cosph1ph2(l,k)=ccl-ssl
4868 cosph1ph2(k,l)=ccl+ssl
4869 sinph1ph2(l,k)=scl+csl
4870 sinph1ph2(k,l)=scl-csl
4874 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4875 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4876 write (iout,*) "coskt and sinkt"
4878 write (iout,*) k,coskt(k),sinkt(k)
4882 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4883 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4886 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4887 & " ethetai",ethetai
4890 write (iout,*) "cosph and sinph"
4892 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4894 write (iout,*) "cosph1ph2 and sinph2ph2"
4897 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4898 & sinph1ph2(l,k),sinph1ph2(k,l)
4901 write(iout,*) "ethetai",ethetai
4905 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4906 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4907 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4908 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4909 ethetai=ethetai+sinkt(m)*aux
4910 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4911 dephii=dephii+k*sinkt(m)*(
4912 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4913 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4914 dephii1=dephii1+k*sinkt(m)*(
4915 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4916 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4918 & write (iout,*) "m",m," k",k," bbthet",
4919 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4920 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4921 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4922 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4926 & write(iout,*) "ethetai",ethetai
4930 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4931 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4932 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4933 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4934 ethetai=ethetai+sinkt(m)*aux
4935 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4936 dephii=dephii+l*sinkt(m)*(
4937 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4938 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4939 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4940 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4941 dephii1=dephii1+(k-l)*sinkt(m)*(
4942 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4943 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4944 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4945 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4947 write (iout,*) "m",m," k",k," l",l," ffthet",
4948 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4949 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4950 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4951 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4952 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4953 & cosph1ph2(k,l)*sinkt(m),
4954 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4960 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4961 & i,theta(i)*rad2deg,phii*rad2deg,
4962 & phii1*rad2deg,ethetai
4963 etheta=etheta+ethetai
4964 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4965 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4966 gloc(nphi+i-2,icg)=wang*dethetai
4972 c-----------------------------------------------------------------------------
4973 subroutine esc(escloc)
4974 C Calculate the local energy of a side chain and its derivatives in the
4975 C corresponding virtual-bond valence angles THETA and the spherical angles
4977 implicit real*8 (a-h,o-z)
4978 include 'DIMENSIONS'
4979 include 'COMMON.GEO'
4980 include 'COMMON.LOCAL'
4981 include 'COMMON.VAR'
4982 include 'COMMON.INTERACT'
4983 include 'COMMON.DERIV'
4984 include 'COMMON.CHAIN'
4985 include 'COMMON.IOUNITS'
4986 include 'COMMON.NAMES'
4987 include 'COMMON.FFIELD'
4988 include 'COMMON.CONTROL'
4989 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4990 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4991 common /sccalc/ time11,time12,time112,theti,it,nlobit
4994 c write (iout,'(a)') 'ESC'
4995 do i=loc_start,loc_end
4997 if (it.eq.10) goto 1
4999 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5000 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5001 theti=theta(i+1)-pipol
5006 if (x(2).gt.pi-delta) then
5010 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5012 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5013 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5015 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5016 & ddersc0(1),dersc(1))
5017 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5018 & ddersc0(3),dersc(3))
5020 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5022 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5023 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5024 & dersc0(2),esclocbi,dersc02)
5025 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5027 call splinthet(x(2),0.5d0*delta,ss,ssd)
5032 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5034 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5035 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5037 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5039 c write (iout,*) escloci
5040 else if (x(2).lt.delta) then
5044 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5046 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5047 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5049 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5050 & ddersc0(1),dersc(1))
5051 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5052 & ddersc0(3),dersc(3))
5054 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5056 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5057 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5058 & dersc0(2),esclocbi,dersc02)
5059 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5064 call splinthet(x(2),0.5d0*delta,ss,ssd)
5066 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5068 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5069 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5071 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5072 c write (iout,*) escloci
5074 call enesc(x,escloci,dersc,ddummy,.false.)
5077 escloc=escloc+escloci
5078 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5079 & 'escloc',i,escloci
5080 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5082 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5084 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5085 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5090 C---------------------------------------------------------------------------
5091 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5092 implicit real*8 (a-h,o-z)
5093 include 'DIMENSIONS'
5094 include 'COMMON.GEO'
5095 include 'COMMON.LOCAL'
5096 include 'COMMON.IOUNITS'
5097 common /sccalc/ time11,time12,time112,theti,it,nlobit
5098 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5099 double precision contr(maxlob,-1:1)
5101 c write (iout,*) 'it=',it,' nlobit=',nlobit
5105 if (mixed) ddersc(j)=0.0d0
5109 C Because of periodicity of the dependence of the SC energy in omega we have
5110 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5111 C To avoid underflows, first compute & store the exponents.
5119 z(k)=x(k)-censc(k,j,it)
5124 Axk=Axk+gaussc(l,k,j,it)*z(l)
5130 expfac=expfac+Ax(k,j,iii)*z(k)
5138 C As in the case of ebend, we want to avoid underflows in exponentiation and
5139 C subsequent NaNs and INFs in energy calculation.
5140 C Find the largest exponent
5144 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5148 cd print *,'it=',it,' emin=',emin
5150 C Compute the contribution to SC energy and derivatives
5155 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5156 if(adexp.ne.adexp) adexp=1.0
5159 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5161 cd print *,'j=',j,' expfac=',expfac
5162 escloc_i=escloc_i+expfac
5164 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5168 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5169 & +gaussc(k,2,j,it))*expfac
5176 dersc(1)=dersc(1)/cos(theti)**2
5177 ddersc(1)=ddersc(1)/cos(theti)**2
5180 escloci=-(dlog(escloc_i)-emin)
5182 dersc(j)=dersc(j)/escloc_i
5186 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5191 C------------------------------------------------------------------------------
5192 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5193 implicit real*8 (a-h,o-z)
5194 include 'DIMENSIONS'
5195 include 'COMMON.GEO'
5196 include 'COMMON.LOCAL'
5197 include 'COMMON.IOUNITS'
5198 common /sccalc/ time11,time12,time112,theti,it,nlobit
5199 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5200 double precision contr(maxlob)
5211 z(k)=x(k)-censc(k,j,it)
5217 Axk=Axk+gaussc(l,k,j,it)*z(l)
5223 expfac=expfac+Ax(k,j)*z(k)
5228 C As in the case of ebend, we want to avoid underflows in exponentiation and
5229 C subsequent NaNs and INFs in energy calculation.
5230 C Find the largest exponent
5233 if (emin.gt.contr(j)) emin=contr(j)
5237 C Compute the contribution to SC energy and derivatives
5241 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5242 escloc_i=escloc_i+expfac
5244 dersc(k)=dersc(k)+Ax(k,j)*expfac
5246 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5247 & +gaussc(1,2,j,it))*expfac
5251 dersc(1)=dersc(1)/cos(theti)**2
5252 dersc12=dersc12/cos(theti)**2
5253 escloci=-(dlog(escloc_i)-emin)
5255 dersc(j)=dersc(j)/escloc_i
5257 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5261 c----------------------------------------------------------------------------------
5262 subroutine esc(escloc)
5263 C Calculate the local energy of a side chain and its derivatives in the
5264 C corresponding virtual-bond valence angles THETA and the spherical angles
5265 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5266 C added by Urszula Kozlowska. 07/11/2007
5268 implicit real*8 (a-h,o-z)
5269 include 'DIMENSIONS'
5270 include 'COMMON.GEO'
5271 include 'COMMON.LOCAL'
5272 include 'COMMON.VAR'
5273 include 'COMMON.SCROT'
5274 include 'COMMON.INTERACT'
5275 include 'COMMON.DERIV'
5276 include 'COMMON.CHAIN'
5277 include 'COMMON.IOUNITS'
5278 include 'COMMON.NAMES'
5279 include 'COMMON.FFIELD'
5280 include 'COMMON.CONTROL'
5281 include 'COMMON.VECTORS'
5282 double precision x_prime(3),y_prime(3),z_prime(3)
5283 & , sumene,dsc_i,dp2_i,x(65),
5284 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5285 & de_dxx,de_dyy,de_dzz,de_dt
5286 double precision s1_t,s1_6_t,s2_t,s2_6_t
5288 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5289 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5290 & dt_dCi(3),dt_dCi1(3)
5291 common /sccalc/ time11,time12,time112,theti,it,nlobit
5294 do i=loc_start,loc_end
5295 costtab(i+1) =dcos(theta(i+1))
5296 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5297 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5298 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5299 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5300 cosfac=dsqrt(cosfac2)
5301 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5302 sinfac=dsqrt(sinfac2)
5304 if (it.eq.10) goto 1
5306 C Compute the axes of tghe local cartesian coordinates system; store in
5307 c x_prime, y_prime and z_prime
5314 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5315 C & dc_norm(3,i+nres)
5317 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5318 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5321 z_prime(j) = -uz(j,i-1)
5324 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5325 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5326 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5327 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5328 c & " xy",scalar(x_prime(1),y_prime(1)),
5329 c & " xz",scalar(x_prime(1),z_prime(1)),
5330 c & " yy",scalar(y_prime(1),y_prime(1)),
5331 c & " yz",scalar(y_prime(1),z_prime(1)),
5332 c & " zz",scalar(z_prime(1),z_prime(1))
5334 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5335 C to local coordinate system. Store in xx, yy, zz.
5341 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5342 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5343 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5350 C Compute the energy of the ith side cbain
5352 c write (2,*) "xx",xx," yy",yy," zz",zz
5355 x(j) = sc_parmin(j,it)
5358 Cc diagnostics - remove later
5360 yy1 = dsin(alph(2))*dcos(omeg(2))
5361 zz1 = -dsin(alph(2))*dsin(omeg(2))
5362 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5363 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5365 C," --- ", xx_w,yy_w,zz_w
5368 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5369 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5371 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5372 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5374 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5375 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5376 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5377 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5378 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5380 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5381 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5382 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5383 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5384 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5386 dsc_i = 0.743d0+x(61)
5388 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5389 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5390 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5391 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5392 s1=(1+x(63))/(0.1d0 + dscp1)
5393 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5394 s2=(1+x(65))/(0.1d0 + dscp2)
5395 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5396 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5397 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5398 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5400 c & dscp1,dscp2,sumene
5401 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5402 escloc = escloc + sumene
5403 c write (2,*) "i",i," escloc",sumene,escloc
5406 C This section to check the numerical derivatives of the energy of ith side
5407 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5408 C #define DEBUG in the code to turn it on.
5410 write (2,*) "sumene =",sumene
5414 write (2,*) xx,yy,zz
5415 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5416 de_dxx_num=(sumenep-sumene)/aincr
5418 write (2,*) "xx+ sumene from enesc=",sumenep
5421 write (2,*) xx,yy,zz
5422 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5423 de_dyy_num=(sumenep-sumene)/aincr
5425 write (2,*) "yy+ sumene from enesc=",sumenep
5428 write (2,*) xx,yy,zz
5429 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5430 de_dzz_num=(sumenep-sumene)/aincr
5432 write (2,*) "zz+ sumene from enesc=",sumenep
5433 costsave=cost2tab(i+1)
5434 sintsave=sint2tab(i+1)
5435 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5436 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5437 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5438 de_dt_num=(sumenep-sumene)/aincr
5439 write (2,*) " t+ sumene from enesc=",sumenep
5440 cost2tab(i+1)=costsave
5441 sint2tab(i+1)=sintsave
5442 C End of diagnostics section.
5445 C Compute the gradient of esc
5447 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5448 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5449 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5450 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5451 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5452 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5453 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5454 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5455 pom1=(sumene3*sint2tab(i+1)+sumene1)
5456 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5457 pom2=(sumene4*cost2tab(i+1)+sumene2)
5458 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5459 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5460 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5461 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5463 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5464 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5465 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5467 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5468 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5469 & +(pom1+pom2)*pom_dx
5471 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5474 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5475 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5476 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5478 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5479 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5480 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5481 & +x(59)*zz**2 +x(60)*xx*zz
5482 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5483 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5484 & +(pom1-pom2)*pom_dy
5486 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5489 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5490 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5491 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5492 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5493 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5494 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5495 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5496 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5498 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5501 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5502 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5503 & +pom1*pom_dt1+pom2*pom_dt2
5505 write(2,*), "de_dt = ", de_dt,de_dt_num
5509 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5510 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5511 cosfac2xx=cosfac2*xx
5512 sinfac2yy=sinfac2*yy
5514 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5516 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5518 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5519 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5520 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5521 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5522 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5523 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5524 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5525 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5526 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5527 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5531 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5532 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5535 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5536 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5537 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5539 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5540 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5544 dXX_Ctab(k,i)=dXX_Ci(k)
5545 dXX_C1tab(k,i)=dXX_Ci1(k)
5546 dYY_Ctab(k,i)=dYY_Ci(k)
5547 dYY_C1tab(k,i)=dYY_Ci1(k)
5548 dZZ_Ctab(k,i)=dZZ_Ci(k)
5549 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5550 dXX_XYZtab(k,i)=dXX_XYZ(k)
5551 dYY_XYZtab(k,i)=dYY_XYZ(k)
5552 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5556 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5557 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5558 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5559 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5560 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5562 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5563 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5564 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5565 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5566 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5567 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5568 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5569 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5571 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5572 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5574 C to check gradient call subroutine check_grad
5580 c------------------------------------------------------------------------------
5581 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5583 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5584 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5585 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5586 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5588 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5589 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5591 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5592 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5593 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5594 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5595 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5597 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5598 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5599 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5600 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5601 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5603 dsc_i = 0.743d0+x(61)
5605 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5606 & *(xx*cost2+yy*sint2))
5607 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5608 & *(xx*cost2-yy*sint2))
5609 s1=(1+x(63))/(0.1d0 + dscp1)
5610 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5611 s2=(1+x(65))/(0.1d0 + dscp2)
5612 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5613 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5614 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5619 c------------------------------------------------------------------------------
5620 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5622 C This procedure calculates two-body contact function g(rij) and its derivative:
5625 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5628 C where x=(rij-r0ij)/delta
5630 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5633 double precision rij,r0ij,eps0ij,fcont,fprimcont
5634 double precision x,x2,x4,delta
5638 if (x.lt.-1.0D0) then
5641 else if (x.le.1.0D0) then
5644 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5645 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5652 c------------------------------------------------------------------------------
5653 subroutine splinthet(theti,delta,ss,ssder)
5654 implicit real*8 (a-h,o-z)
5655 include 'DIMENSIONS'
5656 include 'COMMON.VAR'
5657 include 'COMMON.GEO'
5660 if (theti.gt.pipol) then
5661 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5663 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5668 c------------------------------------------------------------------------------
5669 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5671 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5672 double precision ksi,ksi2,ksi3,a1,a2,a3
5673 a1=fprim0*delta/(f1-f0)
5679 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5680 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5683 c------------------------------------------------------------------------------
5684 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5686 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5687 double precision ksi,ksi2,ksi3,a1,a2,a3
5692 a2=3*(f1x-f0x)-2*fprim0x*delta
5693 a3=fprim0x*delta-2*(f1x-f0x)
5694 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5697 C-----------------------------------------------------------------------------
5699 C-----------------------------------------------------------------------------
5700 subroutine etor(etors,edihcnstr)
5701 implicit real*8 (a-h,o-z)
5702 include 'DIMENSIONS'
5703 include 'COMMON.VAR'
5704 include 'COMMON.GEO'
5705 include 'COMMON.LOCAL'
5706 include 'COMMON.TORSION'
5707 include 'COMMON.INTERACT'
5708 include 'COMMON.DERIV'
5709 include 'COMMON.CHAIN'
5710 include 'COMMON.NAMES'
5711 include 'COMMON.IOUNITS'
5712 include 'COMMON.FFIELD'
5713 include 'COMMON.TORCNSTR'
5714 include 'COMMON.CONTROL'
5716 C Set lprn=.true. for debugging
5720 do i=iphi_start,iphi_end
5722 itori=itortyp(itype(i-2))
5723 itori1=itortyp(itype(i-1))
5726 C Proline-Proline pair is a special case...
5727 if (itori.eq.3 .and. itori1.eq.3) then
5728 if (phii.gt.-dwapi3) then
5730 fac=1.0D0/(1.0D0-cosphi)
5731 etorsi=v1(1,3,3)*fac
5732 etorsi=etorsi+etorsi
5733 etors=etors+etorsi-v1(1,3,3)
5734 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5735 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5738 v1ij=v1(j+1,itori,itori1)
5739 v2ij=v2(j+1,itori,itori1)
5742 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5743 if (energy_dec) etors_ii=etors_ii+
5744 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5745 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5749 v1ij=v1(j,itori,itori1)
5750 v2ij=v2(j,itori,itori1)
5753 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5754 if (energy_dec) etors_ii=etors_ii+
5755 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5756 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5759 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5762 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5763 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5764 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5765 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5766 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5768 ! 6/20/98 - dihedral angle constraints
5771 itori=idih_constr(i)
5774 if (difi.gt.drange(i)) then
5776 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5777 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5778 else if (difi.lt.-drange(i)) then
5780 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5781 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5783 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5784 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5786 ! write (iout,*) 'edihcnstr',edihcnstr
5789 c------------------------------------------------------------------------------
5790 subroutine etor_d(etors_d)
5794 c----------------------------------------------------------------------------
5796 subroutine etor(etors,edihcnstr)
5797 implicit real*8 (a-h,o-z)
5798 include 'DIMENSIONS'
5799 include 'COMMON.VAR'
5800 include 'COMMON.GEO'
5801 include 'COMMON.LOCAL'
5802 include 'COMMON.TORSION'
5803 include 'COMMON.INTERACT'
5804 include 'COMMON.DERIV'
5805 include 'COMMON.CHAIN'
5806 include 'COMMON.NAMES'
5807 include 'COMMON.IOUNITS'
5808 include 'COMMON.FFIELD'
5809 include 'COMMON.TORCNSTR'
5810 include 'COMMON.CONTROL'
5812 C Set lprn=.true. for debugging
5816 do i=iphi_start,iphi_end
5818 itori=itortyp(itype(i-2))
5819 itori1=itortyp(itype(i-1))
5822 C Regular cosine and sine terms
5823 do j=1,nterm(itori,itori1)
5824 v1ij=v1(j,itori,itori1)
5825 v2ij=v2(j,itori,itori1)
5828 etors=etors+v1ij*cosphi+v2ij*sinphi
5829 if (energy_dec) etors_ii=etors_ii+
5830 & v1ij*cosphi+v2ij*sinphi
5831 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5835 C E = SUM ----------------------------------- - v1
5836 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5838 cosphi=dcos(0.5d0*phii)
5839 sinphi=dsin(0.5d0*phii)
5840 do j=1,nlor(itori,itori1)
5841 vl1ij=vlor1(j,itori,itori1)
5842 vl2ij=vlor2(j,itori,itori1)
5843 vl3ij=vlor3(j,itori,itori1)
5844 pom=vl2ij*cosphi+vl3ij*sinphi
5845 pom1=1.0d0/(pom*pom+1.0d0)
5846 etors=etors+vl1ij*pom1
5847 if (energy_dec) etors_ii=etors_ii+
5850 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5852 C Subtract the constant term
5853 etors=etors-v0(itori,itori1)
5854 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5855 & 'etor',i,etors_ii-v0(itori,itori1)
5857 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5858 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5859 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5860 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5861 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5863 ! 6/20/98 - dihedral angle constraints
5865 c do i=1,ndih_constr
5866 do i=idihconstr_start,idihconstr_end
5867 itori=idih_constr(i)
5869 difi=pinorm(phii-phi0(i))
5870 if (difi.gt.drange(i)) then
5872 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5873 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5874 else if (difi.lt.-drange(i)) then
5876 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5877 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5881 c write (iout,*) "gloci", gloc(i-3,icg)
5882 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5883 cd & rad2deg*phi0(i), rad2deg*drange(i),
5884 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5886 cd write (iout,*) 'edihcnstr',edihcnstr
5889 c----------------------------------------------------------------------------
5890 subroutine etor_d(etors_d)
5891 C 6/23/01 Compute double torsional energy
5892 implicit real*8 (a-h,o-z)
5893 include 'DIMENSIONS'
5894 include 'COMMON.VAR'
5895 include 'COMMON.GEO'
5896 include 'COMMON.LOCAL'
5897 include 'COMMON.TORSION'
5898 include 'COMMON.INTERACT'
5899 include 'COMMON.DERIV'
5900 include 'COMMON.CHAIN'
5901 include 'COMMON.NAMES'
5902 include 'COMMON.IOUNITS'
5903 include 'COMMON.FFIELD'
5904 include 'COMMON.TORCNSTR'
5906 C Set lprn=.true. for debugging
5910 do i=iphid_start,iphid_end
5911 itori=itortyp(itype(i-2))
5912 itori1=itortyp(itype(i-1))
5913 itori2=itortyp(itype(i))
5918 do j=1,ntermd_1(itori,itori1,itori2)
5919 v1cij=v1c(1,j,itori,itori1,itori2)
5920 v1sij=v1s(1,j,itori,itori1,itori2)
5921 v2cij=v1c(2,j,itori,itori1,itori2)
5922 v2sij=v1s(2,j,itori,itori1,itori2)
5923 cosphi1=dcos(j*phii)
5924 sinphi1=dsin(j*phii)
5925 cosphi2=dcos(j*phii1)
5926 sinphi2=dsin(j*phii1)
5927 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5928 & v2cij*cosphi2+v2sij*sinphi2
5929 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5930 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5932 do k=2,ntermd_2(itori,itori1,itori2)
5934 v1cdij = v2c(k,l,itori,itori1,itori2)
5935 v2cdij = v2c(l,k,itori,itori1,itori2)
5936 v1sdij = v2s(k,l,itori,itori1,itori2)
5937 v2sdij = v2s(l,k,itori,itori1,itori2)
5938 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5939 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5940 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5941 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5942 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5943 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5944 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5945 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5946 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5947 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5950 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5951 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5952 c write (iout,*) "gloci", gloc(i-3,icg)
5957 c------------------------------------------------------------------------------
5958 subroutine eback_sc_corr(esccor)
5959 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5960 c conformational states; temporarily implemented as differences
5961 c between UNRES torsional potentials (dependent on three types of
5962 c residues) and the torsional potentials dependent on all 20 types
5963 c of residues computed from AM1 energy surfaces of terminally-blocked
5964 c amino-acid residues.
5965 implicit real*8 (a-h,o-z)
5966 include 'DIMENSIONS'
5967 include 'COMMON.VAR'
5968 include 'COMMON.GEO'
5969 include 'COMMON.LOCAL'
5970 include 'COMMON.TORSION'
5971 include 'COMMON.SCCOR'
5972 include 'COMMON.INTERACT'
5973 include 'COMMON.DERIV'
5974 include 'COMMON.CHAIN'
5975 include 'COMMON.NAMES'
5976 include 'COMMON.IOUNITS'
5977 include 'COMMON.FFIELD'
5978 include 'COMMON.CONTROL'
5980 C Set lprn=.true. for debugging
5983 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5985 do i=itau_start,itau_end
5987 isccori=isccortyp(itype(i-2))
5988 isccori1=isccortyp(itype(i-1))
5990 cccc Added 9 May 2012
5991 cc Tauangle is torsional engle depending on the value of first digit
5992 c(see comment below)
5993 cc Omicron is flat angle depending on the value of first digit
5994 c(see comment below)
5997 do intertyp=1,3 !intertyp
5998 cc Added 09 May 2012 (Adasko)
5999 cc Intertyp means interaction type of backbone mainchain correlation:
6000 c 1 = SC...Ca...Ca...Ca
6001 c 2 = Ca...Ca...Ca...SC
6002 c 3 = SC...Ca...Ca...SCi
6004 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6005 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6006 & (itype(i-1).eq.21)))
6007 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6008 & .or.(itype(i-2).eq.21)))
6009 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6010 & (itype(i-1).eq.21)))) cycle
6011 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6012 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6014 do j=1,nterm_sccor(isccori,isccori1)
6015 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6016 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6017 cosphi=dcos(j*tauangle(intertyp,i))
6018 sinphi=dsin(j*tauangle(intertyp,i))
6019 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6020 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6022 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6023 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6024 c &gloc_sc(intertyp,i-3,icg)
6026 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6027 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6028 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6029 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6030 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6034 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6038 c----------------------------------------------------------------------------
6039 subroutine multibody(ecorr)
6040 C This subroutine calculates multi-body contributions to energy following
6041 C the idea of Skolnick et al. If side chains I and J make a contact and
6042 C at the same time side chains I+1 and J+1 make a contact, an extra
6043 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6044 implicit real*8 (a-h,o-z)
6045 include 'DIMENSIONS'
6046 include 'COMMON.IOUNITS'
6047 include 'COMMON.DERIV'
6048 include 'COMMON.INTERACT'
6049 include 'COMMON.CONTACTS'
6050 double precision gx(3),gx1(3)
6053 C Set lprn=.true. for debugging
6057 write (iout,'(a)') 'Contact function values:'
6059 write (iout,'(i2,20(1x,i2,f10.5))')
6060 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6075 num_conti=num_cont(i)
6076 num_conti1=num_cont(i1)
6081 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6082 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6083 cd & ' ishift=',ishift
6084 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6085 C The system gains extra energy.
6086 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6087 endif ! j1==j+-ishift
6096 c------------------------------------------------------------------------------
6097 double precision function esccorr(i,j,k,l,jj,kk)
6098 implicit real*8 (a-h,o-z)
6099 include 'DIMENSIONS'
6100 include 'COMMON.IOUNITS'
6101 include 'COMMON.DERIV'
6102 include 'COMMON.INTERACT'
6103 include 'COMMON.CONTACTS'
6104 double precision gx(3),gx1(3)
6109 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6110 C Calculate the multi-body contribution to energy.
6111 C Calculate multi-body contributions to the gradient.
6112 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6113 cd & k,l,(gacont(m,kk,k),m=1,3)
6115 gx(m) =ekl*gacont(m,jj,i)
6116 gx1(m)=eij*gacont(m,kk,k)
6117 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6118 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6119 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6120 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6124 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6129 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6135 c------------------------------------------------------------------------------
6136 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6137 C This subroutine calculates multi-body contributions to hydrogen-bonding
6138 implicit real*8 (a-h,o-z)
6139 include 'DIMENSIONS'
6140 include 'COMMON.IOUNITS'
6143 parameter (max_cont=maxconts)
6144 parameter (max_dim=26)
6145 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6146 double precision zapas(max_dim,maxconts,max_fg_procs),
6147 & zapas_recv(max_dim,maxconts,max_fg_procs)
6148 common /przechowalnia/ zapas
6149 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6150 & status_array(MPI_STATUS_SIZE,maxconts*2)
6152 include 'COMMON.SETUP'
6153 include 'COMMON.FFIELD'
6154 include 'COMMON.DERIV'
6155 include 'COMMON.INTERACT'
6156 include 'COMMON.CONTACTS'
6157 include 'COMMON.CONTROL'
6158 include 'COMMON.LOCAL'
6159 double precision gx(3),gx1(3),time00
6162 C Set lprn=.true. for debugging
6167 if (nfgtasks.le.1) goto 30
6169 write (iout,'(a)') 'Contact function values before RECEIVE:'
6171 write (iout,'(2i3,50(1x,i2,f5.2))')
6172 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6173 & j=1,num_cont_hb(i))
6177 do i=1,ntask_cont_from
6180 do i=1,ntask_cont_to
6183 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6185 C Make the list of contacts to send to send to other procesors
6186 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6188 do i=iturn3_start,iturn3_end
6189 c write (iout,*) "make contact list turn3",i," num_cont",
6191 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6193 do i=iturn4_start,iturn4_end
6194 c write (iout,*) "make contact list turn4",i," num_cont",
6196 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6200 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6202 do j=1,num_cont_hb(i)
6205 iproc=iint_sent_local(k,jjc,ii)
6206 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6207 if (iproc.gt.0) then
6208 ncont_sent(iproc)=ncont_sent(iproc)+1
6209 nn=ncont_sent(iproc)
6211 zapas(2,nn,iproc)=jjc
6212 zapas(3,nn,iproc)=facont_hb(j,i)
6213 zapas(4,nn,iproc)=ees0p(j,i)
6214 zapas(5,nn,iproc)=ees0m(j,i)
6215 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6216 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6217 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6218 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6219 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6220 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6221 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6222 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6223 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6224 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6225 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6226 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6227 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6228 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6229 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6230 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6231 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6232 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6233 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6234 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6235 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6242 & "Numbers of contacts to be sent to other processors",
6243 & (ncont_sent(i),i=1,ntask_cont_to)
6244 write (iout,*) "Contacts sent"
6245 do ii=1,ntask_cont_to
6247 iproc=itask_cont_to(ii)
6248 write (iout,*) nn," contacts to processor",iproc,
6249 & " of CONT_TO_COMM group"
6251 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6259 CorrelID1=nfgtasks+fg_rank+1
6261 C Receive the numbers of needed contacts from other processors
6262 do ii=1,ntask_cont_from
6263 iproc=itask_cont_from(ii)
6265 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6266 & FG_COMM,req(ireq),IERR)
6268 c write (iout,*) "IRECV ended"
6270 C Send the number of contacts needed by other processors
6271 do ii=1,ntask_cont_to
6272 iproc=itask_cont_to(ii)
6274 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6275 & FG_COMM,req(ireq),IERR)
6277 c write (iout,*) "ISEND ended"
6278 c write (iout,*) "number of requests (nn)",ireq
6281 & call MPI_Waitall(ireq,req,status_array,ierr)
6283 c & "Numbers of contacts to be received from other processors",
6284 c & (ncont_recv(i),i=1,ntask_cont_from)
6288 do ii=1,ntask_cont_from
6289 iproc=itask_cont_from(ii)
6291 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6292 c & " of CONT_TO_COMM group"
6296 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6297 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6298 c write (iout,*) "ireq,req",ireq,req(ireq)
6301 C Send the contacts to processors that need them
6302 do ii=1,ntask_cont_to
6303 iproc=itask_cont_to(ii)
6305 c write (iout,*) nn," contacts to processor",iproc,
6306 c & " of CONT_TO_COMM group"
6309 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6310 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6311 c write (iout,*) "ireq,req",ireq,req(ireq)
6313 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6317 c write (iout,*) "number of requests (contacts)",ireq
6318 c write (iout,*) "req",(req(i),i=1,4)
6321 & call MPI_Waitall(ireq,req,status_array,ierr)
6322 do iii=1,ntask_cont_from
6323 iproc=itask_cont_from(iii)
6326 write (iout,*) "Received",nn," contacts from processor",iproc,
6327 & " of CONT_FROM_COMM group"
6330 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6335 ii=zapas_recv(1,i,iii)
6336 c Flag the received contacts to prevent double-counting
6337 jj=-zapas_recv(2,i,iii)
6338 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6340 nnn=num_cont_hb(ii)+1
6343 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6344 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6345 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6346 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6347 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6348 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6349 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6350 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6351 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6352 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6353 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6354 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6355 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6356 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6357 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6358 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6359 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6360 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6361 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6362 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6363 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6364 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6365 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6366 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6371 write (iout,'(a)') 'Contact function values after receive:'
6373 write (iout,'(2i3,50(1x,i3,f5.2))')
6374 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6375 & j=1,num_cont_hb(i))
6382 write (iout,'(a)') 'Contact function values:'
6384 write (iout,'(2i3,50(1x,i3,f5.2))')
6385 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6386 & j=1,num_cont_hb(i))
6390 C Remove the loop below after debugging !!!
6397 C Calculate the local-electrostatic correlation terms
6398 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6400 num_conti=num_cont_hb(i)
6401 num_conti1=num_cont_hb(i+1)
6408 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6409 c & ' jj=',jj,' kk=',kk
6410 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6411 & .or. j.lt.0 .and. j1.gt.0) .and.
6412 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6413 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6414 C The system gains extra energy.
6415 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6416 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6417 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6419 else if (j1.eq.j) then
6420 C Contacts I-J and I-(J+1) occur simultaneously.
6421 C The system loses extra energy.
6422 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6427 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6428 c & ' jj=',jj,' kk=',kk
6430 C Contacts I-J and (I+1)-J occur simultaneously.
6431 C The system loses extra energy.
6432 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6439 c------------------------------------------------------------------------------
6440 subroutine add_hb_contact(ii,jj,itask)
6441 implicit real*8 (a-h,o-z)
6442 include "DIMENSIONS"
6443 include "COMMON.IOUNITS"
6446 parameter (max_cont=maxconts)
6447 parameter (max_dim=26)
6448 include "COMMON.CONTACTS"
6449 double precision zapas(max_dim,maxconts,max_fg_procs),
6450 & zapas_recv(max_dim,maxconts,max_fg_procs)
6451 common /przechowalnia/ zapas
6452 integer i,j,ii,jj,iproc,itask(4),nn
6453 c write (iout,*) "itask",itask
6456 if (iproc.gt.0) then
6457 do j=1,num_cont_hb(ii)
6459 c write (iout,*) "i",ii," j",jj," jjc",jjc
6461 ncont_sent(iproc)=ncont_sent(iproc)+1
6462 nn=ncont_sent(iproc)
6463 zapas(1,nn,iproc)=ii
6464 zapas(2,nn,iproc)=jjc
6465 zapas(3,nn,iproc)=facont_hb(j,ii)
6466 zapas(4,nn,iproc)=ees0p(j,ii)
6467 zapas(5,nn,iproc)=ees0m(j,ii)
6468 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6469 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6470 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6471 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6472 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6473 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6474 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6475 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6476 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6477 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6478 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6479 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6480 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6481 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6482 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6483 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6484 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6485 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6486 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6487 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6488 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6496 c------------------------------------------------------------------------------
6497 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6499 C This subroutine calculates multi-body contributions to hydrogen-bonding
6500 implicit real*8 (a-h,o-z)
6501 include 'DIMENSIONS'
6502 include 'COMMON.IOUNITS'
6505 parameter (max_cont=maxconts)
6506 parameter (max_dim=70)
6507 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6508 double precision zapas(max_dim,maxconts,max_fg_procs),
6509 & zapas_recv(max_dim,maxconts,max_fg_procs)
6510 common /przechowalnia/ zapas
6511 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6512 & status_array(MPI_STATUS_SIZE,maxconts*2)
6514 include 'COMMON.SETUP'
6515 include 'COMMON.FFIELD'
6516 include 'COMMON.DERIV'
6517 include 'COMMON.LOCAL'
6518 include 'COMMON.INTERACT'
6519 include 'COMMON.CONTACTS'
6520 include 'COMMON.CHAIN'
6521 include 'COMMON.CONTROL'
6522 double precision gx(3),gx1(3)
6523 integer num_cont_hb_old(maxres)
6525 double precision eello4,eello5,eelo6,eello_turn6
6526 external eello4,eello5,eello6,eello_turn6
6527 C Set lprn=.true. for debugging
6532 num_cont_hb_old(i)=num_cont_hb(i)
6536 if (nfgtasks.le.1) goto 30
6538 write (iout,'(a)') 'Contact function values before RECEIVE:'
6540 write (iout,'(2i3,50(1x,i2,f5.2))')
6541 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6542 & j=1,num_cont_hb(i))
6546 do i=1,ntask_cont_from
6549 do i=1,ntask_cont_to
6552 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6554 C Make the list of contacts to send to send to other procesors
6555 do i=iturn3_start,iturn3_end
6556 c write (iout,*) "make contact list turn3",i," num_cont",
6558 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6560 do i=iturn4_start,iturn4_end
6561 c write (iout,*) "make contact list turn4",i," num_cont",
6563 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6567 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6569 do j=1,num_cont_hb(i)
6572 iproc=iint_sent_local(k,jjc,ii)
6573 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6574 if (iproc.ne.0) then
6575 ncont_sent(iproc)=ncont_sent(iproc)+1
6576 nn=ncont_sent(iproc)
6578 zapas(2,nn,iproc)=jjc
6579 zapas(3,nn,iproc)=d_cont(j,i)
6583 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6588 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6596 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6607 & "Numbers of contacts to be sent to other processors",
6608 & (ncont_sent(i),i=1,ntask_cont_to)
6609 write (iout,*) "Contacts sent"
6610 do ii=1,ntask_cont_to
6612 iproc=itask_cont_to(ii)
6613 write (iout,*) nn," contacts to processor",iproc,
6614 & " of CONT_TO_COMM group"
6616 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6624 CorrelID1=nfgtasks+fg_rank+1
6626 C Receive the numbers of needed contacts from other processors
6627 do ii=1,ntask_cont_from
6628 iproc=itask_cont_from(ii)
6630 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6631 & FG_COMM,req(ireq),IERR)
6633 c write (iout,*) "IRECV ended"
6635 C Send the number of contacts needed by other processors
6636 do ii=1,ntask_cont_to
6637 iproc=itask_cont_to(ii)
6639 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6640 & FG_COMM,req(ireq),IERR)
6642 c write (iout,*) "ISEND ended"
6643 c write (iout,*) "number of requests (nn)",ireq
6646 & call MPI_Waitall(ireq,req,status_array,ierr)
6648 c & "Numbers of contacts to be received from other processors",
6649 c & (ncont_recv(i),i=1,ntask_cont_from)
6653 do ii=1,ntask_cont_from
6654 iproc=itask_cont_from(ii)
6656 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6657 c & " of CONT_TO_COMM group"
6661 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6662 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6663 c write (iout,*) "ireq,req",ireq,req(ireq)
6666 C Send the contacts to processors that need them
6667 do ii=1,ntask_cont_to
6668 iproc=itask_cont_to(ii)
6670 c write (iout,*) nn," contacts to processor",iproc,
6671 c & " of CONT_TO_COMM group"
6674 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6675 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6676 c write (iout,*) "ireq,req",ireq,req(ireq)
6678 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6682 c write (iout,*) "number of requests (contacts)",ireq
6683 c write (iout,*) "req",(req(i),i=1,4)
6686 & call MPI_Waitall(ireq,req,status_array,ierr)
6687 do iii=1,ntask_cont_from
6688 iproc=itask_cont_from(iii)
6691 write (iout,*) "Received",nn," contacts from processor",iproc,
6692 & " of CONT_FROM_COMM group"
6695 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6700 ii=zapas_recv(1,i,iii)
6701 c Flag the received contacts to prevent double-counting
6702 jj=-zapas_recv(2,i,iii)
6703 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6705 nnn=num_cont_hb(ii)+1
6708 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6712 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6717 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6725 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6734 write (iout,'(a)') 'Contact function values after receive:'
6736 write (iout,'(2i3,50(1x,i3,5f6.3))')
6737 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6738 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6745 write (iout,'(a)') 'Contact function values:'
6747 write (iout,'(2i3,50(1x,i2,5f6.3))')
6748 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6749 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6755 C Remove the loop below after debugging !!!
6762 C Calculate the dipole-dipole interaction energies
6763 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6764 do i=iatel_s,iatel_e+1
6765 num_conti=num_cont_hb(i)
6774 C Calculate the local-electrostatic correlation terms
6775 c write (iout,*) "gradcorr5 in eello5 before loop"
6777 c write (iout,'(i5,3f10.5)')
6778 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6780 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6781 c write (iout,*) "corr loop i",i
6783 num_conti=num_cont_hb(i)
6784 num_conti1=num_cont_hb(i+1)
6791 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6792 c & ' jj=',jj,' kk=',kk
6793 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6794 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6795 & .or. j.lt.0 .and. j1.gt.0) .and.
6796 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6797 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6798 C The system gains extra energy.
6800 sqd1=dsqrt(d_cont(jj,i))
6801 sqd2=dsqrt(d_cont(kk,i1))
6802 sred_geom = sqd1*sqd2
6803 IF (sred_geom.lt.cutoff_corr) THEN
6804 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6806 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6807 cd & ' jj=',jj,' kk=',kk
6808 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6809 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6811 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6812 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6815 cd write (iout,*) 'sred_geom=',sred_geom,
6816 cd & ' ekont=',ekont,' fprim=',fprimcont,
6817 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6818 cd write (iout,*) "g_contij",g_contij
6819 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6820 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6821 call calc_eello(i,jp,i+1,jp1,jj,kk)
6822 if (wcorr4.gt.0.0d0)
6823 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6824 if (energy_dec.and.wcorr4.gt.0.0d0)
6825 1 write (iout,'(a6,4i5,0pf7.3)')
6826 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6827 c write (iout,*) "gradcorr5 before eello5"
6829 c write (iout,'(i5,3f10.5)')
6830 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6832 if (wcorr5.gt.0.0d0)
6833 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6834 c write (iout,*) "gradcorr5 after eello5"
6836 c write (iout,'(i5,3f10.5)')
6837 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6839 if (energy_dec.and.wcorr5.gt.0.0d0)
6840 1 write (iout,'(a6,4i5,0pf7.3)')
6841 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6842 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6843 cd write(2,*)'ijkl',i,jp,i+1,jp1
6844 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6845 & .or. wturn6.eq.0.0d0))then
6846 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6847 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6848 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6849 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6850 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6851 cd & 'ecorr6=',ecorr6
6852 cd write (iout,'(4e15.5)') sred_geom,
6853 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6854 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6855 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6856 else if (wturn6.gt.0.0d0
6857 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6858 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6859 eturn6=eturn6+eello_turn6(i,jj,kk)
6860 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6861 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6862 cd write (2,*) 'multibody_eello:eturn6',eturn6
6871 num_cont_hb(i)=num_cont_hb_old(i)
6873 c write (iout,*) "gradcorr5 in eello5"
6875 c write (iout,'(i5,3f10.5)')
6876 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6880 c------------------------------------------------------------------------------
6881 subroutine add_hb_contact_eello(ii,jj,itask)
6882 implicit real*8 (a-h,o-z)
6883 include "DIMENSIONS"
6884 include "COMMON.IOUNITS"
6887 parameter (max_cont=maxconts)
6888 parameter (max_dim=70)
6889 include "COMMON.CONTACTS"
6890 double precision zapas(max_dim,maxconts,max_fg_procs),
6891 & zapas_recv(max_dim,maxconts,max_fg_procs)
6892 common /przechowalnia/ zapas
6893 integer i,j,ii,jj,iproc,itask(4),nn
6894 c write (iout,*) "itask",itask
6897 if (iproc.gt.0) then
6898 do j=1,num_cont_hb(ii)
6900 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6902 ncont_sent(iproc)=ncont_sent(iproc)+1
6903 nn=ncont_sent(iproc)
6904 zapas(1,nn,iproc)=ii
6905 zapas(2,nn,iproc)=jjc
6906 zapas(3,nn,iproc)=d_cont(j,ii)
6910 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6915 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6923 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6935 c------------------------------------------------------------------------------
6936 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6937 implicit real*8 (a-h,o-z)
6938 include 'DIMENSIONS'
6939 include 'COMMON.IOUNITS'
6940 include 'COMMON.DERIV'
6941 include 'COMMON.INTERACT'
6942 include 'COMMON.CONTACTS'
6943 double precision gx(3),gx1(3)
6953 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6954 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6955 C Following 4 lines for diagnostics.
6960 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6961 c & 'Contacts ',i,j,
6962 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6963 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6965 C Calculate the multi-body contribution to energy.
6966 c ecorr=ecorr+ekont*ees
6967 C Calculate multi-body contributions to the gradient.
6968 coeffpees0pij=coeffp*ees0pij
6969 coeffmees0mij=coeffm*ees0mij
6970 coeffpees0pkl=coeffp*ees0pkl
6971 coeffmees0mkl=coeffm*ees0mkl
6973 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6974 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6975 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6976 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6977 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6978 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6979 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6980 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6981 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6982 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6983 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6984 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6985 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6986 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6987 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6988 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6989 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6990 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6991 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6992 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6993 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6994 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6995 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6996 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6997 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7002 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7003 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7004 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7005 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7010 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7011 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7012 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7013 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7016 c write (iout,*) "ehbcorr",ekont*ees
7021 C---------------------------------------------------------------------------
7022 subroutine dipole(i,j,jj)
7023 implicit real*8 (a-h,o-z)
7024 include 'DIMENSIONS'
7025 include 'COMMON.IOUNITS'
7026 include 'COMMON.CHAIN'
7027 include 'COMMON.FFIELD'
7028 include 'COMMON.DERIV'
7029 include 'COMMON.INTERACT'
7030 include 'COMMON.CONTACTS'
7031 include 'COMMON.TORSION'
7032 include 'COMMON.VAR'
7033 include 'COMMON.GEO'
7034 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7036 iti1 = itortyp(itype(i+1))
7037 if (j.lt.nres-1) then
7038 itj1 = itortyp(itype(j+1))
7043 dipi(iii,1)=Ub2(iii,i)
7044 dipderi(iii)=Ub2der(iii,i)
7045 dipi(iii,2)=b1(iii,iti1)
7046 dipj(iii,1)=Ub2(iii,j)
7047 dipderj(iii)=Ub2der(iii,j)
7048 dipj(iii,2)=b1(iii,itj1)
7052 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7055 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7062 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7066 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7071 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7072 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7074 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7076 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7078 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7083 C---------------------------------------------------------------------------
7084 subroutine calc_eello(i,j,k,l,jj,kk)
7086 C This subroutine computes matrices and vectors needed to calculate
7087 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7089 implicit real*8 (a-h,o-z)
7090 include 'DIMENSIONS'
7091 include 'COMMON.IOUNITS'
7092 include 'COMMON.CHAIN'
7093 include 'COMMON.DERIV'
7094 include 'COMMON.INTERACT'
7095 include 'COMMON.CONTACTS'
7096 include 'COMMON.TORSION'
7097 include 'COMMON.VAR'
7098 include 'COMMON.GEO'
7099 include 'COMMON.FFIELD'
7100 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7101 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7104 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7105 cd & ' jj=',jj,' kk=',kk
7106 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7107 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7108 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7111 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7112 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7115 call transpose2(aa1(1,1),aa1t(1,1))
7116 call transpose2(aa2(1,1),aa2t(1,1))
7119 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7120 & aa1tder(1,1,lll,kkk))
7121 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7122 & aa2tder(1,1,lll,kkk))
7126 C parallel orientation of the two CA-CA-CA frames.
7128 iti=itortyp(itype(i))
7132 itk1=itortyp(itype(k+1))
7133 itj=itortyp(itype(j))
7134 if (l.lt.nres-1) then
7135 itl1=itortyp(itype(l+1))
7139 C A1 kernel(j+1) A2T
7141 cd write (iout,'(3f10.5,5x,3f10.5)')
7142 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7144 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7145 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7146 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7147 C Following matrices are needed only for 6-th order cumulants
7148 IF (wcorr6.gt.0.0d0) THEN
7149 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7150 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7151 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7152 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7153 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7154 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7155 & ADtEAderx(1,1,1,1,1,1))
7157 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7158 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7159 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7160 & ADtEA1derx(1,1,1,1,1,1))
7162 C End 6-th order cumulants
7165 cd write (2,*) 'In calc_eello6'
7167 cd write (2,*) 'iii=',iii
7169 cd write (2,*) 'kkk=',kkk
7171 cd write (2,'(3(2f10.5),5x)')
7172 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7177 call transpose2(EUgder(1,1,k),auxmat(1,1))
7178 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7179 call transpose2(EUg(1,1,k),auxmat(1,1))
7180 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7181 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7185 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7186 & EAEAderx(1,1,lll,kkk,iii,1))
7190 C A1T kernel(i+1) A2
7191 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7192 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7193 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7194 C Following matrices are needed only for 6-th order cumulants
7195 IF (wcorr6.gt.0.0d0) THEN
7196 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7197 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7198 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7199 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7200 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7201 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7202 & ADtEAderx(1,1,1,1,1,2))
7203 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7204 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7205 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7206 & ADtEA1derx(1,1,1,1,1,2))
7208 C End 6-th order cumulants
7209 call transpose2(EUgder(1,1,l),auxmat(1,1))
7210 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7211 call transpose2(EUg(1,1,l),auxmat(1,1))
7212 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7213 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7217 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7218 & EAEAderx(1,1,lll,kkk,iii,2))
7223 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7224 C They are needed only when the fifth- or the sixth-order cumulants are
7226 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7227 call transpose2(AEA(1,1,1),auxmat(1,1))
7228 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7229 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7230 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7231 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7232 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7233 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7234 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7235 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7236 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7237 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7238 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7239 call transpose2(AEA(1,1,2),auxmat(1,1))
7240 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7241 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7242 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7243 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7244 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7245 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7246 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7247 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7248 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7249 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7250 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7251 C Calculate the Cartesian derivatives of the vectors.
7255 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7256 call matvec2(auxmat(1,1),b1(1,iti),
7257 & AEAb1derx(1,lll,kkk,iii,1,1))
7258 call matvec2(auxmat(1,1),Ub2(1,i),
7259 & AEAb2derx(1,lll,kkk,iii,1,1))
7260 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7261 & AEAb1derx(1,lll,kkk,iii,2,1))
7262 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7263 & AEAb2derx(1,lll,kkk,iii,2,1))
7264 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7265 call matvec2(auxmat(1,1),b1(1,itj),
7266 & AEAb1derx(1,lll,kkk,iii,1,2))
7267 call matvec2(auxmat(1,1),Ub2(1,j),
7268 & AEAb2derx(1,lll,kkk,iii,1,2))
7269 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7270 & AEAb1derx(1,lll,kkk,iii,2,2))
7271 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7272 & AEAb2derx(1,lll,kkk,iii,2,2))
7279 C Antiparallel orientation of the two CA-CA-CA frames.
7281 iti=itortyp(itype(i))
7285 itk1=itortyp(itype(k+1))
7286 itl=itortyp(itype(l))
7287 itj=itortyp(itype(j))
7288 if (j.lt.nres-1) then
7289 itj1=itortyp(itype(j+1))
7293 C A2 kernel(j-1)T A1T
7294 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7295 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7296 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7297 C Following matrices are needed only for 6-th order cumulants
7298 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7299 & j.eq.i+4 .and. l.eq.i+3)) THEN
7300 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7301 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7302 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7303 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7304 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7305 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7306 & ADtEAderx(1,1,1,1,1,1))
7307 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7308 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7309 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7310 & ADtEA1derx(1,1,1,1,1,1))
7312 C End 6-th order cumulants
7313 call transpose2(EUgder(1,1,k),auxmat(1,1))
7314 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7315 call transpose2(EUg(1,1,k),auxmat(1,1))
7316 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7317 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7321 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7322 & EAEAderx(1,1,lll,kkk,iii,1))
7326 C A2T kernel(i+1)T A1
7327 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7328 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7329 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7330 C Following matrices are needed only for 6-th order cumulants
7331 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7332 & j.eq.i+4 .and. l.eq.i+3)) THEN
7333 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7334 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7335 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7336 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7337 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7338 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7339 & ADtEAderx(1,1,1,1,1,2))
7340 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7341 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7342 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7343 & ADtEA1derx(1,1,1,1,1,2))
7345 C End 6-th order cumulants
7346 call transpose2(EUgder(1,1,j),auxmat(1,1))
7347 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7348 call transpose2(EUg(1,1,j),auxmat(1,1))
7349 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7350 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7354 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7355 & EAEAderx(1,1,lll,kkk,iii,2))
7360 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7361 C They are needed only when the fifth- or the sixth-order cumulants are
7363 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7364 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7365 call transpose2(AEA(1,1,1),auxmat(1,1))
7366 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7367 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7368 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7369 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7370 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7371 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7372 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7373 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7374 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7375 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7376 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7377 call transpose2(AEA(1,1,2),auxmat(1,1))
7378 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7379 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7380 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7381 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7382 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7383 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7384 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7385 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7386 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7387 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7388 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7389 C Calculate the Cartesian derivatives of the vectors.
7393 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7394 call matvec2(auxmat(1,1),b1(1,iti),
7395 & AEAb1derx(1,lll,kkk,iii,1,1))
7396 call matvec2(auxmat(1,1),Ub2(1,i),
7397 & AEAb2derx(1,lll,kkk,iii,1,1))
7398 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7399 & AEAb1derx(1,lll,kkk,iii,2,1))
7400 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7401 & AEAb2derx(1,lll,kkk,iii,2,1))
7402 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7403 call matvec2(auxmat(1,1),b1(1,itl),
7404 & AEAb1derx(1,lll,kkk,iii,1,2))
7405 call matvec2(auxmat(1,1),Ub2(1,l),
7406 & AEAb2derx(1,lll,kkk,iii,1,2))
7407 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7408 & AEAb1derx(1,lll,kkk,iii,2,2))
7409 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7410 & AEAb2derx(1,lll,kkk,iii,2,2))
7419 C---------------------------------------------------------------------------
7420 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7421 & KK,KKderg,AKA,AKAderg,AKAderx)
7425 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7426 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7427 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7432 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7434 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7437 cd if (lprn) write (2,*) 'In kernel'
7439 cd if (lprn) write (2,*) 'kkk=',kkk
7441 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7442 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7444 cd write (2,*) 'lll=',lll
7445 cd write (2,*) 'iii=1'
7447 cd write (2,'(3(2f10.5),5x)')
7448 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7451 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7452 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7454 cd write (2,*) 'lll=',lll
7455 cd write (2,*) 'iii=2'
7457 cd write (2,'(3(2f10.5),5x)')
7458 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7465 C---------------------------------------------------------------------------
7466 double precision function eello4(i,j,k,l,jj,kk)
7467 implicit real*8 (a-h,o-z)
7468 include 'DIMENSIONS'
7469 include 'COMMON.IOUNITS'
7470 include 'COMMON.CHAIN'
7471 include 'COMMON.DERIV'
7472 include 'COMMON.INTERACT'
7473 include 'COMMON.CONTACTS'
7474 include 'COMMON.TORSION'
7475 include 'COMMON.VAR'
7476 include 'COMMON.GEO'
7477 double precision pizda(2,2),ggg1(3),ggg2(3)
7478 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7482 cd print *,'eello4:',i,j,k,l,jj,kk
7483 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7484 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7485 cold eij=facont_hb(jj,i)
7486 cold ekl=facont_hb(kk,k)
7488 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7489 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7490 gcorr_loc(k-1)=gcorr_loc(k-1)
7491 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7493 gcorr_loc(l-1)=gcorr_loc(l-1)
7494 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7496 gcorr_loc(j-1)=gcorr_loc(j-1)
7497 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7502 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7503 & -EAEAderx(2,2,lll,kkk,iii,1)
7504 cd derx(lll,kkk,iii)=0.0d0
7508 cd gcorr_loc(l-1)=0.0d0
7509 cd gcorr_loc(j-1)=0.0d0
7510 cd gcorr_loc(k-1)=0.0d0
7512 cd write (iout,*)'Contacts have occurred for peptide groups',
7513 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7514 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7515 if (j.lt.nres-1) then
7522 if (l.lt.nres-1) then
7530 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7531 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7532 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7533 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7534 cgrad ghalf=0.5d0*ggg1(ll)
7535 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7536 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7537 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7538 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7539 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7540 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7541 cgrad ghalf=0.5d0*ggg2(ll)
7542 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7543 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7544 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7545 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7546 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7547 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7551 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7556 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7561 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7566 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7570 cd write (2,*) iii,gcorr_loc(iii)
7573 cd write (2,*) 'ekont',ekont
7574 cd write (iout,*) 'eello4',ekont*eel4
7577 C---------------------------------------------------------------------------
7578 double precision function eello5(i,j,k,l,jj,kk)
7579 implicit real*8 (a-h,o-z)
7580 include 'DIMENSIONS'
7581 include 'COMMON.IOUNITS'
7582 include 'COMMON.CHAIN'
7583 include 'COMMON.DERIV'
7584 include 'COMMON.INTERACT'
7585 include 'COMMON.CONTACTS'
7586 include 'COMMON.TORSION'
7587 include 'COMMON.VAR'
7588 include 'COMMON.GEO'
7589 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7590 double precision ggg1(3),ggg2(3)
7591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7596 C /l\ / \ \ / \ / \ / C
7597 C / \ / \ \ / \ / \ / C
7598 C j| o |l1 | o | o| o | | o |o C
7599 C \ |/k\| |/ \| / |/ \| |/ \| C
7600 C \i/ \ / \ / / \ / \ C
7602 C (I) (II) (III) (IV) C
7604 C eello5_1 eello5_2 eello5_3 eello5_4 C
7606 C Antiparallel chains C
7609 C /j\ / \ \ / \ / \ / C
7610 C / \ / \ \ / \ / \ / C
7611 C j1| o |l | o | o| o | | o |o C
7612 C \ |/k\| |/ \| / |/ \| |/ \| C
7613 C \i/ \ / \ / / \ / \ C
7615 C (I) (II) (III) (IV) C
7617 C eello5_1 eello5_2 eello5_3 eello5_4 C
7619 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7621 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7622 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7627 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7629 itk=itortyp(itype(k))
7630 itl=itortyp(itype(l))
7631 itj=itortyp(itype(j))
7636 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7637 cd & eel5_3_num,eel5_4_num)
7641 derx(lll,kkk,iii)=0.0d0
7645 cd eij=facont_hb(jj,i)
7646 cd ekl=facont_hb(kk,k)
7648 cd write (iout,*)'Contacts have occurred for peptide groups',
7649 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7651 C Contribution from the graph I.
7652 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7653 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7654 call transpose2(EUg(1,1,k),auxmat(1,1))
7655 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7656 vv(1)=pizda(1,1)-pizda(2,2)
7657 vv(2)=pizda(1,2)+pizda(2,1)
7658 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7659 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7660 C Explicit gradient in virtual-dihedral angles.
7661 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7662 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7663 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7664 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7665 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7666 vv(1)=pizda(1,1)-pizda(2,2)
7667 vv(2)=pizda(1,2)+pizda(2,1)
7668 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7669 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7670 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7671 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7672 vv(1)=pizda(1,1)-pizda(2,2)
7673 vv(2)=pizda(1,2)+pizda(2,1)
7675 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7676 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7677 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7679 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7680 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7681 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7683 C Cartesian gradient
7687 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7689 vv(1)=pizda(1,1)-pizda(2,2)
7690 vv(2)=pizda(1,2)+pizda(2,1)
7691 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7692 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7693 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7699 C Contribution from graph II
7700 call transpose2(EE(1,1,itk),auxmat(1,1))
7701 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7702 vv(1)=pizda(1,1)+pizda(2,2)
7703 vv(2)=pizda(2,1)-pizda(1,2)
7704 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7705 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7706 C Explicit gradient in virtual-dihedral angles.
7707 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7708 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7709 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)+pizda(2,2)
7711 vv(2)=pizda(2,1)-pizda(1,2)
7713 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7714 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7715 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7717 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7718 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7719 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7721 C Cartesian gradient
7725 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7727 vv(1)=pizda(1,1)+pizda(2,2)
7728 vv(2)=pizda(2,1)-pizda(1,2)
7729 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7730 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7731 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7739 C Parallel orientation
7740 C Contribution from graph III
7741 call transpose2(EUg(1,1,l),auxmat(1,1))
7742 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7743 vv(1)=pizda(1,1)-pizda(2,2)
7744 vv(2)=pizda(1,2)+pizda(2,1)
7745 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7746 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7747 C Explicit gradient in virtual-dihedral angles.
7748 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7749 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7750 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7751 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7752 vv(1)=pizda(1,1)-pizda(2,2)
7753 vv(2)=pizda(1,2)+pizda(2,1)
7754 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7755 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7756 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7757 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7758 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7759 vv(1)=pizda(1,1)-pizda(2,2)
7760 vv(2)=pizda(1,2)+pizda(2,1)
7761 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7762 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7763 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7764 C Cartesian gradient
7768 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7770 vv(1)=pizda(1,1)-pizda(2,2)
7771 vv(2)=pizda(1,2)+pizda(2,1)
7772 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7773 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7774 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7779 C Contribution from graph IV
7781 call transpose2(EE(1,1,itl),auxmat(1,1))
7782 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7783 vv(1)=pizda(1,1)+pizda(2,2)
7784 vv(2)=pizda(2,1)-pizda(1,2)
7785 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7786 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7787 C Explicit gradient in virtual-dihedral angles.
7788 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7789 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7790 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7791 vv(1)=pizda(1,1)+pizda(2,2)
7792 vv(2)=pizda(2,1)-pizda(1,2)
7793 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7794 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7795 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7796 C Cartesian gradient
7800 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7802 vv(1)=pizda(1,1)+pizda(2,2)
7803 vv(2)=pizda(2,1)-pizda(1,2)
7804 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7805 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7806 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7811 C Antiparallel orientation
7812 C Contribution from graph III
7814 call transpose2(EUg(1,1,j),auxmat(1,1))
7815 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7816 vv(1)=pizda(1,1)-pizda(2,2)
7817 vv(2)=pizda(1,2)+pizda(2,1)
7818 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7819 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7820 C Explicit gradient in virtual-dihedral angles.
7821 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7822 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7823 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7824 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7825 vv(1)=pizda(1,1)-pizda(2,2)
7826 vv(2)=pizda(1,2)+pizda(2,1)
7827 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7828 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7829 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7830 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7831 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7832 vv(1)=pizda(1,1)-pizda(2,2)
7833 vv(2)=pizda(1,2)+pizda(2,1)
7834 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7835 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7836 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7837 C Cartesian gradient
7841 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7843 vv(1)=pizda(1,1)-pizda(2,2)
7844 vv(2)=pizda(1,2)+pizda(2,1)
7845 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7846 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7847 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7852 C Contribution from graph IV
7854 call transpose2(EE(1,1,itj),auxmat(1,1))
7855 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7856 vv(1)=pizda(1,1)+pizda(2,2)
7857 vv(2)=pizda(2,1)-pizda(1,2)
7858 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7859 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7860 C Explicit gradient in virtual-dihedral angles.
7861 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7862 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7863 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7864 vv(1)=pizda(1,1)+pizda(2,2)
7865 vv(2)=pizda(2,1)-pizda(1,2)
7866 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7867 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7868 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7869 C Cartesian gradient
7873 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7875 vv(1)=pizda(1,1)+pizda(2,2)
7876 vv(2)=pizda(2,1)-pizda(1,2)
7877 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7878 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7879 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7885 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7886 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7887 cd write (2,*) 'ijkl',i,j,k,l
7888 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7889 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7891 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7892 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7893 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7894 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7895 if (j.lt.nres-1) then
7902 if (l.lt.nres-1) then
7912 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7913 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7914 C summed up outside the subrouine as for the other subroutines
7915 C handling long-range interactions. The old code is commented out
7916 C with "cgrad" to keep track of changes.
7918 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7919 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7920 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7921 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7922 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7923 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7924 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7925 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7926 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7927 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7929 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7930 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7931 cgrad ghalf=0.5d0*ggg1(ll)
7933 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7934 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7935 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7936 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7937 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7938 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7939 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7940 cgrad ghalf=0.5d0*ggg2(ll)
7942 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7943 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7944 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7945 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7946 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7947 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7952 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7953 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7958 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7959 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7965 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7970 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7974 cd write (2,*) iii,g_corr5_loc(iii)
7977 cd write (2,*) 'ekont',ekont
7978 cd write (iout,*) 'eello5',ekont*eel5
7981 c--------------------------------------------------------------------------
7982 double precision function eello6(i,j,k,l,jj,kk)
7983 implicit real*8 (a-h,o-z)
7984 include 'DIMENSIONS'
7985 include 'COMMON.IOUNITS'
7986 include 'COMMON.CHAIN'
7987 include 'COMMON.DERIV'
7988 include 'COMMON.INTERACT'
7989 include 'COMMON.CONTACTS'
7990 include 'COMMON.TORSION'
7991 include 'COMMON.VAR'
7992 include 'COMMON.GEO'
7993 include 'COMMON.FFIELD'
7994 double precision ggg1(3),ggg2(3)
7995 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8000 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8008 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8009 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8013 derx(lll,kkk,iii)=0.0d0
8017 cd eij=facont_hb(jj,i)
8018 cd ekl=facont_hb(kk,k)
8024 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8025 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8026 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8027 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8028 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8029 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8031 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8032 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8033 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8034 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8035 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8036 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8040 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8042 C If turn contributions are considered, they will be handled separately.
8043 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8044 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8045 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8046 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8047 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8048 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8049 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8051 if (j.lt.nres-1) then
8058 if (l.lt.nres-1) then
8066 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8067 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8068 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8069 cgrad ghalf=0.5d0*ggg1(ll)
8071 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8072 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8073 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8074 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8075 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8076 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8077 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8078 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8079 cgrad ghalf=0.5d0*ggg2(ll)
8080 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8082 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8083 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8084 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8085 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8086 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8087 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8092 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8093 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8098 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8099 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8105 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8110 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8114 cd write (2,*) iii,g_corr6_loc(iii)
8117 cd write (2,*) 'ekont',ekont
8118 cd write (iout,*) 'eello6',ekont*eel6
8121 c--------------------------------------------------------------------------
8122 double precision function eello6_graph1(i,j,k,l,imat,swap)
8123 implicit real*8 (a-h,o-z)
8124 include 'DIMENSIONS'
8125 include 'COMMON.IOUNITS'
8126 include 'COMMON.CHAIN'
8127 include 'COMMON.DERIV'
8128 include 'COMMON.INTERACT'
8129 include 'COMMON.CONTACTS'
8130 include 'COMMON.TORSION'
8131 include 'COMMON.VAR'
8132 include 'COMMON.GEO'
8133 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8137 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8139 C Parallel Antiparallel
8145 C \ j|/k\| / \ |/k\|l /
8150 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8151 itk=itortyp(itype(k))
8152 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8153 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8154 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8155 call transpose2(EUgC(1,1,k),auxmat(1,1))
8156 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8157 vv1(1)=pizda1(1,1)-pizda1(2,2)
8158 vv1(2)=pizda1(1,2)+pizda1(2,1)
8159 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8160 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8161 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8162 s5=scalar2(vv(1),Dtobr2(1,i))
8163 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8164 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8165 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8166 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8167 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8168 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8169 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8170 & +scalar2(vv(1),Dtobr2der(1,i)))
8171 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8172 vv1(1)=pizda1(1,1)-pizda1(2,2)
8173 vv1(2)=pizda1(1,2)+pizda1(2,1)
8174 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8175 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8177 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8178 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8179 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8180 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8181 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8183 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8184 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8185 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8186 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8187 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8189 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8190 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8191 vv1(1)=pizda1(1,1)-pizda1(2,2)
8192 vv1(2)=pizda1(1,2)+pizda1(2,1)
8193 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8194 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8195 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8196 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8205 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8206 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8207 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8208 call transpose2(EUgC(1,1,k),auxmat(1,1))
8209 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8211 vv1(1)=pizda1(1,1)-pizda1(2,2)
8212 vv1(2)=pizda1(1,2)+pizda1(2,1)
8213 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8214 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8215 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8216 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8217 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8218 s5=scalar2(vv(1),Dtobr2(1,i))
8219 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8225 c----------------------------------------------------------------------------
8226 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8227 implicit real*8 (a-h,o-z)
8228 include 'DIMENSIONS'
8229 include 'COMMON.IOUNITS'
8230 include 'COMMON.CHAIN'
8231 include 'COMMON.DERIV'
8232 include 'COMMON.INTERACT'
8233 include 'COMMON.CONTACTS'
8234 include 'COMMON.TORSION'
8235 include 'COMMON.VAR'
8236 include 'COMMON.GEO'
8238 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8239 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8242 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8244 C Parallel Antiparallel C
8250 C \ j|/k\| \ |/k\|l C
8255 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8256 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8257 C AL 7/4/01 s1 would occur in the sixth-order moment,
8258 C but not in a cluster cumulant
8260 s1=dip(1,jj,i)*dip(1,kk,k)
8262 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8263 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8264 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8265 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8266 call transpose2(EUg(1,1,k),auxmat(1,1))
8267 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8268 vv(1)=pizda(1,1)-pizda(2,2)
8269 vv(2)=pizda(1,2)+pizda(2,1)
8270 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8271 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8273 eello6_graph2=-(s1+s2+s3+s4)
8275 eello6_graph2=-(s2+s3+s4)
8278 C Derivatives in gamma(i-1)
8281 s1=dipderg(1,jj,i)*dip(1,kk,k)
8283 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8284 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8285 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8286 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8288 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8290 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8292 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8294 C Derivatives in gamma(k-1)
8296 s1=dip(1,jj,i)*dipderg(1,kk,k)
8298 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8299 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8300 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8301 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8302 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8303 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8304 vv(1)=pizda(1,1)-pizda(2,2)
8305 vv(2)=pizda(1,2)+pizda(2,1)
8306 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8308 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8310 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8312 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8313 C Derivatives in gamma(j-1) or gamma(l-1)
8316 s1=dipderg(3,jj,i)*dip(1,kk,k)
8318 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8319 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8320 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8321 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8322 vv(1)=pizda(1,1)-pizda(2,2)
8323 vv(2)=pizda(1,2)+pizda(2,1)
8324 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8327 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8329 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8332 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8333 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8335 C Derivatives in gamma(l-1) or gamma(j-1)
8338 s1=dip(1,jj,i)*dipderg(3,kk,k)
8340 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8341 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8342 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8343 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8344 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8345 vv(1)=pizda(1,1)-pizda(2,2)
8346 vv(2)=pizda(1,2)+pizda(2,1)
8347 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8350 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8352 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8355 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8356 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8358 C Cartesian derivatives.
8360 write (2,*) 'In eello6_graph2'
8362 write (2,*) 'iii=',iii
8364 write (2,*) 'kkk=',kkk
8366 write (2,'(3(2f10.5),5x)')
8367 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8377 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8379 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8382 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8384 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8385 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8387 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8388 call transpose2(EUg(1,1,k),auxmat(1,1))
8389 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8391 vv(1)=pizda(1,1)-pizda(2,2)
8392 vv(2)=pizda(1,2)+pizda(2,1)
8393 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8394 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8396 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8398 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8401 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8403 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8410 c----------------------------------------------------------------------------
8411 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8412 implicit real*8 (a-h,o-z)
8413 include 'DIMENSIONS'
8414 include 'COMMON.IOUNITS'
8415 include 'COMMON.CHAIN'
8416 include 'COMMON.DERIV'
8417 include 'COMMON.INTERACT'
8418 include 'COMMON.CONTACTS'
8419 include 'COMMON.TORSION'
8420 include 'COMMON.VAR'
8421 include 'COMMON.GEO'
8422 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8424 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8426 C Parallel Antiparallel C
8432 C j|/k\| / |/k\|l / C
8437 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8439 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8440 C energy moment and not to the cluster cumulant.
8441 iti=itortyp(itype(i))
8442 if (j.lt.nres-1) then
8443 itj1=itortyp(itype(j+1))
8447 itk=itortyp(itype(k))
8448 itk1=itortyp(itype(k+1))
8449 if (l.lt.nres-1) then
8450 itl1=itortyp(itype(l+1))
8455 s1=dip(4,jj,i)*dip(4,kk,k)
8457 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8458 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8459 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8460 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8461 call transpose2(EE(1,1,itk),auxmat(1,1))
8462 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8463 vv(1)=pizda(1,1)+pizda(2,2)
8464 vv(2)=pizda(2,1)-pizda(1,2)
8465 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8466 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8467 cd & "sum",-(s2+s3+s4)
8469 eello6_graph3=-(s1+s2+s3+s4)
8471 eello6_graph3=-(s2+s3+s4)
8474 C Derivatives in gamma(k-1)
8475 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8476 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8477 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8478 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8479 C Derivatives in gamma(l-1)
8480 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8481 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8482 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8483 vv(1)=pizda(1,1)+pizda(2,2)
8484 vv(2)=pizda(2,1)-pizda(1,2)
8485 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8486 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8487 C Cartesian derivatives.
8493 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8495 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8498 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8500 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8501 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8503 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8504 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8506 vv(1)=pizda(1,1)+pizda(2,2)
8507 vv(2)=pizda(2,1)-pizda(1,2)
8508 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8510 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8512 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8515 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8517 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8519 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8525 c----------------------------------------------------------------------------
8526 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8527 implicit real*8 (a-h,o-z)
8528 include 'DIMENSIONS'
8529 include 'COMMON.IOUNITS'
8530 include 'COMMON.CHAIN'
8531 include 'COMMON.DERIV'
8532 include 'COMMON.INTERACT'
8533 include 'COMMON.CONTACTS'
8534 include 'COMMON.TORSION'
8535 include 'COMMON.VAR'
8536 include 'COMMON.GEO'
8537 include 'COMMON.FFIELD'
8538 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8539 & auxvec1(2),auxmat1(2,2)
8541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8543 C Parallel Antiparallel C
8549 C \ j|/k\| \ |/k\|l C
8554 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8556 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8557 C energy moment and not to the cluster cumulant.
8558 cd write (2,*) 'eello_graph4: wturn6',wturn6
8559 iti=itortyp(itype(i))
8560 itj=itortyp(itype(j))
8561 if (j.lt.nres-1) then
8562 itj1=itortyp(itype(j+1))
8566 itk=itortyp(itype(k))
8567 if (k.lt.nres-1) then
8568 itk1=itortyp(itype(k+1))
8572 itl=itortyp(itype(l))
8573 if (l.lt.nres-1) then
8574 itl1=itortyp(itype(l+1))
8578 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8579 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8580 cd & ' itl',itl,' itl1',itl1
8583 s1=dip(3,jj,i)*dip(3,kk,k)
8585 s1=dip(2,jj,j)*dip(2,kk,l)
8588 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8589 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8591 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8592 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8594 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8595 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8597 call transpose2(EUg(1,1,k),auxmat(1,1))
8598 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8599 vv(1)=pizda(1,1)-pizda(2,2)
8600 vv(2)=pizda(2,1)+pizda(1,2)
8601 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8602 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8604 eello6_graph4=-(s1+s2+s3+s4)
8606 eello6_graph4=-(s2+s3+s4)
8608 C Derivatives in gamma(i-1)
8612 s1=dipderg(2,jj,i)*dip(3,kk,k)
8614 s1=dipderg(4,jj,j)*dip(2,kk,l)
8617 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8619 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8620 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8622 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8623 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8625 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8626 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8627 cd write (2,*) 'turn6 derivatives'
8629 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8631 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8635 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8637 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8641 C Derivatives in gamma(k-1)
8644 s1=dip(3,jj,i)*dipderg(2,kk,k)
8646 s1=dip(2,jj,j)*dipderg(4,kk,l)
8649 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8650 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8652 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8653 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8655 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8656 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8658 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8659 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8660 vv(1)=pizda(1,1)-pizda(2,2)
8661 vv(2)=pizda(2,1)+pizda(1,2)
8662 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8663 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8665 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8667 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8671 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8673 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8676 C Derivatives in gamma(j-1) or gamma(l-1)
8677 if (l.eq.j+1 .and. l.gt.1) then
8678 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8679 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8680 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8681 vv(1)=pizda(1,1)-pizda(2,2)
8682 vv(2)=pizda(2,1)+pizda(1,2)
8683 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8684 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8685 else if (j.gt.1) then
8686 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8687 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8688 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8689 vv(1)=pizda(1,1)-pizda(2,2)
8690 vv(2)=pizda(2,1)+pizda(1,2)
8691 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8692 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8693 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8695 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8698 C Cartesian derivatives.
8705 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8707 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8711 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8713 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8717 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8719 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8721 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8722 & b1(1,itj1),auxvec(1))
8723 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8725 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8726 & b1(1,itl1),auxvec(1))
8727 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8729 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8731 vv(1)=pizda(1,1)-pizda(2,2)
8732 vv(2)=pizda(2,1)+pizda(1,2)
8733 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8735 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8737 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8740 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8743 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8746 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8748 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8750 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8754 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8756 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8759 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8761 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8769 c----------------------------------------------------------------------------
8770 double precision function eello_turn6(i,jj,kk)
8771 implicit real*8 (a-h,o-z)
8772 include 'DIMENSIONS'
8773 include 'COMMON.IOUNITS'
8774 include 'COMMON.CHAIN'
8775 include 'COMMON.DERIV'
8776 include 'COMMON.INTERACT'
8777 include 'COMMON.CONTACTS'
8778 include 'COMMON.TORSION'
8779 include 'COMMON.VAR'
8780 include 'COMMON.GEO'
8781 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8782 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8784 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8785 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8786 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8787 C the respective energy moment and not to the cluster cumulant.
8796 iti=itortyp(itype(i))
8797 itk=itortyp(itype(k))
8798 itk1=itortyp(itype(k+1))
8799 itl=itortyp(itype(l))
8800 itj=itortyp(itype(j))
8801 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8802 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8803 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8808 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8810 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8814 derx_turn(lll,kkk,iii)=0.0d0
8821 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8823 cd write (2,*) 'eello6_5',eello6_5
8825 call transpose2(AEA(1,1,1),auxmat(1,1))
8826 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8827 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8828 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8830 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8831 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8832 s2 = scalar2(b1(1,itk),vtemp1(1))
8834 call transpose2(AEA(1,1,2),atemp(1,1))
8835 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8836 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8837 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8839 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8840 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8841 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8843 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8844 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8845 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8846 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8847 ss13 = scalar2(b1(1,itk),vtemp4(1))
8848 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8850 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8856 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8857 C Derivatives in gamma(i+2)
8861 call transpose2(AEA(1,1,1),auxmatd(1,1))
8862 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8863 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8864 call transpose2(AEAderg(1,1,2),atempd(1,1))
8865 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8866 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8868 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8869 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8870 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8876 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8877 C Derivatives in gamma(i+3)
8879 call transpose2(AEA(1,1,1),auxmatd(1,1))
8880 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8881 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8882 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8884 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8885 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8886 s2d = scalar2(b1(1,itk),vtemp1d(1))
8888 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8889 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8891 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8893 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8894 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8895 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8903 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8904 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8906 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8907 & -0.5d0*ekont*(s2d+s12d)
8909 C Derivatives in gamma(i+4)
8910 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8911 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8912 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8914 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8915 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8916 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8924 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8926 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8928 C Derivatives in gamma(i+5)
8930 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8931 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8932 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8934 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8935 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8936 s2d = scalar2(b1(1,itk),vtemp1d(1))
8938 call transpose2(AEA(1,1,2),atempd(1,1))
8939 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8940 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8942 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8943 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8945 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8946 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8947 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8955 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8956 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8958 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8959 & -0.5d0*ekont*(s2d+s12d)
8961 C Cartesian derivatives
8966 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8967 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8968 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8970 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8971 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8973 s2d = scalar2(b1(1,itk),vtemp1d(1))
8975 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8976 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8977 s8d = -(atempd(1,1)+atempd(2,2))*
8978 & scalar2(cc(1,1,itl),vtemp2(1))
8980 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8982 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8983 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8990 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8993 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8997 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8998 & - 0.5d0*(s8d+s12d)
9000 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9009 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9011 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9012 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9013 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9014 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9015 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9017 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9018 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9019 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9023 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9024 cd & 16*eel_turn6_num
9026 if (j.lt.nres-1) then
9033 if (l.lt.nres-1) then
9041 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9042 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9043 cgrad ghalf=0.5d0*ggg1(ll)
9045 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9046 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9047 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9048 & +ekont*derx_turn(ll,2,1)
9049 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9050 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9051 & +ekont*derx_turn(ll,4,1)
9052 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9053 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9054 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9055 cgrad ghalf=0.5d0*ggg2(ll)
9057 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9058 & +ekont*derx_turn(ll,2,2)
9059 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9060 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9061 & +ekont*derx_turn(ll,4,2)
9062 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9063 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9064 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9069 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9074 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9080 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9085 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9089 cd write (2,*) iii,g_corr6_loc(iii)
9091 eello_turn6=ekont*eel_turn6
9092 cd write (2,*) 'ekont',ekont
9093 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9097 C-----------------------------------------------------------------------------
9098 double precision function scalar(u,v)
9099 !DIR$ INLINEALWAYS scalar
9101 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9104 double precision u(3),v(3)
9105 cd double precision sc
9113 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9116 crc-------------------------------------------------
9117 SUBROUTINE MATVEC2(A1,V1,V2)
9118 !DIR$ INLINEALWAYS MATVEC2
9120 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9122 implicit real*8 (a-h,o-z)
9123 include 'DIMENSIONS'
9124 DIMENSION A1(2,2),V1(2),V2(2)
9128 c 3 VI=VI+A1(I,K)*V1(K)
9132 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9133 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9138 C---------------------------------------
9139 SUBROUTINE MATMAT2(A1,A2,A3)
9141 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9143 implicit real*8 (a-h,o-z)
9144 include 'DIMENSIONS'
9145 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9146 c DIMENSION AI3(2,2)
9150 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9156 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9157 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9158 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9159 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9167 c-------------------------------------------------------------------------
9168 double precision function scalar2(u,v)
9169 !DIR$ INLINEALWAYS scalar2
9171 double precision u(2),v(2)
9174 scalar2=u(1)*v(1)+u(2)*v(2)
9178 C-----------------------------------------------------------------------------
9180 subroutine transpose2(a,at)
9181 !DIR$ INLINEALWAYS transpose2
9183 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9186 double precision a(2,2),at(2,2)
9193 c--------------------------------------------------------------------------
9194 subroutine transpose(n,a,at)
9197 double precision a(n,n),at(n,n)
9205 C---------------------------------------------------------------------------
9206 subroutine prodmat3(a1,a2,kk,transp,prod)
9207 !DIR$ INLINEALWAYS prodmat3
9209 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9213 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9215 crc double precision auxmat(2,2),prod_(2,2)
9218 crc call transpose2(kk(1,1),auxmat(1,1))
9219 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9220 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9222 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9223 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9224 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9225 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9226 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9227 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9228 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9229 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9232 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9233 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9235 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9236 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9237 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9238 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9239 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9240 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9241 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9242 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9245 c call transpose2(a2(1,1),a2t(1,1))
9248 crc print *,((prod_(i,j),i=1,2),j=1,2)
9249 crc print *,((prod(i,j),i=1,2),j=1,2)