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
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 C print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 C write(iout,*) "zaczynam liczyc energie"
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
121 C write(iout,*) "skonczylem ipoty"
124 C Calculate electrostatic (H-bonding) energy of the main chain.
127 C write(iout,*) "skonczylem ipoty"
129 cmc Sep-06: egb takes care of dynamic ss bonds too
131 c if (dyn_ss) call dyn_set_nss
133 c print *,"Processor",myrank," computed USCSC"
139 time_vec=time_vec+MPI_Wtime()-time01
141 c print *,"Processor",myrank," left VEC_AND_DERIV"
144 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
145 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
146 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
147 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
149 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
150 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
151 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
152 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
154 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
163 c write (iout,*) "Soft-spheer ELEC potential"
164 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
167 c print *,"Processor",myrank," computed UELEC"
169 C Calculate excluded-volume interaction energy between peptide groups
174 call escp(evdw2,evdw2_14)
180 c write (iout,*) "Soft-sphere SCP potential"
181 call escp_soft_sphere(evdw2,evdw2_14)
184 c Calculate the bond-stretching energy
188 C Calculate the disulfide-bridge and other energy and the contributions
189 C from other distance constraints.
190 cd print *,'Calling EHPB'
192 cd print *,'EHPB exitted succesfully.'
194 C Calculate the virtual-bond-angle energy.
196 if (wang.gt.0d0) then
201 c print *,"Processor",myrank," computed UB"
203 C Calculate the SC local energy.
206 c print *,"Processor",myrank," computed USC"
208 C Calculate the virtual-bond torsional energy.
210 cd print *,'nterm=',nterm
212 call etor(etors,edihcnstr)
217 c print *,"Processor",myrank," computed Utor"
219 C 6/23/01 Calculate double-torsional energy
221 if (wtor_d.gt.0) then
226 c print *,"Processor",myrank," computed Utord"
228 C 21/5/07 Calculate local sicdechain correlation energy
230 if (wsccor.gt.0.0d0) then
231 call eback_sc_corr(esccor)
235 c print *,"Processor",myrank," computed Usccorr"
237 C 12/1/95 Multi-body terms
241 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
242 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
243 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
244 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
245 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
252 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
253 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
254 cd write (iout,*) "multibody_hb ecorr",ecorr
256 c print *,"Processor",myrank," computed Ucorr"
258 C If performing constraint dynamics, call the constraint energy
259 C after the equilibration time
260 if(usampl.and.totT.gt.eq_time) then
268 time_enecalc=time_enecalc+MPI_Wtime()-time00
270 c print *,"Processor",myrank," computed Uconstr"
279 energia(2)=evdw2-evdw2_14
296 energia(8)=eello_turn3
297 energia(9)=eello_turn4
304 energia(19)=edihcnstr
306 energia(20)=Uconst+Uconst_back
308 c print *," Processor",myrank," calls SUM_ENERGY"
309 call sum_energy(energia,.true.)
310 if (dyn_ss) call dyn_set_nss
311 c print *," Processor",myrank," left SUM_ENERGY"
313 time_sumene=time_sumene+MPI_Wtime()-time00
317 c-------------------------------------------------------------------------------
318 subroutine sum_energy(energia,reduce)
319 implicit real*8 (a-h,o-z)
324 cMS$ATTRIBUTES C :: proc_proc
330 include 'COMMON.SETUP'
331 include 'COMMON.IOUNITS'
332 double precision energia(0:n_ene),enebuff(0:n_ene+1)
333 include 'COMMON.FFIELD'
334 include 'COMMON.DERIV'
335 include 'COMMON.INTERACT'
336 include 'COMMON.SBRIDGE'
337 include 'COMMON.CHAIN'
339 include 'COMMON.CONTROL'
340 include 'COMMON.TIME1'
343 if (nfgtasks.gt.1 .and. reduce) then
345 write (iout,*) "energies before REDUCE"
346 call enerprint(energia)
350 enebuff(i)=energia(i)
353 call MPI_Barrier(FG_COMM,IERR)
354 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
356 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
357 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
359 write (iout,*) "energies after REDUCE"
360 call enerprint(energia)
363 time_Reduce=time_Reduce+MPI_Wtime()-time00
365 if (fg_rank.eq.0) then
369 evdw2=energia(2)+energia(18)
385 eello_turn3=energia(8)
386 eello_turn4=energia(9)
393 edihcnstr=energia(19)
398 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
399 & +wang*ebe+wtor*etors+wscloc*escloc
400 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
401 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
402 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
403 & +wbond*estr+Uconst+wsccor*esccor
405 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
406 & +wang*ebe+wtor*etors+wscloc*escloc
407 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
408 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
409 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
410 & +wbond*estr+Uconst+wsccor*esccor
416 if (isnan(etot).ne.0) energia(0)=1.0d+99
418 if (isnan(etot)) energia(0)=1.0d+99
423 idumm=proc_proc(etot,i)
425 call proc_proc(etot,i)
427 if(i.eq.1)energia(0)=1.0d+99
434 c-------------------------------------------------------------------------------
435 subroutine sum_gradient
436 implicit real*8 (a-h,o-z)
441 cMS$ATTRIBUTES C :: proc_proc
447 double precision gradbufc(3,maxres),gradbufx(3,maxres),
448 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
449 include 'COMMON.SETUP'
450 include 'COMMON.IOUNITS'
451 include 'COMMON.FFIELD'
452 include 'COMMON.DERIV'
453 include 'COMMON.INTERACT'
454 include 'COMMON.SBRIDGE'
455 include 'COMMON.CHAIN'
457 include 'COMMON.CONTROL'
458 include 'COMMON.TIME1'
459 include 'COMMON.MAXGRAD'
460 include 'COMMON.SCCOR'
465 write (iout,*) "sum_gradient gvdwc, gvdwx"
467 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
468 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
473 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
474 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
475 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
478 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
479 C in virtual-bond-vector coordinates
482 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
484 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
485 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
487 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
489 c write (iout,'(i5,3f10.5,2x,f10.5)')
490 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
492 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
494 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
495 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
503 gradbufc(j,i)=wsc*gvdwc(j,i)+
504 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
505 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
506 & wel_loc*gel_loc_long(j,i)+
507 & wcorr*gradcorr_long(j,i)+
508 & wcorr5*gradcorr5_long(j,i)+
509 & wcorr6*gradcorr6_long(j,i)+
510 & wturn6*gcorr6_turn_long(j,i)+
517 gradbufc(j,i)=wsc*gvdwc(j,i)+
518 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
519 & welec*gelc_long(j,i)+
521 & wel_loc*gel_loc_long(j,i)+
522 & wcorr*gradcorr_long(j,i)+
523 & wcorr5*gradcorr5_long(j,i)+
524 & wcorr6*gradcorr6_long(j,i)+
525 & wturn6*gcorr6_turn_long(j,i)+
531 if (nfgtasks.gt.1) then
534 write (iout,*) "gradbufc before allreduce"
536 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
542 gradbufc_sum(j,i)=gradbufc(j,i)
545 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
546 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
547 c time_reduce=time_reduce+MPI_Wtime()-time00
549 c write (iout,*) "gradbufc_sum after allreduce"
551 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
556 c time_allreduce=time_allreduce+MPI_Wtime()-time00
564 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
565 write (iout,*) (i," jgrad_start",jgrad_start(i),
566 & " jgrad_end ",jgrad_end(i),
567 & i=igrad_start,igrad_end)
570 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
571 c do not parallelize this part.
573 c do i=igrad_start,igrad_end
574 c do j=jgrad_start(i),jgrad_end(i)
576 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
581 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
585 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
589 write (iout,*) "gradbufc after summing"
591 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
598 write (iout,*) "gradbufc"
600 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
606 gradbufc_sum(j,i)=gradbufc(j,i)
611 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
615 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
620 c gradbufc(k,i)=0.0d0
624 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
629 write (iout,*) "gradbufc after summing"
631 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
639 gradbufc(k,nres)=0.0d0
644 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
645 & wel_loc*gel_loc(j,i)+
646 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
647 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
648 & wel_loc*gel_loc_long(j,i)+
649 & wcorr*gradcorr_long(j,i)+
650 & wcorr5*gradcorr5_long(j,i)+
651 & wcorr6*gradcorr6_long(j,i)+
652 & wturn6*gcorr6_turn_long(j,i))+
654 & wcorr*gradcorr(j,i)+
655 & wturn3*gcorr3_turn(j,i)+
656 & wturn4*gcorr4_turn(j,i)+
657 & wcorr5*gradcorr5(j,i)+
658 & wcorr6*gradcorr6(j,i)+
659 & wturn6*gcorr6_turn(j,i)+
660 & wsccor*gsccorc(j,i)
661 & +wscloc*gscloc(j,i)
663 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
664 & wel_loc*gel_loc(j,i)+
665 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
666 & welec*gelc_long(j,i)
667 & wel_loc*gel_loc_long(j,i)+
668 & wcorr*gcorr_long(j,i)+
669 & wcorr5*gradcorr5_long(j,i)+
670 & wcorr6*gradcorr6_long(j,i)+
671 & wturn6*gcorr6_turn_long(j,i))+
673 & wcorr*gradcorr(j,i)+
674 & wturn3*gcorr3_turn(j,i)+
675 & wturn4*gcorr4_turn(j,i)+
676 & wcorr5*gradcorr5(j,i)+
677 & wcorr6*gradcorr6(j,i)+
678 & wturn6*gcorr6_turn(j,i)+
679 & wsccor*gsccorc(j,i)
680 & +wscloc*gscloc(j,i)
682 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
684 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
685 & wsccor*gsccorx(j,i)
686 & +wscloc*gsclocx(j,i)
690 write (iout,*) "gloc before adding corr"
692 write (iout,*) i,gloc(i,icg)
696 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
697 & +wcorr5*g_corr5_loc(i)
698 & +wcorr6*g_corr6_loc(i)
699 & +wturn4*gel_loc_turn4(i)
700 & +wturn3*gel_loc_turn3(i)
701 & +wturn6*gel_loc_turn6(i)
702 & +wel_loc*gel_loc_loc(i)
705 write (iout,*) "gloc after adding corr"
707 write (iout,*) i,gloc(i,icg)
711 if (nfgtasks.gt.1) then
714 gradbufc(j,i)=gradc(j,i,icg)
715 gradbufx(j,i)=gradx(j,i,icg)
719 glocbuf(i)=gloc(i,icg)
723 write (iout,*) "gloc_sc before reduce"
726 write (iout,*) i,j,gloc_sc(j,i,icg)
733 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
737 call MPI_Barrier(FG_COMM,IERR)
738 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
740 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
741 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
742 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
743 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
744 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
745 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
746 time_reduce=time_reduce+MPI_Wtime()-time00
747 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
748 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
749 time_reduce=time_reduce+MPI_Wtime()-time00
752 write (iout,*) "gloc_sc after reduce"
755 write (iout,*) i,j,gloc_sc(j,i,icg)
761 write (iout,*) "gloc after reduce"
763 write (iout,*) i,gloc(i,icg)
768 if (gnorm_check) then
770 c Compute the maximum elements of the gradient
780 gcorr3_turn_max=0.0d0
781 gcorr4_turn_max=0.0d0
784 gcorr6_turn_max=0.0d0
794 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
795 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
796 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
797 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
798 & gvdwc_scp_max=gvdwc_scp_norm
799 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
800 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
801 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
802 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
803 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
804 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
805 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
806 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
807 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
808 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
809 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
810 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
811 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
813 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
814 & gcorr3_turn_max=gcorr3_turn_norm
815 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
817 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
818 & gcorr4_turn_max=gcorr4_turn_norm
819 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
820 if (gradcorr5_norm.gt.gradcorr5_max)
821 & gradcorr5_max=gradcorr5_norm
822 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
823 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
824 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
826 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
827 & gcorr6_turn_max=gcorr6_turn_norm
828 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
829 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
830 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
831 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
832 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
833 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
834 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
835 if (gradx_scp_norm.gt.gradx_scp_max)
836 & gradx_scp_max=gradx_scp_norm
837 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
838 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
839 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
840 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
841 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
842 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
843 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
844 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
848 open(istat,file=statname,position="append")
850 open(istat,file=statname,access="append")
852 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
853 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
854 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
855 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
856 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
857 & gsccorx_max,gsclocx_max
859 if (gvdwc_max.gt.1.0d4) then
860 write (iout,*) "gvdwc gvdwx gradb gradbx"
862 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
863 & gradb(j,i),gradbx(j,i),j=1,3)
865 call pdbout(0.0d0,'cipiszcze',iout)
871 write (iout,*) "gradc gradx gloc"
873 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
874 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
878 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
882 c-------------------------------------------------------------------------------
883 subroutine rescale_weights(t_bath)
884 implicit real*8 (a-h,o-z)
886 include 'COMMON.IOUNITS'
887 include 'COMMON.FFIELD'
888 include 'COMMON.SBRIDGE'
889 double precision kfac /2.4d0/
890 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
892 c facT=2*temp0/(t_bath+temp0)
893 if (rescale_mode.eq.0) then
899 else if (rescale_mode.eq.1) then
900 facT=kfac/(kfac-1.0d0+t_bath/temp0)
901 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
902 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
903 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
904 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
905 else if (rescale_mode.eq.2) then
911 facT=licznik/dlog(dexp(x)+dexp(-x))
912 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
913 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
914 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
915 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
917 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
918 write (*,*) "Wrong RESCALE_MODE",rescale_mode
920 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
924 welec=weights(3)*fact
925 wcorr=weights(4)*fact3
926 wcorr5=weights(5)*fact4
927 wcorr6=weights(6)*fact5
928 wel_loc=weights(7)*fact2
929 wturn3=weights(8)*fact2
930 wturn4=weights(9)*fact3
931 wturn6=weights(10)*fact5
932 wtor=weights(13)*fact
933 wtor_d=weights(14)*fact2
934 wsccor=weights(21)*fact
938 C------------------------------------------------------------------------
939 subroutine enerprint(energia)
940 implicit real*8 (a-h,o-z)
942 include 'COMMON.IOUNITS'
943 include 'COMMON.FFIELD'
944 include 'COMMON.SBRIDGE'
946 double precision energia(0:n_ene)
951 evdw2=energia(2)+energia(18)
963 eello_turn3=energia(8)
964 eello_turn4=energia(9)
965 eello_turn6=energia(10)
971 edihcnstr=energia(19)
976 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
977 & estr,wbond,ebe,wang,
978 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
980 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
981 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
984 10 format (/'Virtual-chain energies:'//
985 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
986 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
987 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
988 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
989 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
990 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
991 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
992 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
993 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
994 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
995 & ' (SS bridges & dist. cnstr.)'/
996 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
999 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1000 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1001 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1002 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1003 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1004 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1005 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1006 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1007 & 'ETOT= ',1pE16.6,' (total)')
1009 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1010 & estr,wbond,ebe,wang,
1011 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1013 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1014 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1015 & ebr*nss,Uconst,etot
1016 10 format (/'Virtual-chain energies:'//
1017 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1018 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1019 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1020 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1021 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1022 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1023 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1024 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1025 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1026 & ' (SS bridges & dist. cnstr.)'/
1027 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1028 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1029 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1030 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1031 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1032 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1033 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1034 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1035 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1036 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1037 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1038 & 'ETOT= ',1pE16.6,' (total)')
1042 C-----------------------------------------------------------------------
1043 subroutine elj(evdw)
1045 C This subroutine calculates the interaction energy of nonbonded side chains
1046 C assuming the LJ potential of interaction.
1048 implicit real*8 (a-h,o-z)
1049 include 'DIMENSIONS'
1050 parameter (accur=1.0d-10)
1051 include 'COMMON.GEO'
1052 include 'COMMON.VAR'
1053 include 'COMMON.LOCAL'
1054 include 'COMMON.CHAIN'
1055 include 'COMMON.DERIV'
1056 include 'COMMON.INTERACT'
1057 include 'COMMON.TORSION'
1058 include 'COMMON.SBRIDGE'
1059 include 'COMMON.NAMES'
1060 include 'COMMON.IOUNITS'
1061 include 'COMMON.CONTACTS'
1063 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1065 do i=iatsc_s,iatsc_e
1067 if (itypi.eq.21) cycle
1075 C Calculate SC interaction energy.
1077 do iint=1,nint_gr(i)
1078 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1079 cd & 'iend=',iend(i,iint)
1080 do j=istart(i,iint),iend(i,iint)
1082 if (itypj.eq.21) cycle
1086 C Change 12/1/95 to calculate four-body interactions
1087 rij=xj*xj+yj*yj+zj*zj
1089 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1090 eps0ij=eps(itypi,itypj)
1092 e1=fac*fac*aa(itypi,itypj)
1093 e2=fac*bb(itypi,itypj)
1095 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1096 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1097 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1098 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1099 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1100 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1103 C Calculate the components of the gradient in DC and X
1105 fac=-rrij*(e1+evdwij)
1110 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1111 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1112 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1113 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1117 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1121 C 12/1/95, revised on 5/20/97
1123 C Calculate the contact function. The ith column of the array JCONT will
1124 C contain the numbers of atoms that make contacts with the atom I (of numbers
1125 C greater than I). The arrays FACONT and GACONT will contain the values of
1126 C the contact function and its derivative.
1128 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1129 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1130 C Uncomment next line, if the correlation interactions are contact function only
1131 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1133 sigij=sigma(itypi,itypj)
1134 r0ij=rs0(itypi,itypj)
1136 C Check whether the SC's are not too far to make a contact.
1139 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1140 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1142 if (fcont.gt.0.0D0) then
1143 C If the SC-SC distance if close to sigma, apply spline.
1144 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1145 cAdam & fcont1,fprimcont1)
1146 cAdam fcont1=1.0d0-fcont1
1147 cAdam if (fcont1.gt.0.0d0) then
1148 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1149 cAdam fcont=fcont*fcont1
1151 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1152 cga eps0ij=1.0d0/dsqrt(eps0ij)
1154 cga gg(k)=gg(k)*eps0ij
1156 cga eps0ij=-evdwij*eps0ij
1157 C Uncomment for AL's type of SC correlation interactions.
1158 cadam eps0ij=-evdwij
1159 num_conti=num_conti+1
1160 jcont(num_conti,i)=j
1161 facont(num_conti,i)=fcont*eps0ij
1162 fprimcont=eps0ij*fprimcont/rij
1164 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1165 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1166 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1167 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1168 gacont(1,num_conti,i)=-fprimcont*xj
1169 gacont(2,num_conti,i)=-fprimcont*yj
1170 gacont(3,num_conti,i)=-fprimcont*zj
1171 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1172 cd write (iout,'(2i3,3f10.5)')
1173 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1179 num_cont(i)=num_conti
1183 gvdwc(j,i)=expon*gvdwc(j,i)
1184 gvdwx(j,i)=expon*gvdwx(j,i)
1187 C******************************************************************************
1191 C To save time, the factor of EXPON has been extracted from ALL components
1192 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1195 C******************************************************************************
1198 C-----------------------------------------------------------------------------
1199 subroutine eljk(evdw)
1201 C This subroutine calculates the interaction energy of nonbonded side chains
1202 C assuming the LJK potential of interaction.
1204 implicit real*8 (a-h,o-z)
1205 include 'DIMENSIONS'
1206 include 'COMMON.GEO'
1207 include 'COMMON.VAR'
1208 include 'COMMON.LOCAL'
1209 include 'COMMON.CHAIN'
1210 include 'COMMON.DERIV'
1211 include 'COMMON.INTERACT'
1212 include 'COMMON.IOUNITS'
1213 include 'COMMON.NAMES'
1216 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1218 do i=iatsc_s,iatsc_e
1220 if (itypi.eq.21) cycle
1226 C Calculate SC interaction energy.
1228 do iint=1,nint_gr(i)
1229 do j=istart(i,iint),iend(i,iint)
1231 if (itypj.eq.21) cycle
1235 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1236 fac_augm=rrij**expon
1237 e_augm=augm(itypi,itypj)*fac_augm
1238 r_inv_ij=dsqrt(rrij)
1240 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1241 fac=r_shift_inv**expon
1242 e1=fac*fac*aa(itypi,itypj)
1243 e2=fac*bb(itypi,itypj)
1245 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1246 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1247 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1248 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1249 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1250 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1251 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1254 C Calculate the components of the gradient in DC and X
1256 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1261 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1262 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1263 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1264 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1268 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1276 gvdwc(j,i)=expon*gvdwc(j,i)
1277 gvdwx(j,i)=expon*gvdwx(j,i)
1282 C-----------------------------------------------------------------------------
1283 subroutine ebp(evdw)
1285 C This subroutine calculates the interaction energy of nonbonded side chains
1286 C assuming the Berne-Pechukas potential of interaction.
1288 implicit real*8 (a-h,o-z)
1289 include 'DIMENSIONS'
1290 include 'COMMON.GEO'
1291 include 'COMMON.VAR'
1292 include 'COMMON.LOCAL'
1293 include 'COMMON.CHAIN'
1294 include 'COMMON.DERIV'
1295 include 'COMMON.NAMES'
1296 include 'COMMON.INTERACT'
1297 include 'COMMON.IOUNITS'
1298 include 'COMMON.CALC'
1299 common /srutu/ icall
1300 c double precision rrsave(maxdim)
1303 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1305 c if (icall.eq.0) then
1311 do i=iatsc_s,iatsc_e
1313 if (itypi.eq.21) cycle
1318 dxi=dc_norm(1,nres+i)
1319 dyi=dc_norm(2,nres+i)
1320 dzi=dc_norm(3,nres+i)
1321 c dsci_inv=dsc_inv(itypi)
1322 dsci_inv=vbld_inv(i+nres)
1324 C Calculate SC interaction energy.
1326 do iint=1,nint_gr(i)
1327 do j=istart(i,iint),iend(i,iint)
1330 if (itypj.eq.21) cycle
1331 c dscj_inv=dsc_inv(itypj)
1332 dscj_inv=vbld_inv(j+nres)
1333 chi1=chi(itypi,itypj)
1334 chi2=chi(itypj,itypi)
1341 alf12=0.5D0*(alf1+alf2)
1342 C For diagnostics only!!!
1355 dxj=dc_norm(1,nres+j)
1356 dyj=dc_norm(2,nres+j)
1357 dzj=dc_norm(3,nres+j)
1358 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1359 cd if (icall.eq.0) then
1365 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1367 C Calculate whole angle-dependent part of epsilon and contributions
1368 C to its derivatives
1369 fac=(rrij*sigsq)**expon2
1370 e1=fac*fac*aa(itypi,itypj)
1371 e2=fac*bb(itypi,itypj)
1372 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1373 eps2der=evdwij*eps3rt
1374 eps3der=evdwij*eps2rt
1375 evdwij=evdwij*eps2rt*eps3rt
1378 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1379 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1380 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1381 cd & restyp(itypi),i,restyp(itypj),j,
1382 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1383 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1384 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1387 C Calculate gradient components.
1388 e1=e1*eps1*eps2rt**2*eps3rt**2
1389 fac=-expon*(e1+evdwij)
1392 C Calculate radial part of the gradient
1396 C Calculate the angular part of the gradient and sum add the contributions
1397 C to the appropriate components of the Cartesian gradient.
1405 C-----------------------------------------------------------------------------
1406 subroutine egb(evdw)
1408 C This subroutine calculates the interaction energy of nonbonded side chains
1409 C assuming the Gay-Berne potential of interaction.
1411 implicit real*8 (a-h,o-z)
1412 include 'DIMENSIONS'
1413 include 'COMMON.GEO'
1414 include 'COMMON.VAR'
1415 include 'COMMON.LOCAL'
1416 include 'COMMON.CHAIN'
1417 include 'COMMON.DERIV'
1418 include 'COMMON.NAMES'
1419 include 'COMMON.INTERACT'
1420 include 'COMMON.IOUNITS'
1421 include 'COMMON.CALC'
1422 include 'COMMON.CONTROL'
1423 include 'COMMON.SBRIDGE'
1426 ccccc energy_dec=.false.
1427 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1430 c if (icall.eq.0) lprn=.false.
1432 do i=iatsc_s,iatsc_e
1434 if (itypi.eq.21) cycle
1439 dxi=dc_norm(1,nres+i)
1440 dyi=dc_norm(2,nres+i)
1441 dzi=dc_norm(3,nres+i)
1442 c dsci_inv=dsc_inv(itypi)
1443 dsci_inv=vbld_inv(i+nres)
1444 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1445 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1447 C Calculate SC interaction energy.
1449 do iint=1,nint_gr(i)
1450 do j=istart(i,iint),iend(i,iint)
1451 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1452 call dyn_ssbond_ene(i,j,evdwij)
1454 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1455 & 'evdw',i,j,evdwij,' ss'
1459 if (itypj.eq.21) cycle
1460 c dscj_inv=dsc_inv(itypj)
1461 dscj_inv=vbld_inv(j+nres)
1462 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1463 c & 1.0d0/vbld(j+nres)
1464 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1465 sig0ij=sigma(itypi,itypj)
1466 chi1=chi(itypi,itypj)
1467 chi2=chi(itypj,itypi)
1474 alf12=0.5D0*(alf1+alf2)
1475 C For diagnostics only!!!
1488 dxj=dc_norm(1,nres+j)
1489 dyj=dc_norm(2,nres+j)
1490 dzj=dc_norm(3,nres+j)
1491 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1492 c write (iout,*) "j",j," dc_norm",
1493 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1494 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1496 C Calculate angle-dependent terms of energy and contributions to their
1500 sig=sig0ij*dsqrt(sigsq)
1501 rij_shift=1.0D0/rij-sig+sig0ij
1502 c for diagnostics; uncomment
1503 c rij_shift=1.2*sig0ij
1504 C I hate to put IF's in the loops, but here don't have another choice!!!!
1505 if (rij_shift.le.0.0D0) then
1507 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1508 cd & restyp(itypi),i,restyp(itypj),j,
1509 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1513 c---------------------------------------------------------------
1514 rij_shift=1.0D0/rij_shift
1515 fac=rij_shift**expon
1516 e1=fac*fac*aa(itypi,itypj)
1517 e2=fac*bb(itypi,itypj)
1518 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1519 eps2der=evdwij*eps3rt
1520 eps3der=evdwij*eps2rt
1521 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1522 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1523 evdwij=evdwij*eps2rt*eps3rt
1526 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1527 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1528 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1529 & restyp(itypi),i,restyp(itypj),j,
1530 & epsi,sigm,chi1,chi2,chip1,chip2,
1531 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1532 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1536 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1539 C Calculate gradient components.
1540 e1=e1*eps1*eps2rt**2*eps3rt**2
1541 fac=-expon*(e1+evdwij)*rij_shift
1545 C Calculate the radial part of the gradient
1549 C Calculate angular part of the gradient.
1555 c write (iout,*) "Number of loop steps in EGB:",ind
1556 cccc energy_dec=.false.
1559 C-----------------------------------------------------------------------------
1560 subroutine egbv(evdw)
1562 C This subroutine calculates the interaction energy of nonbonded side chains
1563 C assuming the Gay-Berne-Vorobjev potential of interaction.
1565 implicit real*8 (a-h,o-z)
1566 include 'DIMENSIONS'
1567 include 'COMMON.GEO'
1568 include 'COMMON.VAR'
1569 include 'COMMON.LOCAL'
1570 include 'COMMON.CHAIN'
1571 include 'COMMON.DERIV'
1572 include 'COMMON.NAMES'
1573 include 'COMMON.INTERACT'
1574 include 'COMMON.IOUNITS'
1575 include 'COMMON.CALC'
1576 common /srutu/ icall
1579 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1582 c if (icall.eq.0) lprn=.true.
1584 do i=iatsc_s,iatsc_e
1586 if (itypi.eq.21) cycle
1591 dxi=dc_norm(1,nres+i)
1592 dyi=dc_norm(2,nres+i)
1593 dzi=dc_norm(3,nres+i)
1594 c dsci_inv=dsc_inv(itypi)
1595 dsci_inv=vbld_inv(i+nres)
1597 C Calculate SC interaction energy.
1599 do iint=1,nint_gr(i)
1600 do j=istart(i,iint),iend(i,iint)
1603 if (itypj.eq.21) cycle
1604 c dscj_inv=dsc_inv(itypj)
1605 dscj_inv=vbld_inv(j+nres)
1606 sig0ij=sigma(itypi,itypj)
1607 r0ij=r0(itypi,itypj)
1608 chi1=chi(itypi,itypj)
1609 chi2=chi(itypj,itypi)
1616 alf12=0.5D0*(alf1+alf2)
1617 C For diagnostics only!!!
1630 dxj=dc_norm(1,nres+j)
1631 dyj=dc_norm(2,nres+j)
1632 dzj=dc_norm(3,nres+j)
1633 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1635 C Calculate angle-dependent terms of energy and contributions to their
1639 sig=sig0ij*dsqrt(sigsq)
1640 rij_shift=1.0D0/rij-sig+r0ij
1641 C I hate to put IF's in the loops, but here don't have another choice!!!!
1642 if (rij_shift.le.0.0D0) then
1647 c---------------------------------------------------------------
1648 rij_shift=1.0D0/rij_shift
1649 fac=rij_shift**expon
1650 e1=fac*fac*aa(itypi,itypj)
1651 e2=fac*bb(itypi,itypj)
1652 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1653 eps2der=evdwij*eps3rt
1654 eps3der=evdwij*eps2rt
1655 fac_augm=rrij**expon
1656 e_augm=augm(itypi,itypj)*fac_augm
1657 evdwij=evdwij*eps2rt*eps3rt
1658 evdw=evdw+evdwij+e_augm
1660 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1661 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1662 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1663 & restyp(itypi),i,restyp(itypj),j,
1664 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1665 & chi1,chi2,chip1,chip2,
1666 & eps1,eps2rt**2,eps3rt**2,
1667 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1670 C Calculate gradient components.
1671 e1=e1*eps1*eps2rt**2*eps3rt**2
1672 fac=-expon*(e1+evdwij)*rij_shift
1674 fac=rij*fac-2*expon*rrij*e_augm
1675 C Calculate the radial part of the gradient
1679 C Calculate angular part of the gradient.
1685 C-----------------------------------------------------------------------------
1686 subroutine sc_angular
1687 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1688 C om12. Called by ebp, egb, and egbv.
1690 include 'COMMON.CALC'
1691 include 'COMMON.IOUNITS'
1695 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1696 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1697 om12=dxi*dxj+dyi*dyj+dzi*dzj
1699 C Calculate eps1(om12) and its derivative in om12
1700 faceps1=1.0D0-om12*chiom12
1701 faceps1_inv=1.0D0/faceps1
1702 eps1=dsqrt(faceps1_inv)
1703 C Following variable is eps1*deps1/dom12
1704 eps1_om12=faceps1_inv*chiom12
1709 c write (iout,*) "om12",om12," eps1",eps1
1710 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1715 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1716 sigsq=1.0D0-facsig*faceps1_inv
1717 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1718 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1719 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1725 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1726 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1728 C Calculate eps2 and its derivatives in om1, om2, and om12.
1731 chipom12=chip12*om12
1732 facp=1.0D0-om12*chipom12
1734 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1735 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1736 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1737 C Following variable is the square root of eps2
1738 eps2rt=1.0D0-facp1*facp_inv
1739 C Following three variables are the derivatives of the square root of eps
1740 C in om1, om2, and om12.
1741 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1742 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1743 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1744 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1745 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1746 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1747 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1748 c & " eps2rt_om12",eps2rt_om12
1749 C Calculate whole angle-dependent part of epsilon and contributions
1750 C to its derivatives
1753 C----------------------------------------------------------------------------
1755 implicit real*8 (a-h,o-z)
1756 include 'DIMENSIONS'
1757 include 'COMMON.CHAIN'
1758 include 'COMMON.DERIV'
1759 include 'COMMON.CALC'
1760 include 'COMMON.IOUNITS'
1761 double precision dcosom1(3),dcosom2(3)
1762 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1763 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1764 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1765 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1769 c eom12=evdwij*eps1_om12
1771 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1772 c & " sigder",sigder
1773 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1774 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1776 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1777 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1780 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1782 c write (iout,*) "gg",(gg(k),k=1,3)
1784 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1785 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1786 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1787 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1788 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1789 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1790 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1791 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1792 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1793 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1796 C Calculate the components of the gradient in DC and X
1800 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1804 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1805 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1809 C-----------------------------------------------------------------------
1810 subroutine e_softsphere(evdw)
1812 C This subroutine calculates the interaction energy of nonbonded side chains
1813 C assuming the LJ potential of interaction.
1815 implicit real*8 (a-h,o-z)
1816 include 'DIMENSIONS'
1817 parameter (accur=1.0d-10)
1818 include 'COMMON.GEO'
1819 include 'COMMON.VAR'
1820 include 'COMMON.LOCAL'
1821 include 'COMMON.CHAIN'
1822 include 'COMMON.DERIV'
1823 include 'COMMON.INTERACT'
1824 include 'COMMON.TORSION'
1825 include 'COMMON.SBRIDGE'
1826 include 'COMMON.NAMES'
1827 include 'COMMON.IOUNITS'
1828 include 'COMMON.CONTACTS'
1830 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1832 do i=iatsc_s,iatsc_e
1834 if (itypi.eq.21) cycle
1840 C Calculate SC interaction energy.
1842 do iint=1,nint_gr(i)
1843 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1844 cd & 'iend=',iend(i,iint)
1845 do j=istart(i,iint),iend(i,iint)
1847 if (itypj.eq.21) cycle
1851 rij=xj*xj+yj*yj+zj*zj
1852 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1853 r0ij=r0(itypi,itypj)
1855 c print *,i,j,r0ij,dsqrt(rij)
1856 if (rij.lt.r0ijsq) then
1857 evdwij=0.25d0*(rij-r0ijsq)**2
1865 C Calculate the components of the gradient in DC and X
1871 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1872 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1873 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1874 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1878 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1886 C--------------------------------------------------------------------------
1887 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1890 C Soft-sphere potential of p-p interaction
1892 implicit real*8 (a-h,o-z)
1893 include 'DIMENSIONS'
1894 include 'COMMON.CONTROL'
1895 include 'COMMON.IOUNITS'
1896 include 'COMMON.GEO'
1897 include 'COMMON.VAR'
1898 include 'COMMON.LOCAL'
1899 include 'COMMON.CHAIN'
1900 include 'COMMON.DERIV'
1901 include 'COMMON.INTERACT'
1902 include 'COMMON.CONTACTS'
1903 include 'COMMON.TORSION'
1904 include 'COMMON.VECTORS'
1905 include 'COMMON.FFIELD'
1907 cd write(iout,*) 'In EELEC_soft_sphere'
1914 do i=iatel_s,iatel_e
1915 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
1919 xmedi=c(1,i)+0.5d0*dxi
1920 ymedi=c(2,i)+0.5d0*dyi
1921 zmedi=c(3,i)+0.5d0*dzi
1923 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1924 do j=ielstart(i),ielend(i)
1925 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
1929 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1930 r0ij=rpp(iteli,itelj)
1935 xj=c(1,j)+0.5D0*dxj-xmedi
1936 yj=c(2,j)+0.5D0*dyj-ymedi
1937 zj=c(3,j)+0.5D0*dzj-zmedi
1938 rij=xj*xj+yj*yj+zj*zj
1939 if (rij.lt.r0ijsq) then
1940 evdw1ij=0.25d0*(rij-r0ijsq)**2
1948 C Calculate contributions to the Cartesian gradient.
1954 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1955 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1958 * Loop over residues i+1 thru j-1.
1962 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1967 cgrad do i=nnt,nct-1
1969 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1971 cgrad do j=i+1,nct-1
1973 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1979 c------------------------------------------------------------------------------
1980 subroutine vec_and_deriv
1981 implicit real*8 (a-h,o-z)
1982 include 'DIMENSIONS'
1986 include 'COMMON.IOUNITS'
1987 include 'COMMON.GEO'
1988 include 'COMMON.VAR'
1989 include 'COMMON.LOCAL'
1990 include 'COMMON.CHAIN'
1991 include 'COMMON.VECTORS'
1992 include 'COMMON.SETUP'
1993 include 'COMMON.TIME1'
1994 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1995 C Compute the local reference systems. For reference system (i), the
1996 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1997 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1999 do i=ivec_start,ivec_end
2003 if (i.eq.nres-1) then
2004 C Case of the last full residue
2005 C Compute the Z-axis
2006 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2007 costh=dcos(pi-theta(nres))
2008 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2012 C Compute the derivatives of uz
2014 uzder(2,1,1)=-dc_norm(3,i-1)
2015 uzder(3,1,1)= dc_norm(2,i-1)
2016 uzder(1,2,1)= dc_norm(3,i-1)
2018 uzder(3,2,1)=-dc_norm(1,i-1)
2019 uzder(1,3,1)=-dc_norm(2,i-1)
2020 uzder(2,3,1)= dc_norm(1,i-1)
2023 uzder(2,1,2)= dc_norm(3,i)
2024 uzder(3,1,2)=-dc_norm(2,i)
2025 uzder(1,2,2)=-dc_norm(3,i)
2027 uzder(3,2,2)= dc_norm(1,i)
2028 uzder(1,3,2)= dc_norm(2,i)
2029 uzder(2,3,2)=-dc_norm(1,i)
2031 C Compute the Y-axis
2034 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2036 C Compute the derivatives of uy
2039 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2040 & -dc_norm(k,i)*dc_norm(j,i-1)
2041 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2043 uyder(j,j,1)=uyder(j,j,1)-costh
2044 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2049 uygrad(l,k,j,i)=uyder(l,k,j)
2050 uzgrad(l,k,j,i)=uzder(l,k,j)
2054 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2055 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2056 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2057 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2060 C Compute the Z-axis
2061 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2062 costh=dcos(pi-theta(i+2))
2063 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2067 C Compute the derivatives of uz
2069 uzder(2,1,1)=-dc_norm(3,i+1)
2070 uzder(3,1,1)= dc_norm(2,i+1)
2071 uzder(1,2,1)= dc_norm(3,i+1)
2073 uzder(3,2,1)=-dc_norm(1,i+1)
2074 uzder(1,3,1)=-dc_norm(2,i+1)
2075 uzder(2,3,1)= dc_norm(1,i+1)
2078 uzder(2,1,2)= dc_norm(3,i)
2079 uzder(3,1,2)=-dc_norm(2,i)
2080 uzder(1,2,2)=-dc_norm(3,i)
2082 uzder(3,2,2)= dc_norm(1,i)
2083 uzder(1,3,2)= dc_norm(2,i)
2084 uzder(2,3,2)=-dc_norm(1,i)
2086 C Compute the Y-axis
2089 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2091 C Compute the derivatives of uy
2094 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2095 & -dc_norm(k,i)*dc_norm(j,i+1)
2096 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2098 uyder(j,j,1)=uyder(j,j,1)-costh
2099 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2104 uygrad(l,k,j,i)=uyder(l,k,j)
2105 uzgrad(l,k,j,i)=uzder(l,k,j)
2109 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2110 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2111 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2112 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2116 vbld_inv_temp(1)=vbld_inv(i+1)
2117 if (i.lt.nres-1) then
2118 vbld_inv_temp(2)=vbld_inv(i+2)
2120 vbld_inv_temp(2)=vbld_inv(i)
2125 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2126 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2131 #if defined(PARVEC) && defined(MPI)
2132 if (nfgtasks1.gt.1) then
2134 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2135 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2136 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2137 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2138 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2140 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2141 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2143 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2144 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2145 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2146 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2147 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2148 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2149 time_gather=time_gather+MPI_Wtime()-time00
2151 c if (fg_rank.eq.0) then
2152 c write (iout,*) "Arrays UY and UZ"
2154 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2161 C-----------------------------------------------------------------------------
2162 subroutine check_vecgrad
2163 implicit real*8 (a-h,o-z)
2164 include 'DIMENSIONS'
2165 include 'COMMON.IOUNITS'
2166 include 'COMMON.GEO'
2167 include 'COMMON.VAR'
2168 include 'COMMON.LOCAL'
2169 include 'COMMON.CHAIN'
2170 include 'COMMON.VECTORS'
2171 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2172 dimension uyt(3,maxres),uzt(3,maxres)
2173 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2174 double precision delta /1.0d-7/
2177 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2178 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2179 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2180 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2181 cd & (dc_norm(if90,i),if90=1,3)
2182 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2183 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2184 cd write(iout,'(a)')
2190 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2191 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2204 cd write (iout,*) 'i=',i
2206 erij(k)=dc_norm(k,i)
2210 dc_norm(k,i)=erij(k)
2212 dc_norm(j,i)=dc_norm(j,i)+delta
2213 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2215 c dc_norm(k,i)=dc_norm(k,i)/fac
2217 c write (iout,*) (dc_norm(k,i),k=1,3)
2218 c write (iout,*) (erij(k),k=1,3)
2221 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2222 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2223 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2224 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2226 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2227 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2228 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2231 dc_norm(k,i)=erij(k)
2234 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2235 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2236 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2237 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2238 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2239 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2240 cd write (iout,'(a)')
2245 C--------------------------------------------------------------------------
2246 subroutine set_matrices
2247 implicit real*8 (a-h,o-z)
2248 include 'DIMENSIONS'
2251 include "COMMON.SETUP"
2253 integer status(MPI_STATUS_SIZE)
2255 include 'COMMON.IOUNITS'
2256 include 'COMMON.GEO'
2257 include 'COMMON.VAR'
2258 include 'COMMON.LOCAL'
2259 include 'COMMON.CHAIN'
2260 include 'COMMON.DERIV'
2261 include 'COMMON.INTERACT'
2262 include 'COMMON.CONTACTS'
2263 include 'COMMON.TORSION'
2264 include 'COMMON.VECTORS'
2265 include 'COMMON.FFIELD'
2266 double precision auxvec(2),auxmat(2,2)
2268 C Compute the virtual-bond-torsional-angle dependent quantities needed
2269 C to calculate the el-loc multibody terms of various order.
2272 do i=ivec_start+2,ivec_end+2
2276 if (i .lt. nres+1) then
2313 if (i .gt. 3 .and. i .lt. nres+1) then
2314 obrot_der(1,i-2)=-sin1
2315 obrot_der(2,i-2)= cos1
2316 Ugder(1,1,i-2)= sin1
2317 Ugder(1,2,i-2)=-cos1
2318 Ugder(2,1,i-2)=-cos1
2319 Ugder(2,2,i-2)=-sin1
2322 obrot2_der(1,i-2)=-dwasin2
2323 obrot2_der(2,i-2)= dwacos2
2324 Ug2der(1,1,i-2)= dwasin2
2325 Ug2der(1,2,i-2)=-dwacos2
2326 Ug2der(2,1,i-2)=-dwacos2
2327 Ug2der(2,2,i-2)=-dwasin2
2329 obrot_der(1,i-2)=0.0d0
2330 obrot_der(2,i-2)=0.0d0
2331 Ugder(1,1,i-2)=0.0d0
2332 Ugder(1,2,i-2)=0.0d0
2333 Ugder(2,1,i-2)=0.0d0
2334 Ugder(2,2,i-2)=0.0d0
2335 obrot2_der(1,i-2)=0.0d0
2336 obrot2_der(2,i-2)=0.0d0
2337 Ug2der(1,1,i-2)=0.0d0
2338 Ug2der(1,2,i-2)=0.0d0
2339 Ug2der(2,1,i-2)=0.0d0
2340 Ug2der(2,2,i-2)=0.0d0
2342 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2343 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2344 c write(iout,*) (itype(i-2))
2345 iti = itortyp(itype(i-2))
2349 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2350 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2351 iti1 = itortyp(itype(i-1))
2355 cd write (iout,*) '*******i',i,' iti1',iti
2356 cd write (iout,*) 'b1',b1(:,iti)
2357 cd write (iout,*) 'b2',b2(:,iti)
2358 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2359 c if (i .gt. iatel_s+2) then
2360 if (i .gt. nnt+2) then
2361 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2362 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2363 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2365 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2366 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2367 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2368 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2369 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2380 DtUg2(l,k,i-2)=0.0d0
2384 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2385 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2387 muder(k,i-2)=Ub2der(k,i-2)
2389 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2390 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2391 iti1 = itortyp(itype(i-1))
2396 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2398 cd write (iout,*) 'mu ',mu(:,i-2)
2399 cd write (iout,*) 'mu1',mu1(:,i-2)
2400 cd write (iout,*) 'mu2',mu2(:,i-2)
2401 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2403 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2404 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2405 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2406 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2407 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2408 C Vectors and matrices dependent on a single virtual-bond dihedral.
2409 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2410 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2411 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2412 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2413 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2414 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2415 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2416 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2417 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2420 C Matrices dependent on two consecutive virtual-bond dihedrals.
2421 C The order of matrices is from left to right.
2422 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2424 c do i=max0(ivec_start,2),ivec_end
2426 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2427 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2428 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2429 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2430 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2431 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2432 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2433 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2436 #if defined(MPI) && defined(PARMAT)
2438 c if (fg_rank.eq.0) then
2439 write (iout,*) "Arrays UG and UGDER before GATHER"
2441 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2442 & ((ug(l,k,i),l=1,2),k=1,2),
2443 & ((ugder(l,k,i),l=1,2),k=1,2)
2445 write (iout,*) "Arrays UG2 and UG2DER"
2447 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2448 & ((ug2(l,k,i),l=1,2),k=1,2),
2449 & ((ug2der(l,k,i),l=1,2),k=1,2)
2451 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2453 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2454 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2455 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2457 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2459 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2460 & costab(i),sintab(i),costab2(i),sintab2(i)
2462 write (iout,*) "Array MUDER"
2464 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2468 if (nfgtasks.gt.1) then
2470 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2471 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2472 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2474 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2475 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2477 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2478 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2480 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2481 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2483 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2484 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2486 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2487 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2489 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2490 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2492 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2493 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2494 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2495 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2496 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2497 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2498 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2499 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2500 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2501 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2502 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2503 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2504 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2506 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2509 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2510 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2512 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2515 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2516 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2518 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2519 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2521 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2522 & ivec_count(fg_rank1),
2523 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2525 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2526 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2528 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2529 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2531 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2532 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2534 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2535 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2537 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2538 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2540 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2543 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2544 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2546 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2547 & ivec_count(fg_rank1),
2548 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2550 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2551 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2553 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2554 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2556 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2557 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2559 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2560 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2562 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2563 & ivec_count(fg_rank1),
2564 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2566 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2567 & ivec_count(fg_rank1),
2568 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2570 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2571 & ivec_count(fg_rank1),
2572 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2573 & MPI_MAT2,FG_COMM1,IERR)
2574 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2575 & ivec_count(fg_rank1),
2576 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2577 & MPI_MAT2,FG_COMM1,IERR)
2580 c Passes matrix info through the ring
2583 if (irecv.lt.0) irecv=nfgtasks1-1
2586 if (inext.ge.nfgtasks1) inext=0
2588 c write (iout,*) "isend",isend," irecv",irecv
2590 lensend=lentyp(isend)
2591 lenrecv=lentyp(irecv)
2592 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2593 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2594 c & MPI_ROTAT1(lensend),inext,2200+isend,
2595 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2596 c & iprev,2200+irecv,FG_COMM,status,IERR)
2597 c write (iout,*) "Gather ROTAT1"
2599 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2600 c & MPI_ROTAT2(lensend),inext,3300+isend,
2601 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2602 c & iprev,3300+irecv,FG_COMM,status,IERR)
2603 c write (iout,*) "Gather ROTAT2"
2605 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2606 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2607 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2608 & iprev,4400+irecv,FG_COMM,status,IERR)
2609 c write (iout,*) "Gather ROTAT_OLD"
2611 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2612 & MPI_PRECOMP11(lensend),inext,5500+isend,
2613 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2614 & iprev,5500+irecv,FG_COMM,status,IERR)
2615 c write (iout,*) "Gather PRECOMP11"
2617 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2618 & MPI_PRECOMP12(lensend),inext,6600+isend,
2619 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2620 & iprev,6600+irecv,FG_COMM,status,IERR)
2621 c write (iout,*) "Gather PRECOMP12"
2623 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2625 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2626 & MPI_ROTAT2(lensend),inext,7700+isend,
2627 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2628 & iprev,7700+irecv,FG_COMM,status,IERR)
2629 c write (iout,*) "Gather PRECOMP21"
2631 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2632 & MPI_PRECOMP22(lensend),inext,8800+isend,
2633 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2634 & iprev,8800+irecv,FG_COMM,status,IERR)
2635 c write (iout,*) "Gather PRECOMP22"
2637 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2638 & MPI_PRECOMP23(lensend),inext,9900+isend,
2639 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2640 & MPI_PRECOMP23(lenrecv),
2641 & iprev,9900+irecv,FG_COMM,status,IERR)
2642 c write (iout,*) "Gather PRECOMP23"
2647 if (irecv.lt.0) irecv=nfgtasks1-1
2650 time_gather=time_gather+MPI_Wtime()-time00
2653 c if (fg_rank.eq.0) then
2654 write (iout,*) "Arrays UG and UGDER"
2656 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2657 & ((ug(l,k,i),l=1,2),k=1,2),
2658 & ((ugder(l,k,i),l=1,2),k=1,2)
2660 write (iout,*) "Arrays UG2 and UG2DER"
2662 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2663 & ((ug2(l,k,i),l=1,2),k=1,2),
2664 & ((ug2der(l,k,i),l=1,2),k=1,2)
2666 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2668 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2669 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2670 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2672 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2674 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2675 & costab(i),sintab(i),costab2(i),sintab2(i)
2677 write (iout,*) "Array MUDER"
2679 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2685 cd iti = itortyp(itype(i))
2688 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2689 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2694 C--------------------------------------------------------------------------
2695 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2697 C This subroutine calculates the average interaction energy and its gradient
2698 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2699 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2700 C The potential depends both on the distance of peptide-group centers and on
2701 C the orientation of the CA-CA virtual bonds.
2703 implicit real*8 (a-h,o-z)
2707 include 'DIMENSIONS'
2708 include 'COMMON.CONTROL'
2709 include 'COMMON.SETUP'
2710 include 'COMMON.IOUNITS'
2711 include 'COMMON.GEO'
2712 include 'COMMON.VAR'
2713 include 'COMMON.LOCAL'
2714 include 'COMMON.CHAIN'
2715 include 'COMMON.DERIV'
2716 include 'COMMON.INTERACT'
2717 include 'COMMON.CONTACTS'
2718 include 'COMMON.TORSION'
2719 include 'COMMON.VECTORS'
2720 include 'COMMON.FFIELD'
2721 include 'COMMON.TIME1'
2722 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2723 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2724 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2725 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),eel_loc_ij
2726 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2727 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2729 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2731 double precision scal_el /1.0d0/
2733 double precision scal_el /0.5d0/
2736 C 13-go grudnia roku pamietnego...
2737 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2738 & 0.0d0,1.0d0,0.0d0,
2739 & 0.0d0,0.0d0,1.0d0/
2740 cd write(iout,*) 'In EELEC'
2742 cd write(iout,*) 'Type',i
2743 cd write(iout,*) 'B1',B1(:,i)
2744 cd write(iout,*) 'B2',B2(:,i)
2745 cd write(iout,*) 'CC',CC(:,:,i)
2746 cd write(iout,*) 'DD',DD(:,:,i)
2747 cd write(iout,*) 'EE',EE(:,:,i)
2749 cd call check_vecgrad
2751 if (icheckgrad.eq.1) then
2753 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2755 dc_norm(k,i)=dc(k,i)*fac
2757 c write (iout,*) 'i',i,' fac',fac
2760 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2761 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2762 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2763 c call vec_and_deriv
2768 c write (iout,*) "after set matrices"
2770 time_mat=time_mat+MPI_Wtime()-time01
2774 cd write (iout,*) 'i=',i
2776 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2779 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2780 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2793 cd print '(a)','Enter EELEC'
2794 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2796 gel_loc_loc(i)=0.0d0
2801 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2803 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2805 c write(iout,*) "przed turnem3 loop"
2806 do i=iturn3_start,iturn3_end
2807 if (itype(i).eq.21 .or. itype(i+1).eq.21
2808 & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
2812 dx_normi=dc_norm(1,i)
2813 dy_normi=dc_norm(2,i)
2814 dz_normi=dc_norm(3,i)
2815 xmedi=c(1,i)+0.5d0*dxi
2816 ymedi=c(2,i)+0.5d0*dyi
2817 zmedi=c(3,i)+0.5d0*dzi
2819 call eelecij(i,i+2,ees,evdw1,eel_loc)
2820 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2821 num_cont_hb(i)=num_conti
2823 do i=iturn4_start,iturn4_end
2824 if (itype(i).eq.21 .or. itype(i+1).eq.21
2825 & .or. itype(i+3).eq.21
2826 & .or. itype(i+4).eq.21) cycle
2830 dx_normi=dc_norm(1,i)
2831 dy_normi=dc_norm(2,i)
2832 dz_normi=dc_norm(3,i)
2833 xmedi=c(1,i)+0.5d0*dxi
2834 ymedi=c(2,i)+0.5d0*dyi
2835 zmedi=c(3,i)+0.5d0*dzi
2836 num_conti=num_cont_hb(i)
2837 call eelecij(i,i+3,ees,evdw1,eel_loc)
2838 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
2839 & call eturn4(i,eello_turn4)
2840 num_cont_hb(i)=num_conti
2843 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2845 do i=iatel_s,iatel_e
2846 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
2850 dx_normi=dc_norm(1,i)
2851 dy_normi=dc_norm(2,i)
2852 dz_normi=dc_norm(3,i)
2853 xmedi=c(1,i)+0.5d0*dxi
2854 ymedi=c(2,i)+0.5d0*dyi
2855 zmedi=c(3,i)+0.5d0*dzi
2856 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2857 num_conti=num_cont_hb(i)
2858 do j=ielstart(i),ielend(i)
2859 c write (iout,*) i,j,itype(i),itype(j)
2860 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
2861 call eelecij(i,j,ees,evdw1,eel_loc)
2863 num_cont_hb(i)=num_conti
2865 c write (iout,*) "Number of loop steps in EELEC:",ind
2867 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2868 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2870 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2871 ccc eel_loc=eel_loc+eello_turn3
2872 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2875 C-------------------------------------------------------------------------------
2876 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2877 implicit real*8 (a-h,o-z)
2878 include 'DIMENSIONS'
2882 include 'COMMON.CONTROL'
2883 include 'COMMON.IOUNITS'
2884 include 'COMMON.GEO'
2885 include 'COMMON.VAR'
2886 include 'COMMON.LOCAL'
2887 include 'COMMON.CHAIN'
2888 include 'COMMON.DERIV'
2889 include 'COMMON.INTERACT'
2890 include 'COMMON.CONTACTS'
2891 include 'COMMON.TORSION'
2892 include 'COMMON.VECTORS'
2893 include 'COMMON.FFIELD'
2894 include 'COMMON.TIME1'
2895 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2896 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2897 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2898 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),a22,a23,a32,a33
2899 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2900 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2902 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2904 double precision scal_el /1.0d0/
2906 double precision scal_el /0.5d0/
2909 C 13-go grudnia roku pamietnego...
2910 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2911 & 0.0d0,1.0d0,0.0d0,
2912 & 0.0d0,0.0d0,1.0d0/
2913 c time00=MPI_Wtime()
2914 cd write (iout,*) "eelecij",i,j
2918 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2919 aaa=app(iteli,itelj)
2920 bbb=bpp(iteli,itelj)
2921 ael6i=ael6(iteli,itelj)
2922 ael3i=ael3(iteli,itelj)
2926 dx_normj=dc_norm(1,j)
2927 dy_normj=dc_norm(2,j)
2928 dz_normj=dc_norm(3,j)
2929 xj=c(1,j)+0.5D0*dxj-xmedi
2930 yj=c(2,j)+0.5D0*dyj-ymedi
2931 zj=c(3,j)+0.5D0*dzj-zmedi
2932 rij=xj*xj+yj*yj+zj*zj
2938 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2939 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2940 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2941 fac=cosa-3.0D0*cosb*cosg
2943 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2944 if (j.eq.i+2) ev1=scal_el*ev1
2949 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2952 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2953 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2956 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2957 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2958 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2959 cd & xmedi,ymedi,zmedi,xj,yj,zj
2961 if (energy_dec) then
2962 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2963 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2967 C Calculate contributions to the Cartesian gradient.
2970 facvdw=-6*rrmij*(ev1+evdwij)
2971 facel=-3*rrmij*(el1+eesij)
2977 * Radial derivatives. First process both termini of the fragment (i,j)
2983 c ghalf=0.5D0*ggg(k)
2984 c gelc(k,i)=gelc(k,i)+ghalf
2985 c gelc(k,j)=gelc(k,j)+ghalf
2987 c 9/28/08 AL Gradient compotents will be summed only at the end
2989 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2990 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2993 * Loop over residues i+1 thru j-1.
2997 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3004 c ghalf=0.5D0*ggg(k)
3005 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3006 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3008 c 9/28/08 AL Gradient compotents will be summed only at the end
3010 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3011 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3014 * Loop over residues i+1 thru j-1.
3018 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3025 fac=-3*rrmij*(facvdw+facvdw+facel)
3030 * Radial derivatives. First process both termini of the fragment (i,j)
3036 c ghalf=0.5D0*ggg(k)
3037 c gelc(k,i)=gelc(k,i)+ghalf
3038 c gelc(k,j)=gelc(k,j)+ghalf
3040 c 9/28/08 AL Gradient compotents will be summed only at the end
3042 gelc_long(k,j)=gelc(k,j)+ggg(k)
3043 gelc_long(k,i)=gelc(k,i)-ggg(k)
3046 * Loop over residues i+1 thru j-1.
3050 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3053 c 9/28/08 AL Gradient compotents will be summed only at the end
3058 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3059 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3065 ecosa=2.0D0*fac3*fac1+fac4
3068 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3069 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3071 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3072 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3074 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3075 cd & (dcosg(k),k=1,3)
3077 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3080 c ghalf=0.5D0*ggg(k)
3081 c gelc(k,i)=gelc(k,i)+ghalf
3082 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3083 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3084 c gelc(k,j)=gelc(k,j)+ghalf
3085 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3086 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3090 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3095 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3096 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3098 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3099 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3100 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3101 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3103 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3104 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3105 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3107 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3108 C energy of a peptide unit is assumed in the form of a second-order
3109 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3110 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3111 C are computed for EVERY pair of non-contiguous peptide groups.
3113 if (j.lt.nres-1) then
3124 muij(kkk)=mu(k,i)*mu(l,j)
3127 cd write (iout,*) 'EELEC: i',i,' j',j
3128 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3129 cd write(iout,*) 'muij',muij
3130 ury=scalar(uy(1,i),erij)
3131 urz=scalar(uz(1,i),erij)
3132 vry=scalar(uy(1,j),erij)
3133 vrz=scalar(uz(1,j),erij)
3134 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3135 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3136 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3137 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3138 fac=dsqrt(-ael6i)*r3ij
3143 cd write (iout,'(4i5,4f10.5)')
3144 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3145 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3146 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3147 cd & uy(:,j),uz(:,j)
3148 cd write (iout,'(4f10.5)')
3149 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3150 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3151 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3152 cd write (iout,'(9f10.5/)')
3153 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3154 C Derivatives of the elements of A in virtual-bond vectors
3155 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3157 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3158 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3159 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3160 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3161 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3162 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3163 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3164 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3165 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3166 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3167 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3168 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3170 C Compute radial contributions to the gradient
3188 C Add the contributions coming from er
3191 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3192 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3193 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3194 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3197 C Derivatives in DC(i)
3198 cgrad ghalf1=0.5d0*agg(k,1)
3199 cgrad ghalf2=0.5d0*agg(k,2)
3200 cgrad ghalf3=0.5d0*agg(k,3)
3201 cgrad ghalf4=0.5d0*agg(k,4)
3202 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3203 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3204 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3205 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3206 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3207 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3208 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3209 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3210 C Derivatives in DC(i+1)
3211 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3212 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3213 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3214 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3215 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3216 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3217 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3218 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3219 C Derivatives in DC(j)
3220 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3221 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3222 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3223 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3224 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3225 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3226 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3227 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3228 C Derivatives in DC(j+1) or DC(nres-1)
3229 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3230 & -3.0d0*vryg(k,3)*ury)
3231 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3232 & -3.0d0*vrzg(k,3)*ury)
3233 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3234 & -3.0d0*vryg(k,3)*urz)
3235 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3236 & -3.0d0*vrzg(k,3)*urz)
3237 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3239 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3252 aggi(k,l)=-aggi(k,l)
3253 aggi1(k,l)=-aggi1(k,l)
3254 aggj(k,l)=-aggj(k,l)
3255 aggj1(k,l)=-aggj1(k,l)
3258 if (j.lt.nres-1) then
3264 aggi(k,l)=-aggi(k,l)
3265 aggi1(k,l)=-aggi1(k,l)
3266 aggj(k,l)=-aggj(k,l)
3267 aggj1(k,l)=-aggj1(k,l)
3278 aggi(k,l)=-aggi(k,l)
3279 aggi1(k,l)=-aggi1(k,l)
3280 aggj(k,l)=-aggj(k,l)
3281 aggj1(k,l)=-aggj1(k,l)
3286 IF (wel_loc.gt.0.0d0) THEN
3287 C Contribution to the local-electrostatic energy coming from the i-j pair
3288 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3290 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3292 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3293 & 'eelloc',i,j,eel_loc_ij
3295 eel_loc=eel_loc+eel_loc_ij
3296 C Partial derivatives in virtual-bond dihedral angles gamma
3298 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3299 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3300 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3301 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3302 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3303 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3304 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3306 ggg(l)=agg(l,1)*muij(1)+
3307 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3308 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3309 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3310 cgrad ghalf=0.5d0*ggg(l)
3311 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3312 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3316 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3319 C Remaining derivatives of eello
3321 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3322 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3323 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3324 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3325 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3326 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3327 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3328 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3331 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3332 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3333 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3334 & .and. num_conti.le.maxconts) then
3335 c write (iout,*) i,j," entered corr"
3337 C Calculate the contact function. The ith column of the array JCONT will
3338 C contain the numbers of atoms that make contacts with the atom I (of numbers
3339 C greater than I). The arrays FACONT and GACONT will contain the values of
3340 C the contact function and its derivative.
3341 c r0ij=1.02D0*rpp(iteli,itelj)
3342 c r0ij=1.11D0*rpp(iteli,itelj)
3343 r0ij=2.20D0*rpp(iteli,itelj)
3344 c r0ij=1.55D0*rpp(iteli,itelj)
3345 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3346 if (fcont.gt.0.0D0) then
3347 num_conti=num_conti+1
3348 if (num_conti.gt.maxconts) then
3349 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3350 & ' will skip next contacts for this conf.'
3352 jcont_hb(num_conti,i)=j
3353 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3354 cd & " jcont_hb",jcont_hb(num_conti,i)
3355 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3356 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3357 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3359 d_cont(num_conti,i)=rij
3360 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3361 C --- Electrostatic-interaction matrix ---
3362 a_chuj(1,1,num_conti,i)=a22
3363 a_chuj(1,2,num_conti,i)=a23
3364 a_chuj(2,1,num_conti,i)=a32
3365 a_chuj(2,2,num_conti,i)=a33
3366 C --- Gradient of rij
3368 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3375 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3376 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3377 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3378 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3379 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3384 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3385 C Calculate contact energies
3387 wij=cosa-3.0D0*cosb*cosg
3390 c fac3=dsqrt(-ael6i)/r0ij**3
3391 fac3=dsqrt(-ael6i)*r3ij
3392 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3393 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3394 if (ees0tmp.gt.0) then
3395 ees0pij=dsqrt(ees0tmp)
3399 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3400 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3401 if (ees0tmp.gt.0) then
3402 ees0mij=dsqrt(ees0tmp)
3407 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3408 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3409 C Diagnostics. Comment out or remove after debugging!
3410 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3411 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3412 c ees0m(num_conti,i)=0.0D0
3414 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3415 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3416 C Angular derivatives of the contact function
3417 ees0pij1=fac3/ees0pij
3418 ees0mij1=fac3/ees0mij
3419 fac3p=-3.0D0*fac3*rrmij
3420 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3421 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3423 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3424 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3425 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3426 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3427 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3428 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3429 ecosap=ecosa1+ecosa2
3430 ecosbp=ecosb1+ecosb2
3431 ecosgp=ecosg1+ecosg2
3432 ecosam=ecosa1-ecosa2
3433 ecosbm=ecosb1-ecosb2
3434 ecosgm=ecosg1-ecosg2
3443 facont_hb(num_conti,i)=fcont
3444 fprimcont=fprimcont/rij
3445 cd facont_hb(num_conti,i)=1.0D0
3446 C Following line is for diagnostics.
3449 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3450 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3453 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3454 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3456 gggp(1)=gggp(1)+ees0pijp*xj
3457 gggp(2)=gggp(2)+ees0pijp*yj
3458 gggp(3)=gggp(3)+ees0pijp*zj
3459 gggm(1)=gggm(1)+ees0mijp*xj
3460 gggm(2)=gggm(2)+ees0mijp*yj
3461 gggm(3)=gggm(3)+ees0mijp*zj
3462 C Derivatives due to the contact function
3463 gacont_hbr(1,num_conti,i)=fprimcont*xj
3464 gacont_hbr(2,num_conti,i)=fprimcont*yj
3465 gacont_hbr(3,num_conti,i)=fprimcont*zj
3468 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3469 c following the change of gradient-summation algorithm.
3471 cgrad ghalfp=0.5D0*gggp(k)
3472 cgrad ghalfm=0.5D0*gggm(k)
3473 gacontp_hb1(k,num_conti,i)=!ghalfp
3474 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3475 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3476 gacontp_hb2(k,num_conti,i)=!ghalfp
3477 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3478 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3479 gacontp_hb3(k,num_conti,i)=gggp(k)
3480 gacontm_hb1(k,num_conti,i)=!ghalfm
3481 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3482 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3483 gacontm_hb2(k,num_conti,i)=!ghalfm
3484 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3485 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3486 gacontm_hb3(k,num_conti,i)=gggm(k)
3488 C Diagnostics. Comment out or remove after debugging!
3490 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3491 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3492 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3493 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3494 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3495 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3498 endif ! num_conti.le.maxconts
3501 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3504 ghalf=0.5d0*agg(l,k)
3505 aggi(l,k)=aggi(l,k)+ghalf
3506 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3507 aggj(l,k)=aggj(l,k)+ghalf
3510 if (j.eq.nres-1 .and. i.lt.j-2) then
3513 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3518 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3521 C-----------------------------------------------------------------------------
3522 subroutine eturn3(i,eello_turn3)
3523 C Third- and fourth-order contributions from turns
3524 implicit real*8 (a-h,o-z)
3525 include 'DIMENSIONS'
3526 include 'COMMON.IOUNITS'
3527 include 'COMMON.GEO'
3528 include 'COMMON.VAR'
3529 include 'COMMON.LOCAL'
3530 include 'COMMON.CHAIN'
3531 include 'COMMON.DERIV'
3532 include 'COMMON.INTERACT'
3533 include 'COMMON.CONTACTS'
3534 include 'COMMON.TORSION'
3535 include 'COMMON.VECTORS'
3536 include 'COMMON.FFIELD'
3537 include 'COMMON.CONTROL'
3539 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3540 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3541 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3542 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3543 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3544 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3545 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3548 c write (iout,*) "eturn3",i,j,j1,j2
3553 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3555 C Third-order contributions
3562 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3563 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3564 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3565 call transpose2(auxmat(1,1),auxmat1(1,1))
3566 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3567 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3568 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3569 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3570 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3571 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3572 cd & ' eello_turn3_num',4*eello_turn3_num
3573 C Derivatives in gamma(i)
3574 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3575 call transpose2(auxmat2(1,1),auxmat3(1,1))
3576 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3577 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3578 C Derivatives in gamma(i+1)
3579 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3580 call transpose2(auxmat2(1,1),auxmat3(1,1))
3581 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3582 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3583 & +0.5d0*(pizda(1,1)+pizda(2,2))
3584 C Cartesian derivatives
3586 c ghalf1=0.5d0*agg(l,1)
3587 c ghalf2=0.5d0*agg(l,2)
3588 c ghalf3=0.5d0*agg(l,3)
3589 c ghalf4=0.5d0*agg(l,4)
3590 a_temp(1,1)=aggi(l,1)!+ghalf1
3591 a_temp(1,2)=aggi(l,2)!+ghalf2
3592 a_temp(2,1)=aggi(l,3)!+ghalf3
3593 a_temp(2,2)=aggi(l,4)!+ghalf4
3594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3595 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3596 & +0.5d0*(pizda(1,1)+pizda(2,2))
3597 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3598 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3599 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3600 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3601 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3602 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3603 & +0.5d0*(pizda(1,1)+pizda(2,2))
3604 a_temp(1,1)=aggj(l,1)!+ghalf1
3605 a_temp(1,2)=aggj(l,2)!+ghalf2
3606 a_temp(2,1)=aggj(l,3)!+ghalf3
3607 a_temp(2,2)=aggj(l,4)!+ghalf4
3608 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3609 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3610 & +0.5d0*(pizda(1,1)+pizda(2,2))
3611 a_temp(1,1)=aggj1(l,1)
3612 a_temp(1,2)=aggj1(l,2)
3613 a_temp(2,1)=aggj1(l,3)
3614 a_temp(2,2)=aggj1(l,4)
3615 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3616 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3617 & +0.5d0*(pizda(1,1)+pizda(2,2))
3621 C-------------------------------------------------------------------------------
3622 subroutine eturn4(i,eello_turn4)
3623 C Third- and fourth-order contributions from turns
3624 implicit real*8 (a-h,o-z)
3625 include 'DIMENSIONS'
3626 include 'COMMON.IOUNITS'
3627 include 'COMMON.GEO'
3628 include 'COMMON.VAR'
3629 include 'COMMON.LOCAL'
3630 include 'COMMON.CHAIN'
3631 include 'COMMON.DERIV'
3632 include 'COMMON.INTERACT'
3633 include 'COMMON.CONTACTS'
3634 include 'COMMON.TORSION'
3635 include 'COMMON.VECTORS'
3636 include 'COMMON.FFIELD'
3637 include 'COMMON.CONTROL'
3639 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3640 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3641 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3642 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3643 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3644 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3645 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3648 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3650 C Fourth-order contributions
3658 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3659 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3660 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3665 iti1=itortyp(itype(i+1))
3666 iti2=itortyp(itype(i+2))
3667 iti3=itortyp(itype(i+3))
3668 C write(iout,*) i,"iti1",iti1," iti2",iti2," iti3",iti3,itype(i+3)
3669 call transpose2(EUg(1,1,i+1),e1t(1,1))
3670 call transpose2(Eug(1,1,i+2),e2t(1,1))
3671 call transpose2(Eug(1,1,i+3),e3t(1,1))
3672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3674 s1=scalar2(b1(1,iti2),auxvec(1))
3675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3677 s2=scalar2(b1(1,iti1),auxvec(1))
3678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3681 eello_turn4=eello_turn4-(s1+s2+s3)
3682 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3683 & 'eturn4',i,j,-(s1+s2+s3)
3684 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3685 cd & ' eello_turn4_num',8*eello_turn4_num
3686 C Derivatives in gamma(i)
3687 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3688 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3689 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3690 s1=scalar2(b1(1,iti2),auxvec(1))
3691 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3692 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3693 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3694 C Derivatives in gamma(i+1)
3695 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3696 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3697 s2=scalar2(b1(1,iti1),auxvec(1))
3698 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3699 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3700 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3701 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3702 C Derivatives in gamma(i+2)
3703 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3704 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3705 s1=scalar2(b1(1,iti2),auxvec(1))
3706 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3707 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3708 s2=scalar2(b1(1,iti1),auxvec(1))
3709 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3710 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3711 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3712 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3713 C Cartesian derivatives
3714 C Derivatives of this turn contributions in DC(i+2)
3715 if (j.lt.nres-1) then
3717 a_temp(1,1)=agg(l,1)
3718 a_temp(1,2)=agg(l,2)
3719 a_temp(2,1)=agg(l,3)
3720 a_temp(2,2)=agg(l,4)
3721 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3722 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3723 s1=scalar2(b1(1,iti2),auxvec(1))
3724 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3725 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3726 s2=scalar2(b1(1,iti1),auxvec(1))
3727 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3728 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3729 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3731 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3734 C Remaining derivatives of this turn contribution
3736 a_temp(1,1)=aggi(l,1)
3737 a_temp(1,2)=aggi(l,2)
3738 a_temp(2,1)=aggi(l,3)
3739 a_temp(2,2)=aggi(l,4)
3740 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3741 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3742 s1=scalar2(b1(1,iti2),auxvec(1))
3743 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3744 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3745 s2=scalar2(b1(1,iti1),auxvec(1))
3746 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3747 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3748 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3749 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3750 a_temp(1,1)=aggi1(l,1)
3751 a_temp(1,2)=aggi1(l,2)
3752 a_temp(2,1)=aggi1(l,3)
3753 a_temp(2,2)=aggi1(l,4)
3754 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3755 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3756 s1=scalar2(b1(1,iti2),auxvec(1))
3757 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3758 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3759 s2=scalar2(b1(1,iti1),auxvec(1))
3760 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3761 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3762 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3763 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3764 a_temp(1,1)=aggj(l,1)
3765 a_temp(1,2)=aggj(l,2)
3766 a_temp(2,1)=aggj(l,3)
3767 a_temp(2,2)=aggj(l,4)
3768 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3769 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3770 s1=scalar2(b1(1,iti2),auxvec(1))
3771 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3772 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3773 s2=scalar2(b1(1,iti1),auxvec(1))
3774 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3775 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3776 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3777 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3778 a_temp(1,1)=aggj1(l,1)
3779 a_temp(1,2)=aggj1(l,2)
3780 a_temp(2,1)=aggj1(l,3)
3781 a_temp(2,2)=aggj1(l,4)
3782 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3783 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3784 s1=scalar2(b1(1,iti2),auxvec(1))
3785 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3786 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3787 s2=scalar2(b1(1,iti1),auxvec(1))
3788 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3789 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3790 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3791 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3792 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3796 C-----------------------------------------------------------------------------
3797 subroutine vecpr(u,v,w)
3798 implicit real*8(a-h,o-z)
3799 dimension u(3),v(3),w(3)
3800 w(1)=u(2)*v(3)-u(3)*v(2)
3801 w(2)=-u(1)*v(3)+u(3)*v(1)
3802 w(3)=u(1)*v(2)-u(2)*v(1)
3805 C-----------------------------------------------------------------------------
3806 subroutine unormderiv(u,ugrad,unorm,ungrad)
3807 C This subroutine computes the derivatives of a normalized vector u, given
3808 C the derivatives computed without normalization conditions, ugrad. Returns
3811 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3812 double precision vec(3)
3813 double precision scalar
3815 c write (2,*) 'ugrad',ugrad
3818 vec(i)=scalar(ugrad(1,i),u(1))
3820 c write (2,*) 'vec',vec
3823 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3826 c write (2,*) 'ungrad',ungrad
3829 C-----------------------------------------------------------------------------
3830 subroutine escp_soft_sphere(evdw2,evdw2_14)
3832 C This subroutine calculates the excluded-volume interaction energy between
3833 C peptide-group centers and side chains and its gradient in virtual-bond and
3834 C side-chain vectors.
3836 implicit real*8 (a-h,o-z)
3837 include 'DIMENSIONS'
3838 include 'COMMON.GEO'
3839 include 'COMMON.VAR'
3840 include 'COMMON.LOCAL'
3841 include 'COMMON.CHAIN'
3842 include 'COMMON.DERIV'
3843 include 'COMMON.INTERACT'
3844 include 'COMMON.FFIELD'
3845 include 'COMMON.IOUNITS'
3846 include 'COMMON.CONTROL'
3851 cd print '(a)','Enter ESCP'
3852 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3853 do i=iatscp_s,iatscp_e
3854 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
3856 xi=0.5D0*(c(1,i)+c(1,i+1))
3857 yi=0.5D0*(c(2,i)+c(2,i+1))
3858 zi=0.5D0*(c(3,i)+c(3,i+1))
3860 do iint=1,nscp_gr(i)
3862 do j=iscpstart(i,iint),iscpend(i,iint)
3863 if (itype(j).eq.21) cycle
3865 C Uncomment following three lines for SC-p interactions
3869 C Uncomment following three lines for Ca-p interactions
3873 rij=xj*xj+yj*yj+zj*zj
3876 if (rij.lt.r0ijsq) then
3877 evdwij=0.25d0*(rij-r0ijsq)**2
3885 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3890 cgrad if (j.lt.i) then
3891 cd write (iout,*) 'j<i'
3892 C Uncomment following three lines for SC-p interactions
3894 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3897 cd write (iout,*) 'j>i'
3899 cgrad ggg(k)=-ggg(k)
3900 C Uncomment following line for SC-p interactions
3901 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3905 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3907 cgrad kstart=min0(i+1,j)
3908 cgrad kend=max0(i-1,j-1)
3909 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3910 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3911 cgrad do k=kstart,kend
3913 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3917 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3918 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3926 C-----------------------------------------------------------------------------
3927 subroutine escp(evdw2,evdw2_14)
3929 C This subroutine calculates the excluded-volume interaction energy between
3930 C peptide-group centers and side chains and its gradient in virtual-bond and
3931 C side-chain vectors.
3933 implicit real*8 (a-h,o-z)
3934 include 'DIMENSIONS'
3935 include 'COMMON.GEO'
3936 include 'COMMON.VAR'
3937 include 'COMMON.LOCAL'
3938 include 'COMMON.CHAIN'
3939 include 'COMMON.DERIV'
3940 include 'COMMON.INTERACT'
3941 include 'COMMON.FFIELD'
3942 include 'COMMON.IOUNITS'
3943 include 'COMMON.CONTROL'
3947 cd print '(a)','Enter ESCP'
3948 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3949 do i=iatscp_s,iatscp_e
3950 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
3952 xi=0.5D0*(c(1,i)+c(1,i+1))
3953 yi=0.5D0*(c(2,i)+c(2,i+1))
3954 zi=0.5D0*(c(3,i)+c(3,i+1))
3956 do iint=1,nscp_gr(i)
3958 do j=iscpstart(i,iint),iscpend(i,iint)
3960 if (itypj.eq.21) cycle
3961 C Uncomment following three lines for SC-p interactions
3965 C Uncomment following three lines for Ca-p interactions
3969 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3971 e1=fac*fac*aad(itypj,iteli)
3972 e2=fac*bad(itypj,iteli)
3973 if (iabs(j-i) .le. 2) then
3976 evdw2_14=evdw2_14+e1+e2
3980 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3981 & 'evdw2',i,j,evdwij
3983 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3985 fac=-(evdwij+e1)*rrij
3989 cgrad if (j.lt.i) then
3990 cd write (iout,*) 'j<i'
3991 C Uncomment following three lines for SC-p interactions
3993 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3996 cd write (iout,*) 'j>i'
3998 cgrad ggg(k)=-ggg(k)
3999 C Uncomment following line for SC-p interactions
4000 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4001 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4005 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4007 cgrad kstart=min0(i+1,j)
4008 cgrad kend=max0(i-1,j-1)
4009 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4010 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4011 cgrad do k=kstart,kend
4013 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4017 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4018 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4026 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4027 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4028 gradx_scp(j,i)=expon*gradx_scp(j,i)
4031 C******************************************************************************
4035 C To save time the factor EXPON has been extracted from ALL components
4036 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4039 C******************************************************************************
4042 C--------------------------------------------------------------------------
4043 subroutine edis(ehpb)
4045 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4047 implicit real*8 (a-h,o-z)
4048 include 'DIMENSIONS'
4049 include 'COMMON.SBRIDGE'
4050 include 'COMMON.CHAIN'
4051 include 'COMMON.DERIV'
4052 include 'COMMON.VAR'
4053 include 'COMMON.INTERACT'
4054 include 'COMMON.IOUNITS'
4057 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4058 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4059 if (link_end.eq.0) return
4060 do i=link_start,link_end
4061 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4062 C CA-CA distance used in regularization of structure.
4065 C iii and jjj point to the residues for which the distance is assigned.
4066 if (ii.gt.nres) then
4073 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4074 c & dhpb(i),dhpb1(i),forcon(i)
4075 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4076 C distance and angle dependent SS bond potential.
4077 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4078 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4079 if (.not.dyn_ss .and. i.le.nss) then
4080 C 15/02/13 CC dynamic SSbond - additional check
4082 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4083 call ssbond_ene(iii,jjj,eij)
4086 cd write (iout,*) "eij",eij
4088 C Calculate the distance between the two points and its difference from the
4092 C Get the force constant corresponding to this distance.
4094 C Calculate the contribution to energy.
4095 ehpb=ehpb+waga*rdis*rdis
4097 C Evaluate gradient.
4100 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4101 cd & ' waga=',waga,' fac=',fac
4103 ggg(j)=fac*(c(j,jj)-c(j,ii))
4105 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4106 C If this is a SC-SC distance, we need to calculate the contributions to the
4107 C Cartesian gradient in the SC vectors (ghpbx).
4110 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4111 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4114 cgrad do j=iii,jjj-1
4116 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4120 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4121 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4128 C--------------------------------------------------------------------------
4129 subroutine ssbond_ene(i,j,eij)
4131 C Calculate the distance and angle dependent SS-bond potential energy
4132 C using a free-energy function derived based on RHF/6-31G** ab initio
4133 C calculations of diethyl disulfide.
4135 C A. Liwo and U. Kozlowska, 11/24/03
4137 implicit real*8 (a-h,o-z)
4138 include 'DIMENSIONS'
4139 include 'COMMON.SBRIDGE'
4140 include 'COMMON.CHAIN'
4141 include 'COMMON.DERIV'
4142 include 'COMMON.LOCAL'
4143 include 'COMMON.INTERACT'
4144 include 'COMMON.VAR'
4145 include 'COMMON.IOUNITS'
4146 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4151 dxi=dc_norm(1,nres+i)
4152 dyi=dc_norm(2,nres+i)
4153 dzi=dc_norm(3,nres+i)
4154 c dsci_inv=dsc_inv(itypi)
4155 dsci_inv=vbld_inv(nres+i)
4157 c dscj_inv=dsc_inv(itypj)
4158 dscj_inv=vbld_inv(nres+j)
4162 dxj=dc_norm(1,nres+j)
4163 dyj=dc_norm(2,nres+j)
4164 dzj=dc_norm(3,nres+j)
4165 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4170 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4171 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4172 om12=dxi*dxj+dyi*dyj+dzi*dzj
4174 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4175 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4181 deltat12=om2-om1+2.0d0
4183 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4184 & +akct*deltad*deltat12
4185 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4186 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4187 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4188 c & " deltat12",deltat12," eij",eij
4189 ed=2*akcm*deltad+akct*deltat12
4191 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4192 eom1=-2*akth*deltat1-pom1-om2*pom2
4193 eom2= 2*akth*deltat2+pom1-om1*pom2
4196 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4197 ghpbx(k,i)=ghpbx(k,i)-ggk
4198 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4199 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4200 ghpbx(k,j)=ghpbx(k,j)+ggk
4201 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4202 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4203 ghpbc(k,i)=ghpbc(k,i)-ggk
4204 ghpbc(k,j)=ghpbc(k,j)+ggk
4207 C Calculate the components of the gradient in DC and X
4211 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4216 C--------------------------------------------------------------------------
4217 subroutine ebond(estr)
4219 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4221 implicit real*8 (a-h,o-z)
4222 include 'DIMENSIONS'
4223 include 'COMMON.LOCAL'
4224 include 'COMMON.GEO'
4225 include 'COMMON.INTERACT'
4226 include 'COMMON.DERIV'
4227 include 'COMMON.VAR'
4228 include 'COMMON.CHAIN'
4229 include 'COMMON.IOUNITS'
4230 include 'COMMON.NAMES'
4231 include 'COMMON.FFIELD'
4232 include 'COMMON.CONTROL'
4233 include 'COMMON.SETUP'
4234 double precision u(3),ud(3)
4237 do i=ibondp_start,ibondp_end
4238 if (itype(i-1).eq.21 .or. itype(i).eq.21) then
4239 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4241 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4242 & *dc(j,i-1)/vbld(i)
4244 if (energy_dec) write(iout,*)
4245 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4247 diff = vbld(i)-vbldp0
4248 if (energy_dec) write (iout,*)
4249 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4252 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4254 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4257 estr=0.5d0*AKP*estr+estr1
4259 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4261 do i=ibond_start,ibond_end
4263 if (iti.ne.10 .and. iti.ne.21) then
4266 diff=vbld(i+nres)-vbldsc0(1,iti)
4267 if (energy_dec) write (iout,*)
4268 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4269 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4270 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4272 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4276 diff=vbld(i+nres)-vbldsc0(j,iti)
4277 ud(j)=aksc(j,iti)*diff
4278 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4292 uprod2=uprod2*u(k)*u(k)
4296 usumsqder=usumsqder+ud(j)*uprod2
4298 estr=estr+uprod/usum
4300 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4308 C--------------------------------------------------------------------------
4309 subroutine ebend(etheta)
4311 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4312 C angles gamma and its derivatives in consecutive thetas and gammas.
4314 implicit real*8 (a-h,o-z)
4315 include 'DIMENSIONS'
4316 include 'COMMON.LOCAL'
4317 include 'COMMON.GEO'
4318 include 'COMMON.INTERACT'
4319 include 'COMMON.DERIV'
4320 include 'COMMON.VAR'
4321 include 'COMMON.CHAIN'
4322 include 'COMMON.IOUNITS'
4323 include 'COMMON.NAMES'
4324 include 'COMMON.FFIELD'
4325 include 'COMMON.CONTROL'
4326 common /calcthet/ term1,term2,termm,diffak,ratak,
4327 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4328 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4329 double precision y(2),z(2)
4331 c time11=dexp(-2*time)
4334 c write (*,'(a,i2)') 'EBEND ICG=',icg
4335 do i=ithet_start,ithet_end
4336 if (itype(i-1).eq.21) cycle
4337 C Zero the energy function and its derivative at 0 or pi.
4338 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4340 if (i.gt.3 .and. itype(i-2).ne.21) then
4343 if (phii.ne.phii) phii=150.0
4353 if (i.lt.nres .and. itype(i).ne.21) then
4356 if (phii1.ne.phii1) phii1=150.0
4368 C Calculate the "mean" value of theta from the part of the distribution
4369 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4370 C In following comments this theta will be referred to as t_c.
4371 thet_pred_mean=0.0d0
4375 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4377 dthett=thet_pred_mean*ssd
4378 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4379 C Derivatives of the "mean" values in gamma1 and gamma2.
4380 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4381 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4382 if (theta(i).gt.pi-delta) then
4383 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4385 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4386 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4387 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4389 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4391 else if (theta(i).lt.delta) then
4392 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4393 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4394 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4396 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4397 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4400 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4403 etheta=etheta+ethetai
4404 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4406 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4407 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4408 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4410 C Ufff.... We've done all this!!!
4413 C---------------------------------------------------------------------------
4414 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4416 implicit real*8 (a-h,o-z)
4417 include 'DIMENSIONS'
4418 include 'COMMON.LOCAL'
4419 include 'COMMON.IOUNITS'
4420 common /calcthet/ term1,term2,termm,diffak,ratak,
4421 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4422 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4423 C Calculate the contributions to both Gaussian lobes.
4424 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4425 C The "polynomial part" of the "standard deviation" of this part of
4429 sig=sig*thet_pred_mean+polthet(j,it)
4431 C Derivative of the "interior part" of the "standard deviation of the"
4432 C gamma-dependent Gaussian lobe in t_c.
4433 sigtc=3*polthet(3,it)
4435 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4438 C Set the parameters of both Gaussian lobes of the distribution.
4439 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4440 fac=sig*sig+sigc0(it)
4443 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4444 sigsqtc=-4.0D0*sigcsq*sigtc
4445 c print *,i,sig,sigtc,sigsqtc
4446 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4447 sigtc=-sigtc/(fac*fac)
4448 C Following variable is sigma(t_c)**(-2)
4449 sigcsq=sigcsq*sigcsq
4451 sig0inv=1.0D0/sig0i**2
4452 delthec=thetai-thet_pred_mean
4453 delthe0=thetai-theta0i
4454 term1=-0.5D0*sigcsq*delthec*delthec
4455 term2=-0.5D0*sig0inv*delthe0*delthe0
4456 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4457 C NaNs in taking the logarithm. We extract the largest exponent which is added
4458 C to the energy (this being the log of the distribution) at the end of energy
4459 C term evaluation for this virtual-bond angle.
4460 if (term1.gt.term2) then
4462 term2=dexp(term2-termm)
4466 term1=dexp(term1-termm)
4469 C The ratio between the gamma-independent and gamma-dependent lobes of
4470 C the distribution is a Gaussian function of thet_pred_mean too.
4471 diffak=gthet(2,it)-thet_pred_mean
4472 ratak=diffak/gthet(3,it)**2
4473 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4474 C Let's differentiate it in thet_pred_mean NOW.
4476 C Now put together the distribution terms to make complete distribution.
4477 termexp=term1+ak*term2
4478 termpre=sigc+ak*sig0i
4479 C Contribution of the bending energy from this theta is just the -log of
4480 C the sum of the contributions from the two lobes and the pre-exponential
4481 C factor. Simple enough, isn't it?
4482 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4483 C NOW the derivatives!!!
4484 C 6/6/97 Take into account the deformation.
4485 E_theta=(delthec*sigcsq*term1
4486 & +ak*delthe0*sig0inv*term2)/termexp
4487 E_tc=((sigtc+aktc*sig0i)/termpre
4488 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4489 & aktc*term2)/termexp)
4492 c-----------------------------------------------------------------------------
4493 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4494 implicit real*8 (a-h,o-z)
4495 include 'DIMENSIONS'
4496 include 'COMMON.LOCAL'
4497 include 'COMMON.IOUNITS'
4498 common /calcthet/ term1,term2,termm,diffak,ratak,
4499 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4500 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4501 delthec=thetai-thet_pred_mean
4502 delthe0=thetai-theta0i
4503 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4504 t3 = thetai-thet_pred_mean
4508 t14 = t12+t6*sigsqtc
4510 t21 = thetai-theta0i
4516 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4517 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4518 & *(-t12*t9-ak*sig0inv*t27)
4522 C--------------------------------------------------------------------------
4523 subroutine ebend(etheta)
4525 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4526 C angles gamma and its derivatives in consecutive thetas and gammas.
4527 C ab initio-derived potentials from
4528 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4530 implicit real*8 (a-h,o-z)
4531 include 'DIMENSIONS'
4532 include 'COMMON.LOCAL'
4533 include 'COMMON.GEO'
4534 include 'COMMON.INTERACT'
4535 include 'COMMON.DERIV'
4536 include 'COMMON.VAR'
4537 include 'COMMON.CHAIN'
4538 include 'COMMON.IOUNITS'
4539 include 'COMMON.NAMES'
4540 include 'COMMON.FFIELD'
4541 include 'COMMON.CONTROL'
4542 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4543 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4544 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4545 & sinph1ph2(maxdouble,maxdouble)
4546 logical lprn /.false./, lprn1 /.false./
4548 do i=ithet_start,ithet_end
4549 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4550 &(itype(i).eq.ntyp1)) cycle
4554 theti2=0.5d0*theta(i)
4555 ityp2=ithetyp(itype(i-1))
4557 coskt(k)=dcos(k*theti2)
4558 sinkt(k)=dsin(k*theti2)
4561 if (i.gt.3 .and. itype(imax0(i-3,1)).ne.ntyp1) then
4564 if (phii.ne.phii) phii=150.0
4568 ityp1=ithetyp(itype(i-2))
4570 cosph1(k)=dcos(k*phii)
4571 sinph1(k)=dsin(k*phii)
4575 ityp1=ithetyp(itype(i-2))
4581 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4584 if (phii1.ne.phii1) phii1=150.0
4589 ityp3=ithetyp(itype(i))
4591 cosph2(k)=dcos(k*phii1)
4592 sinph2(k)=dsin(k*phii1)
4596 ityp3=ithetyp(itype(i))
4602 ethetai=aa0thet(ityp1,ityp2,ityp3)
4605 ccl=cosph1(l)*cosph2(k-l)
4606 ssl=sinph1(l)*sinph2(k-l)
4607 scl=sinph1(l)*cosph2(k-l)
4608 csl=cosph1(l)*sinph2(k-l)
4609 cosph1ph2(l,k)=ccl-ssl
4610 cosph1ph2(k,l)=ccl+ssl
4611 sinph1ph2(l,k)=scl+csl
4612 sinph1ph2(k,l)=scl-csl
4616 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4617 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4618 write (iout,*) "coskt and sinkt"
4620 write (iout,*) k,coskt(k),sinkt(k)
4624 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4625 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4628 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4629 & " ethetai",ethetai
4632 write (iout,*) "cosph and sinph"
4634 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4636 write (iout,*) "cosph1ph2 and sinph2ph2"
4639 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4640 & sinph1ph2(l,k),sinph1ph2(k,l)
4643 write(iout,*) "ethetai",ethetai
4647 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4648 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4649 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4650 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4651 ethetai=ethetai+sinkt(m)*aux
4652 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4653 dephii=dephii+k*sinkt(m)*(
4654 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4655 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4656 dephii1=dephii1+k*sinkt(m)*(
4657 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4658 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4660 & write (iout,*) "m",m," k",k," bbthet",
4661 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4662 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4663 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4664 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4668 & write(iout,*) "ethetai",ethetai
4672 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4673 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4674 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4675 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4676 ethetai=ethetai+sinkt(m)*aux
4677 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4678 dephii=dephii+l*sinkt(m)*(
4679 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4680 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4681 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4682 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4683 dephii1=dephii1+(k-l)*sinkt(m)*(
4684 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4685 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4686 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4687 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4689 write (iout,*) "m",m," k",k," l",l," ffthet",
4690 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4691 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4692 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4693 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4694 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4695 & cosph1ph2(k,l)*sinkt(m),
4696 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4702 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4703 & i,theta(i)*rad2deg,phii*rad2deg,
4704 & phii1*rad2deg,ethetai
4705 etheta=etheta+ethetai
4706 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4708 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4709 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4710 gloc(nphi+i-2,icg)=wang*dethetai
4716 c-----------------------------------------------------------------------------
4717 subroutine esc(escloc)
4718 C Calculate the local energy of a side chain and its derivatives in the
4719 C corresponding virtual-bond valence angles THETA and the spherical angles
4721 implicit real*8 (a-h,o-z)
4722 include 'DIMENSIONS'
4723 include 'COMMON.GEO'
4724 include 'COMMON.LOCAL'
4725 include 'COMMON.VAR'
4726 include 'COMMON.INTERACT'
4727 include 'COMMON.DERIV'
4728 include 'COMMON.CHAIN'
4729 include 'COMMON.IOUNITS'
4730 include 'COMMON.NAMES'
4731 include 'COMMON.FFIELD'
4732 include 'COMMON.CONTROL'
4733 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4734 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4735 common /sccalc/ time11,time12,time112,theti,it,nlobit
4738 c write (iout,'(a)') 'ESC'
4739 do i=loc_start,loc_end
4742 if (it.eq.10) goto 1
4744 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4745 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4746 theti=theta(i+1)-pipol
4751 if (x(2).gt.pi-delta) then
4755 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4757 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4758 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4760 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4761 & ddersc0(1),dersc(1))
4762 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4763 & ddersc0(3),dersc(3))
4765 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4767 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4768 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4769 & dersc0(2),esclocbi,dersc02)
4770 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4772 call splinthet(x(2),0.5d0*delta,ss,ssd)
4777 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4779 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4780 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4782 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4784 c write (iout,*) escloci
4785 else if (x(2).lt.delta) then
4789 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4791 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4792 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4794 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4795 & ddersc0(1),dersc(1))
4796 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4797 & ddersc0(3),dersc(3))
4799 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4801 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4802 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4803 & dersc0(2),esclocbi,dersc02)
4804 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4809 call splinthet(x(2),0.5d0*delta,ss,ssd)
4811 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4813 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4814 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4816 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4817 c write (iout,*) escloci
4819 call enesc(x,escloci,dersc,ddummy,.false.)
4822 escloc=escloc+escloci
4823 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4824 & 'escloc',i,escloci
4825 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4827 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4829 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4830 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4835 C---------------------------------------------------------------------------
4836 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4837 implicit real*8 (a-h,o-z)
4838 include 'DIMENSIONS'
4839 include 'COMMON.GEO'
4840 include 'COMMON.LOCAL'
4841 include 'COMMON.IOUNITS'
4842 common /sccalc/ time11,time12,time112,theti,it,nlobit
4843 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4844 double precision contr(maxlob,-1:1)
4846 c write (iout,*) 'it=',it,' nlobit=',nlobit
4850 if (mixed) ddersc(j)=0.0d0
4854 C Because of periodicity of the dependence of the SC energy in omega we have
4855 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4856 C To avoid underflows, first compute & store the exponents.
4864 z(k)=x(k)-censc(k,j,it)
4869 Axk=Axk+gaussc(l,k,j,it)*z(l)
4875 expfac=expfac+Ax(k,j,iii)*z(k)
4883 C As in the case of ebend, we want to avoid underflows in exponentiation and
4884 C subsequent NaNs and INFs in energy calculation.
4885 C Find the largest exponent
4889 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4893 cd print *,'it=',it,' emin=',emin
4895 C Compute the contribution to SC energy and derivatives
4900 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4901 if(adexp.ne.adexp) adexp=1.0
4904 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4906 cd print *,'j=',j,' expfac=',expfac
4907 escloc_i=escloc_i+expfac
4909 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4913 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4914 & +gaussc(k,2,j,it))*expfac
4921 dersc(1)=dersc(1)/cos(theti)**2
4922 ddersc(1)=ddersc(1)/cos(theti)**2
4925 escloci=-(dlog(escloc_i)-emin)
4927 dersc(j)=dersc(j)/escloc_i
4931 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4936 C------------------------------------------------------------------------------
4937 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4938 implicit real*8 (a-h,o-z)
4939 include 'DIMENSIONS'
4940 include 'COMMON.GEO'
4941 include 'COMMON.LOCAL'
4942 include 'COMMON.IOUNITS'
4943 common /sccalc/ time11,time12,time112,theti,it,nlobit
4944 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4945 double precision contr(maxlob)
4956 z(k)=x(k)-censc(k,j,it)
4962 Axk=Axk+gaussc(l,k,j,it)*z(l)
4968 expfac=expfac+Ax(k,j)*z(k)
4973 C As in the case of ebend, we want to avoid underflows in exponentiation and
4974 C subsequent NaNs and INFs in energy calculation.
4975 C Find the largest exponent
4978 if (emin.gt.contr(j)) emin=contr(j)
4982 C Compute the contribution to SC energy and derivatives
4986 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4987 escloc_i=escloc_i+expfac
4989 dersc(k)=dersc(k)+Ax(k,j)*expfac
4991 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4992 & +gaussc(1,2,j,it))*expfac
4996 dersc(1)=dersc(1)/cos(theti)**2
4997 dersc12=dersc12/cos(theti)**2
4998 escloci=-(dlog(escloc_i)-emin)
5000 dersc(j)=dersc(j)/escloc_i
5002 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5006 c----------------------------------------------------------------------------------
5007 subroutine esc(escloc)
5008 C Calculate the local energy of a side chain and its derivatives in the
5009 C corresponding virtual-bond valence angles THETA and the spherical angles
5010 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5011 C added by Urszula Kozlowska. 07/11/2007
5013 implicit real*8 (a-h,o-z)
5014 include 'DIMENSIONS'
5015 include 'COMMON.GEO'
5016 include 'COMMON.LOCAL'
5017 include 'COMMON.VAR'
5018 include 'COMMON.SCROT'
5019 include 'COMMON.INTERACT'
5020 include 'COMMON.DERIV'
5021 include 'COMMON.CHAIN'
5022 include 'COMMON.IOUNITS'
5023 include 'COMMON.NAMES'
5024 include 'COMMON.FFIELD'
5025 include 'COMMON.CONTROL'
5026 include 'COMMON.VECTORS'
5027 double precision x_prime(3),y_prime(3),z_prime(3)
5028 & , sumene,dsc_i,dp2_i,x(65),
5029 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5030 & de_dxx,de_dyy,de_dzz,de_dt
5031 double precision s1_t,s1_6_t,s2_t,s2_6_t
5033 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5034 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5035 & dt_dCi(3),dt_dCi1(3)
5036 common /sccalc/ time11,time12,time112,theti,it,nlobit
5039 do i=loc_start,loc_end
5040 if (itype(i).eq.21) cycle
5041 costtab(i+1) =dcos(theta(i+1))
5042 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5043 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5044 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5045 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5046 cosfac=dsqrt(cosfac2)
5047 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5048 sinfac=dsqrt(sinfac2)
5050 if (it.eq.10) goto 1
5052 C Compute the axes of tghe local cartesian coordinates system; store in
5053 c x_prime, y_prime and z_prime
5060 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5061 C & dc_norm(3,i+nres)
5063 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5064 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5067 z_prime(j) = -uz(j,i-1)
5070 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5071 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5072 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5073 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5074 c & " xy",scalar(x_prime(1),y_prime(1)),
5075 c & " xz",scalar(x_prime(1),z_prime(1)),
5076 c & " yy",scalar(y_prime(1),y_prime(1)),
5077 c & " yz",scalar(y_prime(1),z_prime(1)),
5078 c & " zz",scalar(z_prime(1),z_prime(1))
5080 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5081 C to local coordinate system. Store in xx, yy, zz.
5087 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5088 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5089 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5096 C Compute the energy of the ith side cbain
5098 c write (2,*) "xx",xx," yy",yy," zz",zz
5101 x(j) = sc_parmin(j,it)
5104 Cc diagnostics - remove later
5106 yy1 = dsin(alph(2))*dcos(omeg(2))
5107 zz1 = -dsin(alph(2))*dsin(omeg(2))
5108 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5109 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5111 C," --- ", xx_w,yy_w,zz_w
5114 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5115 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5117 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5118 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5120 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5121 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5122 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5123 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5124 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5126 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5127 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5128 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5129 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5130 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5132 dsc_i = 0.743d0+x(61)
5134 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5135 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5136 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5137 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5138 s1=(1+x(63))/(0.1d0 + dscp1)
5139 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5140 s2=(1+x(65))/(0.1d0 + dscp2)
5141 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5142 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5143 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5144 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5146 c & dscp1,dscp2,sumene
5147 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5148 escloc = escloc + sumene
5149 c write (2,*) "i",i," escloc",sumene,escloc
5152 C This section to check the numerical derivatives of the energy of ith side
5153 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5154 C #define DEBUG in the code to turn it on.
5156 write (2,*) "sumene =",sumene
5160 write (2,*) xx,yy,zz
5161 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5162 de_dxx_num=(sumenep-sumene)/aincr
5164 write (2,*) "xx+ sumene from enesc=",sumenep
5167 write (2,*) xx,yy,zz
5168 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5169 de_dyy_num=(sumenep-sumene)/aincr
5171 write (2,*) "yy+ sumene from enesc=",sumenep
5174 write (2,*) xx,yy,zz
5175 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5176 de_dzz_num=(sumenep-sumene)/aincr
5178 write (2,*) "zz+ sumene from enesc=",sumenep
5179 costsave=cost2tab(i+1)
5180 sintsave=sint2tab(i+1)
5181 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5182 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5183 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5184 de_dt_num=(sumenep-sumene)/aincr
5185 write (2,*) " t+ sumene from enesc=",sumenep
5186 cost2tab(i+1)=costsave
5187 sint2tab(i+1)=sintsave
5188 C End of diagnostics section.
5191 C Compute the gradient of esc
5193 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5194 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5195 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5196 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5197 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5198 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5199 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5200 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5201 pom1=(sumene3*sint2tab(i+1)+sumene1)
5202 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5203 pom2=(sumene4*cost2tab(i+1)+sumene2)
5204 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5205 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5206 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5207 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5209 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5210 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5211 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5213 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5214 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5215 & +(pom1+pom2)*pom_dx
5217 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5220 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5221 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5222 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5224 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5225 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5226 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5227 & +x(59)*zz**2 +x(60)*xx*zz
5228 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5229 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5230 & +(pom1-pom2)*pom_dy
5232 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5235 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5236 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5237 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5238 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5239 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5240 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5241 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5242 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5244 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5247 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5248 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5249 & +pom1*pom_dt1+pom2*pom_dt2
5251 write(2,*), "de_dt = ", de_dt,de_dt_num
5255 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5256 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5257 cosfac2xx=cosfac2*xx
5258 sinfac2yy=sinfac2*yy
5260 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5262 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5264 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5265 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5266 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5267 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5268 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5269 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5270 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5271 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5272 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5273 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5277 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5278 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5281 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5282 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5283 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5285 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5286 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5290 dXX_Ctab(k,i)=dXX_Ci(k)
5291 dXX_C1tab(k,i)=dXX_Ci1(k)
5292 dYY_Ctab(k,i)=dYY_Ci(k)
5293 dYY_C1tab(k,i)=dYY_Ci1(k)
5294 dZZ_Ctab(k,i)=dZZ_Ci(k)
5295 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5296 dXX_XYZtab(k,i)=dXX_XYZ(k)
5297 dYY_XYZtab(k,i)=dYY_XYZ(k)
5298 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5302 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5303 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5304 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5305 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5306 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5308 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5309 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5310 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5311 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5312 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5313 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5314 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5315 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5317 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5318 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5320 C to check gradient call subroutine check_grad
5326 c------------------------------------------------------------------------------
5327 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5329 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5330 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5331 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5332 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5334 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5335 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5337 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5338 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5339 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5340 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5341 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5343 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5344 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5345 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5346 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5347 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5349 dsc_i = 0.743d0+x(61)
5351 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5352 & *(xx*cost2+yy*sint2))
5353 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5354 & *(xx*cost2-yy*sint2))
5355 s1=(1+x(63))/(0.1d0 + dscp1)
5356 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5357 s2=(1+x(65))/(0.1d0 + dscp2)
5358 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5359 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5360 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5365 c------------------------------------------------------------------------------
5366 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5368 C This procedure calculates two-body contact function g(rij) and its derivative:
5371 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5374 C where x=(rij-r0ij)/delta
5376 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5379 double precision rij,r0ij,eps0ij,fcont,fprimcont
5380 double precision x,x2,x4,delta
5384 if (x.lt.-1.0D0) then
5387 else if (x.le.1.0D0) then
5390 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5391 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5398 c------------------------------------------------------------------------------
5399 subroutine splinthet(theti,delta,ss,ssder)
5400 implicit real*8 (a-h,o-z)
5401 include 'DIMENSIONS'
5402 include 'COMMON.VAR'
5403 include 'COMMON.GEO'
5406 if (theti.gt.pipol) then
5407 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5409 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5414 c------------------------------------------------------------------------------
5415 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5417 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5418 double precision ksi,ksi2,ksi3,a1,a2,a3
5419 a1=fprim0*delta/(f1-f0)
5425 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5426 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5429 c------------------------------------------------------------------------------
5430 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5432 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5433 double precision ksi,ksi2,ksi3,a1,a2,a3
5438 a2=3*(f1x-f0x)-2*fprim0x*delta
5439 a3=fprim0x*delta-2*(f1x-f0x)
5440 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5443 C-----------------------------------------------------------------------------
5445 C-----------------------------------------------------------------------------
5446 subroutine etor(etors,edihcnstr)
5447 implicit real*8 (a-h,o-z)
5448 include 'DIMENSIONS'
5449 include 'COMMON.VAR'
5450 include 'COMMON.GEO'
5451 include 'COMMON.LOCAL'
5452 include 'COMMON.TORSION'
5453 include 'COMMON.INTERACT'
5454 include 'COMMON.DERIV'
5455 include 'COMMON.CHAIN'
5456 include 'COMMON.NAMES'
5457 include 'COMMON.IOUNITS'
5458 include 'COMMON.FFIELD'
5459 include 'COMMON.TORCNSTR'
5460 include 'COMMON.CONTROL'
5462 C Set lprn=.true. for debugging
5466 do i=iphi_start,iphi_end
5468 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5469 & .or. itype(i).eq.21) cycle
5470 itori=itortyp(itype(i-2))
5471 itori1=itortyp(itype(i-1))
5474 C Proline-Proline pair is a special case...
5475 if (itori.eq.3 .and. itori1.eq.3) then
5476 if (phii.gt.-dwapi3) then
5478 fac=1.0D0/(1.0D0-cosphi)
5479 etorsi=v1(1,3,3)*fac
5480 etorsi=etorsi+etorsi
5481 etors=etors+etorsi-v1(1,3,3)
5482 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5483 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5486 v1ij=v1(j+1,itori,itori1)
5487 v2ij=v2(j+1,itori,itori1)
5490 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5491 if (energy_dec) etors_ii=etors_ii+
5492 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5493 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5497 v1ij=v1(j,itori,itori1)
5498 v2ij=v2(j,itori,itori1)
5501 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5502 if (energy_dec) etors_ii=etors_ii+
5503 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5504 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5507 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5510 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5511 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5512 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5513 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5514 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5516 ! 6/20/98 - dihedral angle constraints
5519 itori=idih_constr(i)
5522 if (difi.gt.drange(i)) then
5524 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5525 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5526 else if (difi.lt.-drange(i)) then
5528 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5529 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5531 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5532 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5534 ! write (iout,*) 'edihcnstr',edihcnstr
5537 c------------------------------------------------------------------------------
5538 subroutine etor_d(etors_d)
5542 c----------------------------------------------------------------------------
5544 subroutine etor(etors,edihcnstr)
5545 implicit real*8 (a-h,o-z)
5546 include 'DIMENSIONS'
5547 include 'COMMON.VAR'
5548 include 'COMMON.GEO'
5549 include 'COMMON.LOCAL'
5550 include 'COMMON.TORSION'
5551 include 'COMMON.INTERACT'
5552 include 'COMMON.DERIV'
5553 include 'COMMON.CHAIN'
5554 include 'COMMON.NAMES'
5555 include 'COMMON.IOUNITS'
5556 include 'COMMON.FFIELD'
5557 include 'COMMON.TORCNSTR'
5558 include 'COMMON.CONTROL'
5560 C Set lprn=.true. for debugging
5564 do i=iphi_start,iphi_end
5565 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5566 & .or. itype(i).eq.21
5567 & .or. itype(i-3).eq.ntyp1) cycle
5569 itori=itortyp(itype(i-2))
5570 itori1=itortyp(itype(i-1))
5573 C Regular cosine and sine terms
5574 do j=1,nterm(itori,itori1)
5575 v1ij=v1(j,itori,itori1)
5576 v2ij=v2(j,itori,itori1)
5579 etors=etors+v1ij*cosphi+v2ij*sinphi
5580 if (energy_dec) etors_ii=etors_ii+
5581 & v1ij*cosphi+v2ij*sinphi
5582 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5586 C E = SUM ----------------------------------- - v1
5587 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5589 cosphi=dcos(0.5d0*phii)
5590 sinphi=dsin(0.5d0*phii)
5591 do j=1,nlor(itori,itori1)
5592 vl1ij=vlor1(j,itori,itori1)
5593 vl2ij=vlor2(j,itori,itori1)
5594 vl3ij=vlor3(j,itori,itori1)
5595 pom=vl2ij*cosphi+vl3ij*sinphi
5596 pom1=1.0d0/(pom*pom+1.0d0)
5597 etors=etors+vl1ij*pom1
5598 if (energy_dec) etors_ii=etors_ii+
5601 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5603 C Subtract the constant term
5604 etors=etors-v0(itori,itori1)
5605 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5606 & 'etor',i,etors_ii-v0(itori,itori1)
5608 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5609 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5610 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5611 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5612 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5614 ! 6/20/98 - dihedral angle constraints
5616 c do i=1,ndih_constr
5617 do i=idihconstr_start,idihconstr_end
5618 itori=idih_constr(i)
5620 difi=pinorm(phii-phi0(i))
5621 if (difi.gt.drange(i)) then
5623 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5624 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5625 else if (difi.lt.-drange(i)) then
5627 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5628 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5632 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5633 cd & rad2deg*phi0(i), rad2deg*drange(i),
5634 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5636 cd write (iout,*) 'edihcnstr',edihcnstr
5639 c----------------------------------------------------------------------------
5640 subroutine etor_d(etors_d)
5641 C 6/23/01 Compute double torsional energy
5642 implicit real*8 (a-h,o-z)
5643 include 'DIMENSIONS'
5644 include 'COMMON.VAR'
5645 include 'COMMON.GEO'
5646 include 'COMMON.LOCAL'
5647 include 'COMMON.TORSION'
5648 include 'COMMON.INTERACT'
5649 include 'COMMON.DERIV'
5650 include 'COMMON.CHAIN'
5651 include 'COMMON.NAMES'
5652 include 'COMMON.IOUNITS'
5653 include 'COMMON.FFIELD'
5654 include 'COMMON.TORCNSTR'
5655 include 'COMMON.CONTROL'
5657 C Set lprn=.true. for debugging
5661 C write(iout,*) "a tu??"
5662 do i=iphid_start,iphid_end
5663 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5664 & .or. itype(i).eq.21 .or. itype(i+1).eq.21
5665 & .or. itype(i-3).eq.ntyp1) cycle
5667 itori=itortyp(itype(i-2))
5668 itori1=itortyp(itype(i-1))
5669 itori2=itortyp(itype(i))
5674 C Regular cosine and sine terms
5675 do j=1,ntermd_1(itori,itori1,itori2)
5676 v1cij=v1c(1,j,itori,itori1,itori2)
5677 v1sij=v1s(1,j,itori,itori1,itori2)
5678 v2cij=v1c(2,j,itori,itori1,itori2)
5679 v2sij=v1s(2,j,itori,itori1,itori2)
5680 cosphi1=dcos(j*phii)
5681 sinphi1=dsin(j*phii)
5682 cosphi2=dcos(j*phii1)
5683 sinphi2=dsin(j*phii1)
5684 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5685 & v2cij*cosphi2+v2sij*sinphi2
5686 if (energy_dec) etors_d_ii=etors_d_ii+
5687 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5688 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5689 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5691 do k=2,ntermd_2(itori,itori1,itori2)
5693 v1cdij = v2c(k,l,itori,itori1,itori2)
5694 v2cdij = v2c(l,k,itori,itori1,itori2)
5695 v1sdij = v2s(k,l,itori,itori1,itori2)
5696 v2sdij = v2s(l,k,itori,itori1,itori2)
5697 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5698 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5699 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5700 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5701 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5702 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5703 if (energy_dec) etors_d_ii=etors_d_ii+
5704 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5705 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5706 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5707 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5708 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5709 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5712 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5713 & 'etor_d',i,etors_d_ii
5714 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5715 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5720 c------------------------------------------------------------------------------
5721 subroutine eback_sc_corr(esccor)
5722 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5723 c conformational states; temporarily implemented as differences
5724 c between UNRES torsional potentials (dependent on three types of
5725 c residues) and the torsional potentials dependent on all 20 types
5726 c of residues computed from AM1 energy surfaces of terminally-blocked
5727 c amino-acid residues.
5728 implicit real*8 (a-h,o-z)
5729 include 'DIMENSIONS'
5730 include 'COMMON.VAR'
5731 include 'COMMON.GEO'
5732 include 'COMMON.LOCAL'
5733 include 'COMMON.TORSION'
5734 include 'COMMON.SCCOR'
5735 include 'COMMON.INTERACT'
5736 include 'COMMON.DERIV'
5737 include 'COMMON.CHAIN'
5738 include 'COMMON.NAMES'
5739 include 'COMMON.IOUNITS'
5740 include 'COMMON.FFIELD'
5741 include 'COMMON.CONTROL'
5743 C Set lprn=.true. for debugging
5746 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5748 do i=itau_start,itau_end
5749 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5751 isccori=isccortyp(itype(i-2))
5752 isccori1=isccortyp(itype(i-1))
5753 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5755 do intertyp=1,3 !intertyp
5756 cc Added 09 May 2012 (Adasko)
5757 cc Intertyp means interaction type of backbone mainchain correlation:
5758 c 1 = SC...Ca...Ca...Ca
5759 c 2 = Ca...Ca...Ca...SC
5760 c 3 = SC...Ca...Ca...SCi
5762 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5763 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5764 & (itype(i-1).eq.ntyp1)))
5765 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5766 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5767 & .or.(itype(i).eq.ntyp1)))
5768 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5769 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5770 & (itype(i-3).eq.ntyp1)))) cycle
5771 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5772 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5774 do j=1,nterm_sccor(isccori,isccori1)
5775 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5776 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5777 cosphi=dcos(j*tauangle(intertyp,i))
5778 sinphi=dsin(j*tauangle(intertyp,i))
5779 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5780 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5782 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5783 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5785 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5786 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5787 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5788 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5789 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5795 c----------------------------------------------------------------------------
5796 subroutine multibody(ecorr)
5797 C This subroutine calculates multi-body contributions to energy following
5798 C the idea of Skolnick et al. If side chains I and J make a contact and
5799 C at the same time side chains I+1 and J+1 make a contact, an extra
5800 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5801 implicit real*8 (a-h,o-z)
5802 include 'DIMENSIONS'
5803 include 'COMMON.IOUNITS'
5804 include 'COMMON.DERIV'
5805 include 'COMMON.INTERACT'
5806 include 'COMMON.CONTACTS'
5807 double precision gx(3),gx1(3)
5810 C Set lprn=.true. for debugging
5814 write (iout,'(a)') 'Contact function values:'
5816 write (iout,'(i2,20(1x,i2,f10.5))')
5817 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5832 num_conti=num_cont(i)
5833 num_conti1=num_cont(i1)
5838 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5839 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5840 cd & ' ishift=',ishift
5841 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5842 C The system gains extra energy.
5843 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5844 endif ! j1==j+-ishift
5853 c------------------------------------------------------------------------------
5854 double precision function esccorr(i,j,k,l,jj,kk)
5855 implicit real*8 (a-h,o-z)
5856 include 'DIMENSIONS'
5857 include 'COMMON.IOUNITS'
5858 include 'COMMON.DERIV'
5859 include 'COMMON.INTERACT'
5860 include 'COMMON.CONTACTS'
5861 double precision gx(3),gx1(3)
5866 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5867 C Calculate the multi-body contribution to energy.
5868 C Calculate multi-body contributions to the gradient.
5869 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5870 cd & k,l,(gacont(m,kk,k),m=1,3)
5872 gx(m) =ekl*gacont(m,jj,i)
5873 gx1(m)=eij*gacont(m,kk,k)
5874 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5875 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5876 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5877 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5881 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5886 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5892 c------------------------------------------------------------------------------
5893 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5894 C This subroutine calculates multi-body contributions to hydrogen-bonding
5895 implicit real*8 (a-h,o-z)
5896 include 'DIMENSIONS'
5897 include 'COMMON.IOUNITS'
5900 parameter (max_cont=maxconts)
5901 parameter (max_dim=26)
5902 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5903 double precision zapas(max_dim,maxconts,max_fg_procs),
5904 & zapas_recv(max_dim,maxconts,max_fg_procs)
5905 common /przechowalnia/ zapas
5906 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5907 & status_array(MPI_STATUS_SIZE,maxconts*2)
5909 include 'COMMON.SETUP'
5910 include 'COMMON.FFIELD'
5911 include 'COMMON.DERIV'
5912 include 'COMMON.INTERACT'
5913 include 'COMMON.CONTACTS'
5914 include 'COMMON.CONTROL'
5915 include 'COMMON.LOCAL'
5916 double precision gx(3),gx1(3),time00
5919 C Set lprn=.true. for debugging
5924 if (nfgtasks.le.1) goto 30
5926 write (iout,'(a)') 'Contact function values before RECEIVE:'
5928 write (iout,'(2i3,50(1x,i2,f5.2))')
5929 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5930 & j=1,num_cont_hb(i))
5934 do i=1,ntask_cont_from
5937 do i=1,ntask_cont_to
5940 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5942 C Make the list of contacts to send to send to other procesors
5943 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5945 do i=iturn3_start,iturn3_end
5946 c write (iout,*) "make contact list turn3",i," num_cont",
5948 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5950 do i=iturn4_start,iturn4_end
5951 c write (iout,*) "make contact list turn4",i," num_cont",
5953 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5957 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5959 do j=1,num_cont_hb(i)
5962 iproc=iint_sent_local(k,jjc,ii)
5963 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5964 if (iproc.gt.0) then
5965 ncont_sent(iproc)=ncont_sent(iproc)+1
5966 nn=ncont_sent(iproc)
5968 zapas(2,nn,iproc)=jjc
5969 zapas(3,nn,iproc)=facont_hb(j,i)
5970 zapas(4,nn,iproc)=ees0p(j,i)
5971 zapas(5,nn,iproc)=ees0m(j,i)
5972 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5973 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5974 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5975 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5976 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5977 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5978 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5979 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5980 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5981 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5982 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5983 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5984 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5985 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5986 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5987 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5988 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5989 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5990 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5991 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5992 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5999 & "Numbers of contacts to be sent to other processors",
6000 & (ncont_sent(i),i=1,ntask_cont_to)
6001 write (iout,*) "Contacts sent"
6002 do ii=1,ntask_cont_to
6004 iproc=itask_cont_to(ii)
6005 write (iout,*) nn," contacts to processor",iproc,
6006 & " of CONT_TO_COMM group"
6008 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6016 CorrelID1=nfgtasks+fg_rank+1
6018 C Receive the numbers of needed contacts from other processors
6019 do ii=1,ntask_cont_from
6020 iproc=itask_cont_from(ii)
6022 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6023 & FG_COMM,req(ireq),IERR)
6025 c write (iout,*) "IRECV ended"
6027 C Send the number of contacts needed by other processors
6028 do ii=1,ntask_cont_to
6029 iproc=itask_cont_to(ii)
6031 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6032 & FG_COMM,req(ireq),IERR)
6034 c write (iout,*) "ISEND ended"
6035 c write (iout,*) "number of requests (nn)",ireq
6038 & call MPI_Waitall(ireq,req,status_array,ierr)
6040 c & "Numbers of contacts to be received from other processors",
6041 c & (ncont_recv(i),i=1,ntask_cont_from)
6045 do ii=1,ntask_cont_from
6046 iproc=itask_cont_from(ii)
6048 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6049 c & " of CONT_TO_COMM group"
6053 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6054 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6055 c write (iout,*) "ireq,req",ireq,req(ireq)
6058 C Send the contacts to processors that need them
6059 do ii=1,ntask_cont_to
6060 iproc=itask_cont_to(ii)
6062 c write (iout,*) nn," contacts to processor",iproc,
6063 c & " of CONT_TO_COMM group"
6066 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6067 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6068 c write (iout,*) "ireq,req",ireq,req(ireq)
6070 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6074 c write (iout,*) "number of requests (contacts)",ireq
6075 c write (iout,*) "req",(req(i),i=1,4)
6078 & call MPI_Waitall(ireq,req,status_array,ierr)
6079 do iii=1,ntask_cont_from
6080 iproc=itask_cont_from(iii)
6083 write (iout,*) "Received",nn," contacts from processor",iproc,
6084 & " of CONT_FROM_COMM group"
6087 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6092 ii=zapas_recv(1,i,iii)
6093 c Flag the received contacts to prevent double-counting
6094 jj=-zapas_recv(2,i,iii)
6095 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6097 nnn=num_cont_hb(ii)+1
6100 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6101 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6102 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6103 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6104 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6105 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6106 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6107 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6108 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6109 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6110 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6111 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6112 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6113 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6114 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6115 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6116 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6117 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6118 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6119 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6120 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6121 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6122 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6123 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6128 write (iout,'(a)') 'Contact function values after receive:'
6130 write (iout,'(2i3,50(1x,i3,f5.2))')
6131 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6132 & j=1,num_cont_hb(i))
6139 write (iout,'(a)') 'Contact function values:'
6141 write (iout,'(2i3,50(1x,i3,f5.2))')
6142 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6143 & j=1,num_cont_hb(i))
6147 C Remove the loop below after debugging !!!
6154 C Calculate the local-electrostatic correlation terms
6155 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6157 num_conti=num_cont_hb(i)
6158 num_conti1=num_cont_hb(i+1)
6165 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6166 c & ' jj=',jj,' kk=',kk
6167 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6168 & .or. j.lt.0 .and. j1.gt.0) .and.
6169 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6170 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6171 C The system gains extra energy.
6172 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6173 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6174 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6176 else if (j1.eq.j) then
6177 C Contacts I-J and I-(J+1) occur simultaneously.
6178 C The system loses extra energy.
6179 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6184 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6185 c & ' jj=',jj,' kk=',kk
6187 C Contacts I-J and (I+1)-J occur simultaneously.
6188 C The system loses extra energy.
6189 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6196 c------------------------------------------------------------------------------
6197 subroutine add_hb_contact(ii,jj,itask)
6198 implicit real*8 (a-h,o-z)
6199 include "DIMENSIONS"
6200 include "COMMON.IOUNITS"
6203 parameter (max_cont=maxconts)
6204 parameter (max_dim=26)
6205 include "COMMON.CONTACTS"
6206 double precision zapas(max_dim,maxconts,max_fg_procs),
6207 & zapas_recv(max_dim,maxconts,max_fg_procs)
6208 common /przechowalnia/ zapas
6209 integer i,j,ii,jj,iproc,itask(4),nn
6210 c write (iout,*) "itask",itask
6213 if (iproc.gt.0) then
6214 do j=1,num_cont_hb(ii)
6216 c write (iout,*) "i",ii," j",jj," jjc",jjc
6218 ncont_sent(iproc)=ncont_sent(iproc)+1
6219 nn=ncont_sent(iproc)
6220 zapas(1,nn,iproc)=ii
6221 zapas(2,nn,iproc)=jjc
6222 zapas(3,nn,iproc)=facont_hb(j,ii)
6223 zapas(4,nn,iproc)=ees0p(j,ii)
6224 zapas(5,nn,iproc)=ees0m(j,ii)
6225 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6226 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6227 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6228 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6229 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6230 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6231 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6232 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6233 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6234 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6235 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6236 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6237 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6238 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6239 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6240 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6241 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6242 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6243 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6244 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6245 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6253 c------------------------------------------------------------------------------
6254 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6256 C This subroutine calculates multi-body contributions to hydrogen-bonding
6257 implicit real*8 (a-h,o-z)
6258 include 'DIMENSIONS'
6259 include 'COMMON.IOUNITS'
6262 parameter (max_cont=maxconts)
6263 parameter (max_dim=70)
6264 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6265 double precision zapas(max_dim,maxconts,max_fg_procs),
6266 & zapas_recv(max_dim,maxconts,max_fg_procs)
6267 common /przechowalnia/ zapas
6268 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6269 & status_array(MPI_STATUS_SIZE,maxconts*2)
6271 include 'COMMON.SETUP'
6272 include 'COMMON.FFIELD'
6273 include 'COMMON.DERIV'
6274 include 'COMMON.LOCAL'
6275 include 'COMMON.INTERACT'
6276 include 'COMMON.CONTACTS'
6277 include 'COMMON.CHAIN'
6278 include 'COMMON.CONTROL'
6279 double precision gx(3),gx1(3)
6280 integer num_cont_hb_old(maxres)
6282 double precision eello4,eello5,eelo6,eello_turn6
6283 external eello4,eello5,eello6,eello_turn6
6284 C Set lprn=.true. for debugging
6289 num_cont_hb_old(i)=num_cont_hb(i)
6293 if (nfgtasks.le.1) goto 30
6295 write (iout,'(a)') 'Contact function values before RECEIVE:'
6297 write (iout,'(2i3,50(1x,i2,f5.2))')
6298 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6299 & j=1,num_cont_hb(i))
6303 do i=1,ntask_cont_from
6306 do i=1,ntask_cont_to
6309 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6311 C Make the list of contacts to send to send to other procesors
6312 do i=iturn3_start,iturn3_end
6313 c write (iout,*) "make contact list turn3",i," num_cont",
6315 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6317 do i=iturn4_start,iturn4_end
6318 c write (iout,*) "make contact list turn4",i," num_cont",
6320 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6324 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6326 do j=1,num_cont_hb(i)
6329 iproc=iint_sent_local(k,jjc,ii)
6330 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6331 if (iproc.ne.0) then
6332 ncont_sent(iproc)=ncont_sent(iproc)+1
6333 nn=ncont_sent(iproc)
6335 zapas(2,nn,iproc)=jjc
6336 zapas(3,nn,iproc)=d_cont(j,i)
6340 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6345 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6353 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6364 & "Numbers of contacts to be sent to other processors",
6365 & (ncont_sent(i),i=1,ntask_cont_to)
6366 write (iout,*) "Contacts sent"
6367 do ii=1,ntask_cont_to
6369 iproc=itask_cont_to(ii)
6370 write (iout,*) nn," contacts to processor",iproc,
6371 & " of CONT_TO_COMM group"
6373 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6381 CorrelID1=nfgtasks+fg_rank+1
6383 C Receive the numbers of needed contacts from other processors
6384 do ii=1,ntask_cont_from
6385 iproc=itask_cont_from(ii)
6387 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6388 & FG_COMM,req(ireq),IERR)
6390 c write (iout,*) "IRECV ended"
6392 C Send the number of contacts needed by other processors
6393 do ii=1,ntask_cont_to
6394 iproc=itask_cont_to(ii)
6396 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6397 & FG_COMM,req(ireq),IERR)
6399 c write (iout,*) "ISEND ended"
6400 c write (iout,*) "number of requests (nn)",ireq
6403 & call MPI_Waitall(ireq,req,status_array,ierr)
6405 c & "Numbers of contacts to be received from other processors",
6406 c & (ncont_recv(i),i=1,ntask_cont_from)
6410 do ii=1,ntask_cont_from
6411 iproc=itask_cont_from(ii)
6413 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6414 c & " of CONT_TO_COMM group"
6418 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6419 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6420 c write (iout,*) "ireq,req",ireq,req(ireq)
6423 C Send the contacts to processors that need them
6424 do ii=1,ntask_cont_to
6425 iproc=itask_cont_to(ii)
6427 c write (iout,*) nn," contacts to processor",iproc,
6428 c & " of CONT_TO_COMM group"
6431 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6432 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6433 c write (iout,*) "ireq,req",ireq,req(ireq)
6435 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6439 c write (iout,*) "number of requests (contacts)",ireq
6440 c write (iout,*) "req",(req(i),i=1,4)
6443 & call MPI_Waitall(ireq,req,status_array,ierr)
6444 do iii=1,ntask_cont_from
6445 iproc=itask_cont_from(iii)
6448 write (iout,*) "Received",nn," contacts from processor",iproc,
6449 & " of CONT_FROM_COMM group"
6452 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6457 ii=zapas_recv(1,i,iii)
6458 c Flag the received contacts to prevent double-counting
6459 jj=-zapas_recv(2,i,iii)
6460 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6462 nnn=num_cont_hb(ii)+1
6465 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6469 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6474 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6482 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6491 write (iout,'(a)') 'Contact function values after receive:'
6493 write (iout,'(2i3,50(1x,i3,5f6.3))')
6494 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6495 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6502 write (iout,'(a)') 'Contact function values:'
6504 write (iout,'(2i3,50(1x,i2,5f6.3))')
6505 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6506 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6512 C Remove the loop below after debugging !!!
6519 C Calculate the dipole-dipole interaction energies
6520 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6521 do i=iatel_s,iatel_e+1
6522 num_conti=num_cont_hb(i)
6531 C Calculate the local-electrostatic correlation terms
6532 c write (iout,*) "gradcorr5 in eello5 before loop"
6534 c write (iout,'(i5,3f10.5)')
6535 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6537 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6538 c write (iout,*) "corr loop i",i
6540 num_conti=num_cont_hb(i)
6541 num_conti1=num_cont_hb(i+1)
6548 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6549 c & ' jj=',jj,' kk=',kk
6550 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6551 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6552 & .or. j.lt.0 .and. j1.gt.0) .and.
6553 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6554 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6555 C The system gains extra energy.
6557 sqd1=dsqrt(d_cont(jj,i))
6558 sqd2=dsqrt(d_cont(kk,i1))
6559 sred_geom = sqd1*sqd2
6560 IF (sred_geom.lt.cutoff_corr) THEN
6561 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6563 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6564 cd & ' jj=',jj,' kk=',kk
6565 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6566 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6568 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6569 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6572 cd write (iout,*) 'sred_geom=',sred_geom,
6573 cd & ' ekont=',ekont,' fprim=',fprimcont,
6574 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6575 cd write (iout,*) "g_contij",g_contij
6576 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6577 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6578 call calc_eello(i,jp,i+1,jp1,jj,kk)
6579 if (wcorr4.gt.0.0d0)
6580 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6581 if (energy_dec.and.wcorr4.gt.0.0d0)
6582 1 write (iout,'(a6,4i5,0pf7.3)')
6583 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6584 c write (iout,*) "gradcorr5 before eello5"
6586 c write (iout,'(i5,3f10.5)')
6587 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6589 if (wcorr5.gt.0.0d0)
6590 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6591 c write (iout,*) "gradcorr5 after eello5"
6593 c write (iout,'(i5,3f10.5)')
6594 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6596 if (energy_dec.and.wcorr5.gt.0.0d0)
6597 1 write (iout,'(a6,4i5,0pf7.3)')
6598 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6599 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6600 cd write(2,*)'ijkl',i,jp,i+1,jp1
6601 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6602 & .or. wturn6.eq.0.0d0))then
6603 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6604 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6605 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6606 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6607 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6608 cd & 'ecorr6=',ecorr6
6609 cd write (iout,'(4e15.5)') sred_geom,
6610 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6611 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6612 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6613 else if (wturn6.gt.0.0d0
6614 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6615 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6616 eturn6=eturn6+eello_turn6(i,jj,kk)
6617 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6618 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6619 cd write (2,*) 'multibody_eello:eturn6',eturn6
6628 num_cont_hb(i)=num_cont_hb_old(i)
6630 c write (iout,*) "gradcorr5 in eello5"
6632 c write (iout,'(i5,3f10.5)')
6633 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6637 c------------------------------------------------------------------------------
6638 subroutine add_hb_contact_eello(ii,jj,itask)
6639 implicit real*8 (a-h,o-z)
6640 include "DIMENSIONS"
6641 include "COMMON.IOUNITS"
6644 parameter (max_cont=maxconts)
6645 parameter (max_dim=70)
6646 include "COMMON.CONTACTS"
6647 double precision zapas(max_dim,maxconts,max_fg_procs),
6648 & zapas_recv(max_dim,maxconts,max_fg_procs)
6649 common /przechowalnia/ zapas
6650 integer i,j,ii,jj,iproc,itask(4),nn
6651 c write (iout,*) "itask",itask
6654 if (iproc.gt.0) then
6655 do j=1,num_cont_hb(ii)
6657 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6659 ncont_sent(iproc)=ncont_sent(iproc)+1
6660 nn=ncont_sent(iproc)
6661 zapas(1,nn,iproc)=ii
6662 zapas(2,nn,iproc)=jjc
6663 zapas(3,nn,iproc)=d_cont(j,ii)
6667 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6672 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6680 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6692 c------------------------------------------------------------------------------
6693 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6694 implicit real*8 (a-h,o-z)
6695 include 'DIMENSIONS'
6696 include 'COMMON.IOUNITS'
6697 include 'COMMON.DERIV'
6698 include 'COMMON.INTERACT'
6699 include 'COMMON.CONTACTS'
6700 double precision gx(3),gx1(3)
6710 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6711 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6712 C Following 4 lines for diagnostics.
6717 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6718 c & 'Contacts ',i,j,
6719 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6720 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6722 C Calculate the multi-body contribution to energy.
6723 c ecorr=ecorr+ekont*ees
6724 C Calculate multi-body contributions to the gradient.
6725 coeffpees0pij=coeffp*ees0pij
6726 coeffmees0mij=coeffm*ees0mij
6727 coeffpees0pkl=coeffp*ees0pkl
6728 coeffmees0mkl=coeffm*ees0mkl
6730 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6731 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6732 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6733 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6734 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6735 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6736 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6737 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6738 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6739 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6740 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6741 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6742 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6743 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6744 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6745 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6746 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6747 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6748 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6749 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6750 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6751 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6752 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6753 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6754 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6759 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6760 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6761 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6762 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6767 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6768 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6769 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6770 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6773 c write (iout,*) "ehbcorr",ekont*ees
6778 C---------------------------------------------------------------------------
6779 subroutine dipole(i,j,jj)
6780 implicit real*8 (a-h,o-z)
6781 include 'DIMENSIONS'
6782 include 'COMMON.IOUNITS'
6783 include 'COMMON.CHAIN'
6784 include 'COMMON.FFIELD'
6785 include 'COMMON.DERIV'
6786 include 'COMMON.INTERACT'
6787 include 'COMMON.CONTACTS'
6788 include 'COMMON.TORSION'
6789 include 'COMMON.VAR'
6790 include 'COMMON.GEO'
6791 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6793 iti1 = itortyp(itype(i+1))
6794 if (j.lt.nres-1) then
6795 itj1 = itortyp(itype(j+1))
6800 dipi(iii,1)=Ub2(iii,i)
6801 dipderi(iii)=Ub2der(iii,i)
6802 dipi(iii,2)=b1(iii,iti1)
6803 dipj(iii,1)=Ub2(iii,j)
6804 dipderj(iii)=Ub2der(iii,j)
6805 dipj(iii,2)=b1(iii,itj1)
6809 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6812 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6819 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6823 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6828 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6829 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6831 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6833 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6835 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6840 C---------------------------------------------------------------------------
6841 subroutine calc_eello(i,j,k,l,jj,kk)
6843 C This subroutine computes matrices and vectors needed to calculate
6844 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6846 implicit real*8 (a-h,o-z)
6847 include 'DIMENSIONS'
6848 include 'COMMON.IOUNITS'
6849 include 'COMMON.CHAIN'
6850 include 'COMMON.DERIV'
6851 include 'COMMON.INTERACT'
6852 include 'COMMON.CONTACTS'
6853 include 'COMMON.TORSION'
6854 include 'COMMON.VAR'
6855 include 'COMMON.GEO'
6856 include 'COMMON.FFIELD'
6857 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6858 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6861 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6862 cd & ' jj=',jj,' kk=',kk
6863 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6864 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6865 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6868 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6869 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6872 call transpose2(aa1(1,1),aa1t(1,1))
6873 call transpose2(aa2(1,1),aa2t(1,1))
6876 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6877 & aa1tder(1,1,lll,kkk))
6878 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6879 & aa2tder(1,1,lll,kkk))
6883 C parallel orientation of the two CA-CA-CA frames.
6885 iti=itortyp(itype(i))
6889 itk1=itortyp(itype(k+1))
6890 itj=itortyp(itype(j))
6891 if (l.lt.nres-1) then
6892 itl1=itortyp(itype(l+1))
6896 C A1 kernel(j+1) A2T
6898 cd write (iout,'(3f10.5,5x,3f10.5)')
6899 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6901 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6902 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6903 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6904 C Following matrices are needed only for 6-th order cumulants
6905 IF (wcorr6.gt.0.0d0) THEN
6906 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6907 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6908 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6909 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6910 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6911 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6912 & ADtEAderx(1,1,1,1,1,1))
6914 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6915 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6916 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6917 & ADtEA1derx(1,1,1,1,1,1))
6919 C End 6-th order cumulants
6922 cd write (2,*) 'In calc_eello6'
6924 cd write (2,*) 'iii=',iii
6926 cd write (2,*) 'kkk=',kkk
6928 cd write (2,'(3(2f10.5),5x)')
6929 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6934 call transpose2(EUgder(1,1,k),auxmat(1,1))
6935 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6936 call transpose2(EUg(1,1,k),auxmat(1,1))
6937 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6938 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6942 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6943 & EAEAderx(1,1,lll,kkk,iii,1))
6947 C A1T kernel(i+1) A2
6948 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6949 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6950 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6951 C Following matrices are needed only for 6-th order cumulants
6952 IF (wcorr6.gt.0.0d0) THEN
6953 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6954 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6955 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6956 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6957 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6958 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6959 & ADtEAderx(1,1,1,1,1,2))
6960 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6961 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6962 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6963 & ADtEA1derx(1,1,1,1,1,2))
6965 C End 6-th order cumulants
6966 call transpose2(EUgder(1,1,l),auxmat(1,1))
6967 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6968 call transpose2(EUg(1,1,l),auxmat(1,1))
6969 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6970 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6974 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6975 & EAEAderx(1,1,lll,kkk,iii,2))
6980 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6981 C They are needed only when the fifth- or the sixth-order cumulants are
6983 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6984 call transpose2(AEA(1,1,1),auxmat(1,1))
6985 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6986 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6987 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6988 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6989 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6990 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6991 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6992 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6993 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6994 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6995 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6996 call transpose2(AEA(1,1,2),auxmat(1,1))
6997 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6998 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6999 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7000 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7001 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7002 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7003 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7004 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7005 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7006 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7007 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7008 C Calculate the Cartesian derivatives of the vectors.
7012 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7013 call matvec2(auxmat(1,1),b1(1,iti),
7014 & AEAb1derx(1,lll,kkk,iii,1,1))
7015 call matvec2(auxmat(1,1),Ub2(1,i),
7016 & AEAb2derx(1,lll,kkk,iii,1,1))
7017 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7018 & AEAb1derx(1,lll,kkk,iii,2,1))
7019 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7020 & AEAb2derx(1,lll,kkk,iii,2,1))
7021 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7022 call matvec2(auxmat(1,1),b1(1,itj),
7023 & AEAb1derx(1,lll,kkk,iii,1,2))
7024 call matvec2(auxmat(1,1),Ub2(1,j),
7025 & AEAb2derx(1,lll,kkk,iii,1,2))
7026 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7027 & AEAb1derx(1,lll,kkk,iii,2,2))
7028 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7029 & AEAb2derx(1,lll,kkk,iii,2,2))
7036 C Antiparallel orientation of the two CA-CA-CA frames.
7038 iti=itortyp(itype(i))
7042 itk1=itortyp(itype(k+1))
7043 itl=itortyp(itype(l))
7044 itj=itortyp(itype(j))
7045 if (j.lt.nres-1) then
7046 itj1=itortyp(itype(j+1))
7050 C A2 kernel(j-1)T A1T
7051 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7052 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7053 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7054 C Following matrices are needed only for 6-th order cumulants
7055 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7056 & j.eq.i+4 .and. l.eq.i+3)) THEN
7057 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7058 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7059 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7060 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7061 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7062 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7063 & ADtEAderx(1,1,1,1,1,1))
7064 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7065 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7066 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7067 & ADtEA1derx(1,1,1,1,1,1))
7069 C End 6-th order cumulants
7070 call transpose2(EUgder(1,1,k),auxmat(1,1))
7071 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7072 call transpose2(EUg(1,1,k),auxmat(1,1))
7073 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7074 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7078 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7079 & EAEAderx(1,1,lll,kkk,iii,1))
7083 C A2T kernel(i+1)T A1
7084 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7085 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7086 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7087 C Following matrices are needed only for 6-th order cumulants
7088 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7089 & j.eq.i+4 .and. l.eq.i+3)) THEN
7090 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7091 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7092 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7093 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7094 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7095 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7096 & ADtEAderx(1,1,1,1,1,2))
7097 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7098 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7099 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7100 & ADtEA1derx(1,1,1,1,1,2))
7102 C End 6-th order cumulants
7103 call transpose2(EUgder(1,1,j),auxmat(1,1))
7104 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7105 call transpose2(EUg(1,1,j),auxmat(1,1))
7106 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7107 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7111 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7112 & EAEAderx(1,1,lll,kkk,iii,2))
7117 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7118 C They are needed only when the fifth- or the sixth-order cumulants are
7120 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7121 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7122 call transpose2(AEA(1,1,1),auxmat(1,1))
7123 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7124 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7125 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7126 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7127 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7128 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7129 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7130 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7131 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7132 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7133 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7134 call transpose2(AEA(1,1,2),auxmat(1,1))
7135 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7136 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7137 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7138 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7139 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7140 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7141 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7142 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7143 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7144 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7145 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7146 C Calculate the Cartesian derivatives of the vectors.
7150 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7151 call matvec2(auxmat(1,1),b1(1,iti),
7152 & AEAb1derx(1,lll,kkk,iii,1,1))
7153 call matvec2(auxmat(1,1),Ub2(1,i),
7154 & AEAb2derx(1,lll,kkk,iii,1,1))
7155 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7156 & AEAb1derx(1,lll,kkk,iii,2,1))
7157 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7158 & AEAb2derx(1,lll,kkk,iii,2,1))
7159 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7160 call matvec2(auxmat(1,1),b1(1,itl),
7161 & AEAb1derx(1,lll,kkk,iii,1,2))
7162 call matvec2(auxmat(1,1),Ub2(1,l),
7163 & AEAb2derx(1,lll,kkk,iii,1,2))
7164 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7165 & AEAb1derx(1,lll,kkk,iii,2,2))
7166 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7167 & AEAb2derx(1,lll,kkk,iii,2,2))
7176 C---------------------------------------------------------------------------
7177 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7178 & KK,KKderg,AKA,AKAderg,AKAderx)
7182 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7183 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7184 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7189 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7191 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7194 cd if (lprn) write (2,*) 'In kernel'
7196 cd if (lprn) write (2,*) 'kkk=',kkk
7198 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7199 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7201 cd write (2,*) 'lll=',lll
7202 cd write (2,*) 'iii=1'
7204 cd write (2,'(3(2f10.5),5x)')
7205 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7208 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7209 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7211 cd write (2,*) 'lll=',lll
7212 cd write (2,*) 'iii=2'
7214 cd write (2,'(3(2f10.5),5x)')
7215 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7222 C---------------------------------------------------------------------------
7223 double precision function eello4(i,j,k,l,jj,kk)
7224 implicit real*8 (a-h,o-z)
7225 include 'DIMENSIONS'
7226 include 'COMMON.IOUNITS'
7227 include 'COMMON.CHAIN'
7228 include 'COMMON.DERIV'
7229 include 'COMMON.INTERACT'
7230 include 'COMMON.CONTACTS'
7231 include 'COMMON.TORSION'
7232 include 'COMMON.VAR'
7233 include 'COMMON.GEO'
7234 double precision pizda(2,2),ggg1(3),ggg2(3)
7235 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7239 cd print *,'eello4:',i,j,k,l,jj,kk
7240 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7241 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7242 cold eij=facont_hb(jj,i)
7243 cold ekl=facont_hb(kk,k)
7245 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7246 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7247 gcorr_loc(k-1)=gcorr_loc(k-1)
7248 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7250 gcorr_loc(l-1)=gcorr_loc(l-1)
7251 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7253 gcorr_loc(j-1)=gcorr_loc(j-1)
7254 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7259 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7260 & -EAEAderx(2,2,lll,kkk,iii,1)
7261 cd derx(lll,kkk,iii)=0.0d0
7265 cd gcorr_loc(l-1)=0.0d0
7266 cd gcorr_loc(j-1)=0.0d0
7267 cd gcorr_loc(k-1)=0.0d0
7269 cd write (iout,*)'Contacts have occurred for peptide groups',
7270 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7271 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7272 if (j.lt.nres-1) then
7279 if (l.lt.nres-1) then
7287 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7288 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7289 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7290 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7291 cgrad ghalf=0.5d0*ggg1(ll)
7292 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7293 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7294 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7295 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7296 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7297 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7298 cgrad ghalf=0.5d0*ggg2(ll)
7299 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7300 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7301 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7302 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7303 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7304 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7308 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7313 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7318 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7323 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7327 cd write (2,*) iii,gcorr_loc(iii)
7330 cd write (2,*) 'ekont',ekont
7331 cd write (iout,*) 'eello4',ekont*eel4
7334 C---------------------------------------------------------------------------
7335 double precision function eello5(i,j,k,l,jj,kk)
7336 implicit real*8 (a-h,o-z)
7337 include 'DIMENSIONS'
7338 include 'COMMON.IOUNITS'
7339 include 'COMMON.CHAIN'
7340 include 'COMMON.DERIV'
7341 include 'COMMON.INTERACT'
7342 include 'COMMON.CONTACTS'
7343 include 'COMMON.TORSION'
7344 include 'COMMON.VAR'
7345 include 'COMMON.GEO'
7346 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7347 double precision ggg1(3),ggg2(3)
7348 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7353 C /l\ / \ \ / \ / \ / C
7354 C / \ / \ \ / \ / \ / C
7355 C j| o |l1 | o | o| o | | o |o C
7356 C \ |/k\| |/ \| / |/ \| |/ \| C
7357 C \i/ \ / \ / / \ / \ C
7359 C (I) (II) (III) (IV) C
7361 C eello5_1 eello5_2 eello5_3 eello5_4 C
7363 C Antiparallel chains C
7366 C /j\ / \ \ / \ / \ / C
7367 C / \ / \ \ / \ / \ / C
7368 C j1| o |l | o | o| o | | o |o C
7369 C \ |/k\| |/ \| / |/ \| |/ \| C
7370 C \i/ \ / \ / / \ / \ C
7372 C (I) (II) (III) (IV) C
7374 C eello5_1 eello5_2 eello5_3 eello5_4 C
7376 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7378 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7379 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7384 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7386 itk=itortyp(itype(k))
7387 itl=itortyp(itype(l))
7388 itj=itortyp(itype(j))
7393 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7394 cd & eel5_3_num,eel5_4_num)
7398 derx(lll,kkk,iii)=0.0d0
7402 cd eij=facont_hb(jj,i)
7403 cd ekl=facont_hb(kk,k)
7405 cd write (iout,*)'Contacts have occurred for peptide groups',
7406 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7408 C Contribution from the graph I.
7409 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7410 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7411 call transpose2(EUg(1,1,k),auxmat(1,1))
7412 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7413 vv(1)=pizda(1,1)-pizda(2,2)
7414 vv(2)=pizda(1,2)+pizda(2,1)
7415 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7416 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7417 C Explicit gradient in virtual-dihedral angles.
7418 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7419 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7420 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7421 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7422 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7423 vv(1)=pizda(1,1)-pizda(2,2)
7424 vv(2)=pizda(1,2)+pizda(2,1)
7425 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7426 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7427 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7428 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7429 vv(1)=pizda(1,1)-pizda(2,2)
7430 vv(2)=pizda(1,2)+pizda(2,1)
7432 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7433 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7434 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7436 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7437 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7438 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7440 C Cartesian gradient
7444 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7446 vv(1)=pizda(1,1)-pizda(2,2)
7447 vv(2)=pizda(1,2)+pizda(2,1)
7448 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7449 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7450 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7456 C Contribution from graph II
7457 call transpose2(EE(1,1,itk),auxmat(1,1))
7458 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7459 vv(1)=pizda(1,1)+pizda(2,2)
7460 vv(2)=pizda(2,1)-pizda(1,2)
7461 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7462 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7463 C Explicit gradient in virtual-dihedral angles.
7464 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7465 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7466 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7467 vv(1)=pizda(1,1)+pizda(2,2)
7468 vv(2)=pizda(2,1)-pizda(1,2)
7470 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7471 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7472 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7474 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7475 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7476 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7478 C Cartesian gradient
7482 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7484 vv(1)=pizda(1,1)+pizda(2,2)
7485 vv(2)=pizda(2,1)-pizda(1,2)
7486 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7487 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7488 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7496 C Parallel orientation
7497 C Contribution from graph III
7498 call transpose2(EUg(1,1,l),auxmat(1,1))
7499 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7500 vv(1)=pizda(1,1)-pizda(2,2)
7501 vv(2)=pizda(1,2)+pizda(2,1)
7502 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7503 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7504 C Explicit gradient in virtual-dihedral angles.
7505 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7506 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7507 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7508 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7509 vv(1)=pizda(1,1)-pizda(2,2)
7510 vv(2)=pizda(1,2)+pizda(2,1)
7511 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7512 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7513 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7514 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7515 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7516 vv(1)=pizda(1,1)-pizda(2,2)
7517 vv(2)=pizda(1,2)+pizda(2,1)
7518 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7519 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7520 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7521 C Cartesian gradient
7525 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7527 vv(1)=pizda(1,1)-pizda(2,2)
7528 vv(2)=pizda(1,2)+pizda(2,1)
7529 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7530 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7531 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7536 C Contribution from graph IV
7538 call transpose2(EE(1,1,itl),auxmat(1,1))
7539 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7540 vv(1)=pizda(1,1)+pizda(2,2)
7541 vv(2)=pizda(2,1)-pizda(1,2)
7542 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7543 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7544 C Explicit gradient in virtual-dihedral angles.
7545 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7546 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7547 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7548 vv(1)=pizda(1,1)+pizda(2,2)
7549 vv(2)=pizda(2,1)-pizda(1,2)
7550 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7551 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7552 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7553 C Cartesian gradient
7557 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7559 vv(1)=pizda(1,1)+pizda(2,2)
7560 vv(2)=pizda(2,1)-pizda(1,2)
7561 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7562 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7563 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7568 C Antiparallel orientation
7569 C Contribution from graph III
7571 call transpose2(EUg(1,1,j),auxmat(1,1))
7572 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7573 vv(1)=pizda(1,1)-pizda(2,2)
7574 vv(2)=pizda(1,2)+pizda(2,1)
7575 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7576 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7577 C Explicit gradient in virtual-dihedral angles.
7578 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7579 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7580 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7581 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7582 vv(1)=pizda(1,1)-pizda(2,2)
7583 vv(2)=pizda(1,2)+pizda(2,1)
7584 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7585 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7586 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7587 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7588 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7589 vv(1)=pizda(1,1)-pizda(2,2)
7590 vv(2)=pizda(1,2)+pizda(2,1)
7591 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7592 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7593 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7594 C Cartesian gradient
7598 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7600 vv(1)=pizda(1,1)-pizda(2,2)
7601 vv(2)=pizda(1,2)+pizda(2,1)
7602 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7603 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7604 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7609 C Contribution from graph IV
7611 call transpose2(EE(1,1,itj),auxmat(1,1))
7612 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7613 vv(1)=pizda(1,1)+pizda(2,2)
7614 vv(2)=pizda(2,1)-pizda(1,2)
7615 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7616 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7617 C Explicit gradient in virtual-dihedral angles.
7618 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7619 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7620 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7621 vv(1)=pizda(1,1)+pizda(2,2)
7622 vv(2)=pizda(2,1)-pizda(1,2)
7623 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7624 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7625 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7626 C Cartesian gradient
7630 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7632 vv(1)=pizda(1,1)+pizda(2,2)
7633 vv(2)=pizda(2,1)-pizda(1,2)
7634 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7635 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7636 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7642 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7643 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7644 cd write (2,*) 'ijkl',i,j,k,l
7645 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7646 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7648 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7649 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7650 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7651 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7652 if (j.lt.nres-1) then
7659 if (l.lt.nres-1) then
7669 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7670 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7671 C summed up outside the subrouine as for the other subroutines
7672 C handling long-range interactions. The old code is commented out
7673 C with "cgrad" to keep track of changes.
7675 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7676 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7677 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7678 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7679 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7680 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7681 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7682 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7683 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7684 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7686 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7687 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7688 cgrad ghalf=0.5d0*ggg1(ll)
7690 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7691 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7692 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7693 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7694 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7695 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7696 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7697 cgrad ghalf=0.5d0*ggg2(ll)
7699 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7700 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7701 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7702 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7703 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7704 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7709 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7710 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7715 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7716 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7722 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7727 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7731 cd write (2,*) iii,g_corr5_loc(iii)
7734 cd write (2,*) 'ekont',ekont
7735 cd write (iout,*) 'eello5',ekont*eel5
7738 c--------------------------------------------------------------------------
7739 double precision function eello6(i,j,k,l,jj,kk)
7740 implicit real*8 (a-h,o-z)
7741 include 'DIMENSIONS'
7742 include 'COMMON.IOUNITS'
7743 include 'COMMON.CHAIN'
7744 include 'COMMON.DERIV'
7745 include 'COMMON.INTERACT'
7746 include 'COMMON.CONTACTS'
7747 include 'COMMON.TORSION'
7748 include 'COMMON.VAR'
7749 include 'COMMON.GEO'
7750 include 'COMMON.FFIELD'
7751 double precision ggg1(3),ggg2(3)
7752 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7757 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7765 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7766 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7770 derx(lll,kkk,iii)=0.0d0
7774 cd eij=facont_hb(jj,i)
7775 cd ekl=facont_hb(kk,k)
7781 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7782 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7783 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7784 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7785 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7786 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7788 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7789 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7790 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7791 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7792 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7793 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7797 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7799 C If turn contributions are considered, they will be handled separately.
7800 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7801 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7802 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7803 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7804 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7805 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7806 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7808 if (j.lt.nres-1) then
7815 if (l.lt.nres-1) then
7823 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7824 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7825 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7826 cgrad ghalf=0.5d0*ggg1(ll)
7828 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7829 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7830 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7831 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7832 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7833 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7834 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7835 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7836 cgrad ghalf=0.5d0*ggg2(ll)
7837 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7839 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7840 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7841 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7842 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7843 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7844 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7849 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7850 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7855 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7856 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7862 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7867 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7871 cd write (2,*) iii,g_corr6_loc(iii)
7874 cd write (2,*) 'ekont',ekont
7875 cd write (iout,*) 'eello6',ekont*eel6
7878 c--------------------------------------------------------------------------
7879 double precision function eello6_graph1(i,j,k,l,imat,swap)
7880 implicit real*8 (a-h,o-z)
7881 include 'DIMENSIONS'
7882 include 'COMMON.IOUNITS'
7883 include 'COMMON.CHAIN'
7884 include 'COMMON.DERIV'
7885 include 'COMMON.INTERACT'
7886 include 'COMMON.CONTACTS'
7887 include 'COMMON.TORSION'
7888 include 'COMMON.VAR'
7889 include 'COMMON.GEO'
7890 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7894 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7896 C Parallel Antiparallel C
7902 C \ j|/k\| / \ |/k\|l / C
7907 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7908 itk=itortyp(itype(k))
7909 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7910 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7911 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7912 call transpose2(EUgC(1,1,k),auxmat(1,1))
7913 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7914 vv1(1)=pizda1(1,1)-pizda1(2,2)
7915 vv1(2)=pizda1(1,2)+pizda1(2,1)
7916 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7917 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7918 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7919 s5=scalar2(vv(1),Dtobr2(1,i))
7920 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7921 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7922 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7923 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7924 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7925 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7926 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7927 & +scalar2(vv(1),Dtobr2der(1,i)))
7928 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7929 vv1(1)=pizda1(1,1)-pizda1(2,2)
7930 vv1(2)=pizda1(1,2)+pizda1(2,1)
7931 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7932 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7934 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7935 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7936 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7937 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7938 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7940 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7941 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7942 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7943 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7944 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7946 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7947 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7948 vv1(1)=pizda1(1,1)-pizda1(2,2)
7949 vv1(2)=pizda1(1,2)+pizda1(2,1)
7950 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7951 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7952 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7953 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7962 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7963 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7964 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7965 call transpose2(EUgC(1,1,k),auxmat(1,1))
7966 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7968 vv1(1)=pizda1(1,1)-pizda1(2,2)
7969 vv1(2)=pizda1(1,2)+pizda1(2,1)
7970 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7971 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7972 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7973 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7974 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7975 s5=scalar2(vv(1),Dtobr2(1,i))
7976 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7982 c----------------------------------------------------------------------------
7983 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7984 implicit real*8 (a-h,o-z)
7985 include 'DIMENSIONS'
7986 include 'COMMON.IOUNITS'
7987 include 'COMMON.CHAIN'
7988 include 'COMMON.DERIV'
7989 include 'COMMON.INTERACT'
7990 include 'COMMON.CONTACTS'
7991 include 'COMMON.TORSION'
7992 include 'COMMON.VAR'
7993 include 'COMMON.GEO'
7995 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7996 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8001 C Parallel Antiparallel C
8007 C \ j|/k\| \ |/k\|l C
8012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8013 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8014 C AL 7/4/01 s1 would occur in the sixth-order moment,
8015 C but not in a cluster cumulant
8017 s1=dip(1,jj,i)*dip(1,kk,k)
8019 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8020 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8021 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8022 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8023 call transpose2(EUg(1,1,k),auxmat(1,1))
8024 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8025 vv(1)=pizda(1,1)-pizda(2,2)
8026 vv(2)=pizda(1,2)+pizda(2,1)
8027 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8028 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8030 eello6_graph2=-(s1+s2+s3+s4)
8032 eello6_graph2=-(s2+s3+s4)
8035 C Derivatives in gamma(i-1)
8038 s1=dipderg(1,jj,i)*dip(1,kk,k)
8040 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8041 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8042 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8043 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8045 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8047 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8049 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8051 C Derivatives in gamma(k-1)
8053 s1=dip(1,jj,i)*dipderg(1,kk,k)
8055 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8056 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8057 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8058 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8059 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8060 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8061 vv(1)=pizda(1,1)-pizda(2,2)
8062 vv(2)=pizda(1,2)+pizda(2,1)
8063 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8065 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8067 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8069 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8070 C Derivatives in gamma(j-1) or gamma(l-1)
8073 s1=dipderg(3,jj,i)*dip(1,kk,k)
8075 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8076 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8077 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8078 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8079 vv(1)=pizda(1,1)-pizda(2,2)
8080 vv(2)=pizda(1,2)+pizda(2,1)
8081 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8084 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8086 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8089 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8090 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8092 C Derivatives in gamma(l-1) or gamma(j-1)
8095 s1=dip(1,jj,i)*dipderg(3,kk,k)
8097 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8098 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8099 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8100 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8101 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8102 vv(1)=pizda(1,1)-pizda(2,2)
8103 vv(2)=pizda(1,2)+pizda(2,1)
8104 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8107 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8109 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8112 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8113 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8115 C Cartesian derivatives.
8117 write (2,*) 'In eello6_graph2'
8119 write (2,*) 'iii=',iii
8121 write (2,*) 'kkk=',kkk
8123 write (2,'(3(2f10.5),5x)')
8124 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8134 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8136 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8139 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8141 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8142 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8144 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8145 call transpose2(EUg(1,1,k),auxmat(1,1))
8146 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8148 vv(1)=pizda(1,1)-pizda(2,2)
8149 vv(2)=pizda(1,2)+pizda(2,1)
8150 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8151 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8153 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8155 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8158 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8160 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8167 c----------------------------------------------------------------------------
8168 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8169 implicit real*8 (a-h,o-z)
8170 include 'DIMENSIONS'
8171 include 'COMMON.IOUNITS'
8172 include 'COMMON.CHAIN'
8173 include 'COMMON.DERIV'
8174 include 'COMMON.INTERACT'
8175 include 'COMMON.CONTACTS'
8176 include 'COMMON.TORSION'
8177 include 'COMMON.VAR'
8178 include 'COMMON.GEO'
8179 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8181 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8183 C Parallel Antiparallel C
8189 C j|/k\| / |/k\|l / C
8194 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8196 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8197 C energy moment and not to the cluster cumulant.
8198 iti=itortyp(itype(i))
8199 if (j.lt.nres-1) then
8200 itj1=itortyp(itype(j+1))
8204 itk=itortyp(itype(k))
8205 itk1=itortyp(itype(k+1))
8206 if (l.lt.nres-1) then
8207 itl1=itortyp(itype(l+1))
8212 s1=dip(4,jj,i)*dip(4,kk,k)
8214 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8215 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8216 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8217 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8218 call transpose2(EE(1,1,itk),auxmat(1,1))
8219 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8220 vv(1)=pizda(1,1)+pizda(2,2)
8221 vv(2)=pizda(2,1)-pizda(1,2)
8222 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8223 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8224 cd & "sum",-(s2+s3+s4)
8226 eello6_graph3=-(s1+s2+s3+s4)
8228 eello6_graph3=-(s2+s3+s4)
8231 C Derivatives in gamma(k-1)
8232 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8233 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8234 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8235 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8236 C Derivatives in gamma(l-1)
8237 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8238 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8239 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8240 vv(1)=pizda(1,1)+pizda(2,2)
8241 vv(2)=pizda(2,1)-pizda(1,2)
8242 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8243 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8244 C Cartesian derivatives.
8250 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8252 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8255 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8257 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8258 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8260 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8261 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8263 vv(1)=pizda(1,1)+pizda(2,2)
8264 vv(2)=pizda(2,1)-pizda(1,2)
8265 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8267 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8269 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8272 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8274 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8276 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8282 c----------------------------------------------------------------------------
8283 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8284 implicit real*8 (a-h,o-z)
8285 include 'DIMENSIONS'
8286 include 'COMMON.IOUNITS'
8287 include 'COMMON.CHAIN'
8288 include 'COMMON.DERIV'
8289 include 'COMMON.INTERACT'
8290 include 'COMMON.CONTACTS'
8291 include 'COMMON.TORSION'
8292 include 'COMMON.VAR'
8293 include 'COMMON.GEO'
8294 include 'COMMON.FFIELD'
8295 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8296 & auxvec1(2),auxmat1(2,2)
8298 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8300 C Parallel Antiparallel C
8306 C \ j|/k\| \ |/k\|l C
8311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8313 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8314 C energy moment and not to the cluster cumulant.
8315 cd write (2,*) 'eello_graph4: wturn6',wturn6
8316 iti=itortyp(itype(i))
8317 itj=itortyp(itype(j))
8318 if (j.lt.nres-1) then
8319 itj1=itortyp(itype(j+1))
8323 itk=itortyp(itype(k))
8324 if (k.lt.nres-1) then
8325 itk1=itortyp(itype(k+1))
8329 itl=itortyp(itype(l))
8330 if (l.lt.nres-1) then
8331 itl1=itortyp(itype(l+1))
8335 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8336 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8337 cd & ' itl',itl,' itl1',itl1
8340 s1=dip(3,jj,i)*dip(3,kk,k)
8342 s1=dip(2,jj,j)*dip(2,kk,l)
8345 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8346 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8348 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8349 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8351 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8352 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8354 call transpose2(EUg(1,1,k),auxmat(1,1))
8355 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8356 vv(1)=pizda(1,1)-pizda(2,2)
8357 vv(2)=pizda(2,1)+pizda(1,2)
8358 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8359 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8361 eello6_graph4=-(s1+s2+s3+s4)
8363 eello6_graph4=-(s2+s3+s4)
8365 C Derivatives in gamma(i-1)
8369 s1=dipderg(2,jj,i)*dip(3,kk,k)
8371 s1=dipderg(4,jj,j)*dip(2,kk,l)
8374 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8376 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8377 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8379 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8380 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8382 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8383 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8384 cd write (2,*) 'turn6 derivatives'
8386 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8388 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8392 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8394 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8398 C Derivatives in gamma(k-1)
8401 s1=dip(3,jj,i)*dipderg(2,kk,k)
8403 s1=dip(2,jj,j)*dipderg(4,kk,l)
8406 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8407 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8409 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8410 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8412 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8413 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8415 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8416 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8417 vv(1)=pizda(1,1)-pizda(2,2)
8418 vv(2)=pizda(2,1)+pizda(1,2)
8419 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8420 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8422 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8424 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8428 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8430 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8433 C Derivatives in gamma(j-1) or gamma(l-1)
8434 if (l.eq.j+1 .and. l.gt.1) then
8435 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8436 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8437 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8438 vv(1)=pizda(1,1)-pizda(2,2)
8439 vv(2)=pizda(2,1)+pizda(1,2)
8440 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8441 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8442 else if (j.gt.1) then
8443 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8444 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8445 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8446 vv(1)=pizda(1,1)-pizda(2,2)
8447 vv(2)=pizda(2,1)+pizda(1,2)
8448 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8449 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8450 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8452 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8455 C Cartesian derivatives.
8462 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8464 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8468 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8470 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8474 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8476 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8478 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8479 & b1(1,itj1),auxvec(1))
8480 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8482 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8483 & b1(1,itl1),auxvec(1))
8484 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8486 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8488 vv(1)=pizda(1,1)-pizda(2,2)
8489 vv(2)=pizda(2,1)+pizda(1,2)
8490 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8492 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8494 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8497 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8500 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8503 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8505 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8507 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8511 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8513 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8516 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8518 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8526 c----------------------------------------------------------------------------
8527 double precision function eello_turn6(i,jj,kk)
8528 implicit real*8 (a-h,o-z)
8529 include 'DIMENSIONS'
8530 include 'COMMON.IOUNITS'
8531 include 'COMMON.CHAIN'
8532 include 'COMMON.DERIV'
8533 include 'COMMON.INTERACT'
8534 include 'COMMON.CONTACTS'
8535 include 'COMMON.TORSION'
8536 include 'COMMON.VAR'
8537 include 'COMMON.GEO'
8538 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8539 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8541 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8542 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8543 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8544 C the respective energy moment and not to the cluster cumulant.
8553 iti=itortyp(itype(i))
8554 itk=itortyp(itype(k))
8555 itk1=itortyp(itype(k+1))
8556 itl=itortyp(itype(l))
8557 itj=itortyp(itype(j))
8558 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8559 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8560 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8565 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8567 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8571 derx_turn(lll,kkk,iii)=0.0d0
8578 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8580 cd write (2,*) 'eello6_5',eello6_5
8582 call transpose2(AEA(1,1,1),auxmat(1,1))
8583 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8584 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8585 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8587 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8588 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8589 s2 = scalar2(b1(1,itk),vtemp1(1))
8591 call transpose2(AEA(1,1,2),atemp(1,1))
8592 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8593 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8594 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8596 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8597 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8598 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8600 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8601 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8602 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8603 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8604 ss13 = scalar2(b1(1,itk),vtemp4(1))
8605 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8607 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8613 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8614 C Derivatives in gamma(i+2)
8618 call transpose2(AEA(1,1,1),auxmatd(1,1))
8619 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8620 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8621 call transpose2(AEAderg(1,1,2),atempd(1,1))
8622 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8623 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8625 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8626 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8627 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8633 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8634 C Derivatives in gamma(i+3)
8636 call transpose2(AEA(1,1,1),auxmatd(1,1))
8637 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8638 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8639 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8641 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8642 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8643 s2d = scalar2(b1(1,itk),vtemp1d(1))
8645 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8646 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8648 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8650 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8651 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8652 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8660 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8661 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8663 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8664 & -0.5d0*ekont*(s2d+s12d)
8666 C Derivatives in gamma(i+4)
8667 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8668 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8669 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8671 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8672 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8673 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8681 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8683 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8685 C Derivatives in gamma(i+5)
8687 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8688 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8689 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8691 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8692 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8693 s2d = scalar2(b1(1,itk),vtemp1d(1))
8695 call transpose2(AEA(1,1,2),atempd(1,1))
8696 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8697 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8699 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8700 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8702 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8703 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8704 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8712 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8713 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8715 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8716 & -0.5d0*ekont*(s2d+s12d)
8718 C Cartesian derivatives
8723 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8724 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8725 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8727 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8728 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8730 s2d = scalar2(b1(1,itk),vtemp1d(1))
8732 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8733 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8734 s8d = -(atempd(1,1)+atempd(2,2))*
8735 & scalar2(cc(1,1,itl),vtemp2(1))
8737 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8739 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8740 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8747 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8750 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8754 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8755 & - 0.5d0*(s8d+s12d)
8757 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8766 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8768 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8769 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8770 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8771 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8772 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8774 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8775 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8776 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8780 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8781 cd & 16*eel_turn6_num
8783 if (j.lt.nres-1) then
8790 if (l.lt.nres-1) then
8798 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8799 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8800 cgrad ghalf=0.5d0*ggg1(ll)
8802 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8803 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8804 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8805 & +ekont*derx_turn(ll,2,1)
8806 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8807 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8808 & +ekont*derx_turn(ll,4,1)
8809 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8810 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8811 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8812 cgrad ghalf=0.5d0*ggg2(ll)
8814 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8815 & +ekont*derx_turn(ll,2,2)
8816 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8817 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8818 & +ekont*derx_turn(ll,4,2)
8819 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8820 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8821 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8826 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8831 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8837 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8842 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8846 cd write (2,*) iii,g_corr6_loc(iii)
8848 eello_turn6=ekont*eel_turn6
8849 cd write (2,*) 'ekont',ekont
8850 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8854 C-----------------------------------------------------------------------------
8855 double precision function scalar(u,v)
8856 !DIR$ INLINEALWAYS scalar
8858 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8861 double precision u(3),v(3)
8862 cd double precision sc
8870 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8873 crc-------------------------------------------------
8874 SUBROUTINE MATVEC2(A1,V1,V2)
8875 !DIR$ INLINEALWAYS MATVEC2
8877 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8879 implicit real*8 (a-h,o-z)
8880 include 'DIMENSIONS'
8881 DIMENSION A1(2,2),V1(2),V2(2)
8885 c 3 VI=VI+A1(I,K)*V1(K)
8889 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8890 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8895 C---------------------------------------
8896 SUBROUTINE MATMAT2(A1,A2,A3)
8898 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8900 implicit real*8 (a-h,o-z)
8901 include 'DIMENSIONS'
8902 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8903 c DIMENSION AI3(2,2)
8907 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8913 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8914 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8915 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8916 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8924 c-------------------------------------------------------------------------
8925 double precision function scalar2(u,v)
8926 !DIR$ INLINEALWAYS scalar2
8928 double precision u(2),v(2)
8931 scalar2=u(1)*v(1)+u(2)*v(2)
8935 C-----------------------------------------------------------------------------
8937 subroutine transpose2(a,at)
8938 !DIR$ INLINEALWAYS transpose2
8940 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8943 double precision a(2,2),at(2,2)
8950 c--------------------------------------------------------------------------
8951 subroutine transpose(n,a,at)
8954 double precision a(n,n),at(n,n)
8962 C---------------------------------------------------------------------------
8963 subroutine prodmat3(a1,a2,kk,transp,prod)
8964 !DIR$ INLINEALWAYS prodmat3
8966 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8970 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8972 crc double precision auxmat(2,2),prod_(2,2)
8975 crc call transpose2(kk(1,1),auxmat(1,1))
8976 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8977 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8979 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8980 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8981 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8982 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8983 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8984 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8985 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8986 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8989 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8990 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8992 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8993 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8994 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8995 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8996 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8997 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8998 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8999 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9002 c call transpose2(a2(1,1),a2t(1,1))
9005 crc print *,((prod_(i,j),i=1,2),j=1,2)
9006 crc print *,((prod(i,j),i=1,2),j=1,2)