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.21) cycle
4553 theti2=0.5d0*theta(i)
4554 ityp2=ithetyp(itype(i-1))
4556 coskt(k)=dcos(k*theti2)
4557 sinkt(k)=dsin(k*theti2)
4559 if (i.gt.3 .and. itype(i-2).ne.21) then
4562 if (phii.ne.phii) phii=150.0
4566 ityp1=ithetyp(itype(i-2))
4568 cosph1(k)=dcos(k*phii)
4569 sinph1(k)=dsin(k*phii)
4579 if (i.lt.nres .and. itype(i).ne.21) then
4582 if (phii1.ne.phii1) phii1=150.0
4587 ityp3=ithetyp(itype(i))
4589 cosph2(k)=dcos(k*phii1)
4590 sinph2(k)=dsin(k*phii1)
4600 ethetai=aa0thet(ityp1,ityp2,ityp3)
4603 ccl=cosph1(l)*cosph2(k-l)
4604 ssl=sinph1(l)*sinph2(k-l)
4605 scl=sinph1(l)*cosph2(k-l)
4606 csl=cosph1(l)*sinph2(k-l)
4607 cosph1ph2(l,k)=ccl-ssl
4608 cosph1ph2(k,l)=ccl+ssl
4609 sinph1ph2(l,k)=scl+csl
4610 sinph1ph2(k,l)=scl-csl
4614 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4615 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4616 write (iout,*) "coskt and sinkt"
4618 write (iout,*) k,coskt(k),sinkt(k)
4622 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4623 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4626 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4627 & " ethetai",ethetai
4630 write (iout,*) "cosph and sinph"
4632 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4634 write (iout,*) "cosph1ph2 and sinph2ph2"
4637 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4638 & sinph1ph2(l,k),sinph1ph2(k,l)
4641 write(iout,*) "ethetai",ethetai
4645 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4646 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4647 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4648 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4649 ethetai=ethetai+sinkt(m)*aux
4650 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4651 dephii=dephii+k*sinkt(m)*(
4652 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4653 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4654 dephii1=dephii1+k*sinkt(m)*(
4655 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4656 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4658 & write (iout,*) "m",m," k",k," bbthet",
4659 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4660 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4661 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4662 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4666 & write(iout,*) "ethetai",ethetai
4670 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4671 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4672 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4673 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4674 ethetai=ethetai+sinkt(m)*aux
4675 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4676 dephii=dephii+l*sinkt(m)*(
4677 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4678 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4679 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4680 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4681 dephii1=dephii1+(k-l)*sinkt(m)*(
4682 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4683 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4684 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4685 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4687 write (iout,*) "m",m," k",k," l",l," ffthet",
4688 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4689 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4690 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4691 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4692 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4693 & cosph1ph2(k,l)*sinkt(m),
4694 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4700 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4701 & i,theta(i)*rad2deg,phii*rad2deg,
4702 & phii1*rad2deg,ethetai
4703 etheta=etheta+ethetai
4704 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4705 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4706 gloc(nphi+i-2,icg)=wang*dethetai
4712 c-----------------------------------------------------------------------------
4713 subroutine esc(escloc)
4714 C Calculate the local energy of a side chain and its derivatives in the
4715 C corresponding virtual-bond valence angles THETA and the spherical angles
4717 implicit real*8 (a-h,o-z)
4718 include 'DIMENSIONS'
4719 include 'COMMON.GEO'
4720 include 'COMMON.LOCAL'
4721 include 'COMMON.VAR'
4722 include 'COMMON.INTERACT'
4723 include 'COMMON.DERIV'
4724 include 'COMMON.CHAIN'
4725 include 'COMMON.IOUNITS'
4726 include 'COMMON.NAMES'
4727 include 'COMMON.FFIELD'
4728 include 'COMMON.CONTROL'
4729 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4730 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4731 common /sccalc/ time11,time12,time112,theti,it,nlobit
4734 c write (iout,'(a)') 'ESC'
4735 do i=loc_start,loc_end
4738 if (it.eq.10) goto 1
4740 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4741 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4742 theti=theta(i+1)-pipol
4747 if (x(2).gt.pi-delta) then
4751 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4753 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4754 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4756 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4757 & ddersc0(1),dersc(1))
4758 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4759 & ddersc0(3),dersc(3))
4761 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4763 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4764 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4765 & dersc0(2),esclocbi,dersc02)
4766 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4768 call splinthet(x(2),0.5d0*delta,ss,ssd)
4773 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4775 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4776 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4778 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4780 c write (iout,*) escloci
4781 else if (x(2).lt.delta) then
4785 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4787 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4788 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4790 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4791 & ddersc0(1),dersc(1))
4792 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4793 & ddersc0(3),dersc(3))
4795 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4797 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4798 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4799 & dersc0(2),esclocbi,dersc02)
4800 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4805 call splinthet(x(2),0.5d0*delta,ss,ssd)
4807 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4809 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4810 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4812 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4813 c write (iout,*) escloci
4815 call enesc(x,escloci,dersc,ddummy,.false.)
4818 escloc=escloc+escloci
4819 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4820 & 'escloc',i,escloci
4821 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4823 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4825 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4826 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4831 C---------------------------------------------------------------------------
4832 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4833 implicit real*8 (a-h,o-z)
4834 include 'DIMENSIONS'
4835 include 'COMMON.GEO'
4836 include 'COMMON.LOCAL'
4837 include 'COMMON.IOUNITS'
4838 common /sccalc/ time11,time12,time112,theti,it,nlobit
4839 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4840 double precision contr(maxlob,-1:1)
4842 c write (iout,*) 'it=',it,' nlobit=',nlobit
4846 if (mixed) ddersc(j)=0.0d0
4850 C Because of periodicity of the dependence of the SC energy in omega we have
4851 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4852 C To avoid underflows, first compute & store the exponents.
4860 z(k)=x(k)-censc(k,j,it)
4865 Axk=Axk+gaussc(l,k,j,it)*z(l)
4871 expfac=expfac+Ax(k,j,iii)*z(k)
4879 C As in the case of ebend, we want to avoid underflows in exponentiation and
4880 C subsequent NaNs and INFs in energy calculation.
4881 C Find the largest exponent
4885 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4889 cd print *,'it=',it,' emin=',emin
4891 C Compute the contribution to SC energy and derivatives
4896 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4897 if(adexp.ne.adexp) adexp=1.0
4900 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4902 cd print *,'j=',j,' expfac=',expfac
4903 escloc_i=escloc_i+expfac
4905 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4909 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4910 & +gaussc(k,2,j,it))*expfac
4917 dersc(1)=dersc(1)/cos(theti)**2
4918 ddersc(1)=ddersc(1)/cos(theti)**2
4921 escloci=-(dlog(escloc_i)-emin)
4923 dersc(j)=dersc(j)/escloc_i
4927 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4932 C------------------------------------------------------------------------------
4933 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4934 implicit real*8 (a-h,o-z)
4935 include 'DIMENSIONS'
4936 include 'COMMON.GEO'
4937 include 'COMMON.LOCAL'
4938 include 'COMMON.IOUNITS'
4939 common /sccalc/ time11,time12,time112,theti,it,nlobit
4940 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4941 double precision contr(maxlob)
4952 z(k)=x(k)-censc(k,j,it)
4958 Axk=Axk+gaussc(l,k,j,it)*z(l)
4964 expfac=expfac+Ax(k,j)*z(k)
4969 C As in the case of ebend, we want to avoid underflows in exponentiation and
4970 C subsequent NaNs and INFs in energy calculation.
4971 C Find the largest exponent
4974 if (emin.gt.contr(j)) emin=contr(j)
4978 C Compute the contribution to SC energy and derivatives
4982 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4983 escloc_i=escloc_i+expfac
4985 dersc(k)=dersc(k)+Ax(k,j)*expfac
4987 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4988 & +gaussc(1,2,j,it))*expfac
4992 dersc(1)=dersc(1)/cos(theti)**2
4993 dersc12=dersc12/cos(theti)**2
4994 escloci=-(dlog(escloc_i)-emin)
4996 dersc(j)=dersc(j)/escloc_i
4998 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5002 c----------------------------------------------------------------------------------
5003 subroutine esc(escloc)
5004 C Calculate the local energy of a side chain and its derivatives in the
5005 C corresponding virtual-bond valence angles THETA and the spherical angles
5006 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5007 C added by Urszula Kozlowska. 07/11/2007
5009 implicit real*8 (a-h,o-z)
5010 include 'DIMENSIONS'
5011 include 'COMMON.GEO'
5012 include 'COMMON.LOCAL'
5013 include 'COMMON.VAR'
5014 include 'COMMON.SCROT'
5015 include 'COMMON.INTERACT'
5016 include 'COMMON.DERIV'
5017 include 'COMMON.CHAIN'
5018 include 'COMMON.IOUNITS'
5019 include 'COMMON.NAMES'
5020 include 'COMMON.FFIELD'
5021 include 'COMMON.CONTROL'
5022 include 'COMMON.VECTORS'
5023 double precision x_prime(3),y_prime(3),z_prime(3)
5024 & , sumene,dsc_i,dp2_i,x(65),
5025 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5026 & de_dxx,de_dyy,de_dzz,de_dt
5027 double precision s1_t,s1_6_t,s2_t,s2_6_t
5029 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5030 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5031 & dt_dCi(3),dt_dCi1(3)
5032 common /sccalc/ time11,time12,time112,theti,it,nlobit
5035 do i=loc_start,loc_end
5036 if (itype(i).eq.21) cycle
5037 costtab(i+1) =dcos(theta(i+1))
5038 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5039 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5040 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5041 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5042 cosfac=dsqrt(cosfac2)
5043 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5044 sinfac=dsqrt(sinfac2)
5046 if (it.eq.10) goto 1
5048 C Compute the axes of tghe local cartesian coordinates system; store in
5049 c x_prime, y_prime and z_prime
5056 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5057 C & dc_norm(3,i+nres)
5059 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5060 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5063 z_prime(j) = -uz(j,i-1)
5066 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5067 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5068 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5069 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5070 c & " xy",scalar(x_prime(1),y_prime(1)),
5071 c & " xz",scalar(x_prime(1),z_prime(1)),
5072 c & " yy",scalar(y_prime(1),y_prime(1)),
5073 c & " yz",scalar(y_prime(1),z_prime(1)),
5074 c & " zz",scalar(z_prime(1),z_prime(1))
5076 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5077 C to local coordinate system. Store in xx, yy, zz.
5083 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5084 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5085 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5092 C Compute the energy of the ith side cbain
5094 c write (2,*) "xx",xx," yy",yy," zz",zz
5097 x(j) = sc_parmin(j,it)
5100 Cc diagnostics - remove later
5102 yy1 = dsin(alph(2))*dcos(omeg(2))
5103 zz1 = -dsin(alph(2))*dsin(omeg(2))
5104 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5105 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5107 C," --- ", xx_w,yy_w,zz_w
5110 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5111 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5113 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5114 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5116 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5117 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5118 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5119 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5120 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5122 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5123 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5124 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5125 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5126 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5128 dsc_i = 0.743d0+x(61)
5130 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5131 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5132 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5133 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5134 s1=(1+x(63))/(0.1d0 + dscp1)
5135 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5136 s2=(1+x(65))/(0.1d0 + dscp2)
5137 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5138 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5139 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5140 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5142 c & dscp1,dscp2,sumene
5143 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5144 escloc = escloc + sumene
5145 c write (2,*) "i",i," escloc",sumene,escloc
5148 C This section to check the numerical derivatives of the energy of ith side
5149 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5150 C #define DEBUG in the code to turn it on.
5152 write (2,*) "sumene =",sumene
5156 write (2,*) xx,yy,zz
5157 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5158 de_dxx_num=(sumenep-sumene)/aincr
5160 write (2,*) "xx+ sumene from enesc=",sumenep
5163 write (2,*) xx,yy,zz
5164 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5165 de_dyy_num=(sumenep-sumene)/aincr
5167 write (2,*) "yy+ sumene from enesc=",sumenep
5170 write (2,*) xx,yy,zz
5171 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5172 de_dzz_num=(sumenep-sumene)/aincr
5174 write (2,*) "zz+ sumene from enesc=",sumenep
5175 costsave=cost2tab(i+1)
5176 sintsave=sint2tab(i+1)
5177 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5178 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5179 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5180 de_dt_num=(sumenep-sumene)/aincr
5181 write (2,*) " t+ sumene from enesc=",sumenep
5182 cost2tab(i+1)=costsave
5183 sint2tab(i+1)=sintsave
5184 C End of diagnostics section.
5187 C Compute the gradient of esc
5189 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5190 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5191 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5192 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5193 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5194 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5195 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5196 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5197 pom1=(sumene3*sint2tab(i+1)+sumene1)
5198 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5199 pom2=(sumene4*cost2tab(i+1)+sumene2)
5200 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5201 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5202 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5203 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5205 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5206 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5207 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5209 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5210 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5211 & +(pom1+pom2)*pom_dx
5213 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5216 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5217 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5218 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5220 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5221 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5222 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5223 & +x(59)*zz**2 +x(60)*xx*zz
5224 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5225 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5226 & +(pom1-pom2)*pom_dy
5228 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5231 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5232 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5233 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5234 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5235 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5236 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5237 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5238 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5240 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5243 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5244 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5245 & +pom1*pom_dt1+pom2*pom_dt2
5247 write(2,*), "de_dt = ", de_dt,de_dt_num
5251 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5252 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5253 cosfac2xx=cosfac2*xx
5254 sinfac2yy=sinfac2*yy
5256 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5258 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5260 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5261 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5262 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5263 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5264 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5265 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5266 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5267 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5268 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5269 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5273 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5274 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5277 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5278 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5279 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5281 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5282 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5286 dXX_Ctab(k,i)=dXX_Ci(k)
5287 dXX_C1tab(k,i)=dXX_Ci1(k)
5288 dYY_Ctab(k,i)=dYY_Ci(k)
5289 dYY_C1tab(k,i)=dYY_Ci1(k)
5290 dZZ_Ctab(k,i)=dZZ_Ci(k)
5291 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5292 dXX_XYZtab(k,i)=dXX_XYZ(k)
5293 dYY_XYZtab(k,i)=dYY_XYZ(k)
5294 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5298 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5299 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5300 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5301 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5302 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5304 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5305 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5306 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5307 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5308 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5309 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5310 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5311 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5313 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5314 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5316 C to check gradient call subroutine check_grad
5322 c------------------------------------------------------------------------------
5323 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5325 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5326 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5327 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5328 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5330 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5331 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5333 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5334 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5335 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5336 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5337 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5339 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5340 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5341 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5342 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5343 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5345 dsc_i = 0.743d0+x(61)
5347 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5348 & *(xx*cost2+yy*sint2))
5349 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5350 & *(xx*cost2-yy*sint2))
5351 s1=(1+x(63))/(0.1d0 + dscp1)
5352 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5353 s2=(1+x(65))/(0.1d0 + dscp2)
5354 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5355 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5356 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5361 c------------------------------------------------------------------------------
5362 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5364 C This procedure calculates two-body contact function g(rij) and its derivative:
5367 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5370 C where x=(rij-r0ij)/delta
5372 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5375 double precision rij,r0ij,eps0ij,fcont,fprimcont
5376 double precision x,x2,x4,delta
5380 if (x.lt.-1.0D0) then
5383 else if (x.le.1.0D0) then
5386 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5387 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5394 c------------------------------------------------------------------------------
5395 subroutine splinthet(theti,delta,ss,ssder)
5396 implicit real*8 (a-h,o-z)
5397 include 'DIMENSIONS'
5398 include 'COMMON.VAR'
5399 include 'COMMON.GEO'
5402 if (theti.gt.pipol) then
5403 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5405 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5410 c------------------------------------------------------------------------------
5411 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5413 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5414 double precision ksi,ksi2,ksi3,a1,a2,a3
5415 a1=fprim0*delta/(f1-f0)
5421 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5422 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5425 c------------------------------------------------------------------------------
5426 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5428 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5429 double precision ksi,ksi2,ksi3,a1,a2,a3
5434 a2=3*(f1x-f0x)-2*fprim0x*delta
5435 a3=fprim0x*delta-2*(f1x-f0x)
5436 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5439 C-----------------------------------------------------------------------------
5441 C-----------------------------------------------------------------------------
5442 subroutine etor(etors,edihcnstr)
5443 implicit real*8 (a-h,o-z)
5444 include 'DIMENSIONS'
5445 include 'COMMON.VAR'
5446 include 'COMMON.GEO'
5447 include 'COMMON.LOCAL'
5448 include 'COMMON.TORSION'
5449 include 'COMMON.INTERACT'
5450 include 'COMMON.DERIV'
5451 include 'COMMON.CHAIN'
5452 include 'COMMON.NAMES'
5453 include 'COMMON.IOUNITS'
5454 include 'COMMON.FFIELD'
5455 include 'COMMON.TORCNSTR'
5456 include 'COMMON.CONTROL'
5458 C Set lprn=.true. for debugging
5462 do i=iphi_start,iphi_end
5464 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5465 & .or. itype(i).eq.21) cycle
5466 itori=itortyp(itype(i-2))
5467 itori1=itortyp(itype(i-1))
5470 C Proline-Proline pair is a special case...
5471 if (itori.eq.3 .and. itori1.eq.3) then
5472 if (phii.gt.-dwapi3) then
5474 fac=1.0D0/(1.0D0-cosphi)
5475 etorsi=v1(1,3,3)*fac
5476 etorsi=etorsi+etorsi
5477 etors=etors+etorsi-v1(1,3,3)
5478 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5479 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5482 v1ij=v1(j+1,itori,itori1)
5483 v2ij=v2(j+1,itori,itori1)
5486 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5487 if (energy_dec) etors_ii=etors_ii+
5488 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5489 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5493 v1ij=v1(j,itori,itori1)
5494 v2ij=v2(j,itori,itori1)
5497 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5498 if (energy_dec) etors_ii=etors_ii+
5499 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5500 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5503 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5506 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5507 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5508 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5509 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5510 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5512 ! 6/20/98 - dihedral angle constraints
5515 itori=idih_constr(i)
5518 if (difi.gt.drange(i)) then
5520 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5521 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5522 else if (difi.lt.-drange(i)) then
5524 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5525 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5527 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5528 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5530 ! write (iout,*) 'edihcnstr',edihcnstr
5533 c------------------------------------------------------------------------------
5534 subroutine etor_d(etors_d)
5538 c----------------------------------------------------------------------------
5540 subroutine etor(etors,edihcnstr)
5541 implicit real*8 (a-h,o-z)
5542 include 'DIMENSIONS'
5543 include 'COMMON.VAR'
5544 include 'COMMON.GEO'
5545 include 'COMMON.LOCAL'
5546 include 'COMMON.TORSION'
5547 include 'COMMON.INTERACT'
5548 include 'COMMON.DERIV'
5549 include 'COMMON.CHAIN'
5550 include 'COMMON.NAMES'
5551 include 'COMMON.IOUNITS'
5552 include 'COMMON.FFIELD'
5553 include 'COMMON.TORCNSTR'
5554 include 'COMMON.CONTROL'
5556 C Set lprn=.true. for debugging
5560 do i=iphi_start,iphi_end
5561 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5562 & .or. itype(i).eq.21
5563 & .or. itype(i-3).eq.ntyp1) cycle
5565 itori=itortyp(itype(i-2))
5566 itori1=itortyp(itype(i-1))
5569 C Regular cosine and sine terms
5570 do j=1,nterm(itori,itori1)
5571 v1ij=v1(j,itori,itori1)
5572 v2ij=v2(j,itori,itori1)
5575 etors=etors+v1ij*cosphi+v2ij*sinphi
5576 if (energy_dec) etors_ii=etors_ii+
5577 & v1ij*cosphi+v2ij*sinphi
5578 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5582 C E = SUM ----------------------------------- - v1
5583 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5585 cosphi=dcos(0.5d0*phii)
5586 sinphi=dsin(0.5d0*phii)
5587 do j=1,nlor(itori,itori1)
5588 vl1ij=vlor1(j,itori,itori1)
5589 vl2ij=vlor2(j,itori,itori1)
5590 vl3ij=vlor3(j,itori,itori1)
5591 pom=vl2ij*cosphi+vl3ij*sinphi
5592 pom1=1.0d0/(pom*pom+1.0d0)
5593 etors=etors+vl1ij*pom1
5594 if (energy_dec) etors_ii=etors_ii+
5597 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5599 C Subtract the constant term
5600 etors=etors-v0(itori,itori1)
5601 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5602 & 'etor',i,etors_ii-v0(itori,itori1)
5604 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5605 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5606 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5607 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5608 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5610 ! 6/20/98 - dihedral angle constraints
5612 c do i=1,ndih_constr
5613 do i=idihconstr_start,idihconstr_end
5614 itori=idih_constr(i)
5616 difi=pinorm(phii-phi0(i))
5617 if (difi.gt.drange(i)) then
5619 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5620 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5621 else if (difi.lt.-drange(i)) then
5623 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5624 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5628 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5629 cd & rad2deg*phi0(i), rad2deg*drange(i),
5630 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5632 cd write (iout,*) 'edihcnstr',edihcnstr
5635 c----------------------------------------------------------------------------
5636 subroutine etor_d(etors_d)
5637 C 6/23/01 Compute double torsional energy
5638 implicit real*8 (a-h,o-z)
5639 include 'DIMENSIONS'
5640 include 'COMMON.VAR'
5641 include 'COMMON.GEO'
5642 include 'COMMON.LOCAL'
5643 include 'COMMON.TORSION'
5644 include 'COMMON.INTERACT'
5645 include 'COMMON.DERIV'
5646 include 'COMMON.CHAIN'
5647 include 'COMMON.NAMES'
5648 include 'COMMON.IOUNITS'
5649 include 'COMMON.FFIELD'
5650 include 'COMMON.TORCNSTR'
5652 C Set lprn=.true. for debugging
5656 C write(iout,*) "a tu??"
5657 do i=iphid_start,iphid_end
5658 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5659 & .or. itype(i).eq.21 .or. itype(i+1).eq.21
5660 & .or. itype(i-3).eq.ntyp1) cycle
5661 itori=itortyp(itype(i-2))
5662 itori1=itortyp(itype(i-1))
5663 itori2=itortyp(itype(i))
5668 C Regular cosine and sine terms
5669 do j=1,ntermd_1(itori,itori1,itori2)
5670 v1cij=v1c(1,j,itori,itori1,itori2)
5671 v1sij=v1s(1,j,itori,itori1,itori2)
5672 v2cij=v1c(2,j,itori,itori1,itori2)
5673 v2sij=v1s(2,j,itori,itori1,itori2)
5674 cosphi1=dcos(j*phii)
5675 sinphi1=dsin(j*phii)
5676 cosphi2=dcos(j*phii1)
5677 sinphi2=dsin(j*phii1)
5678 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5679 & v2cij*cosphi2+v2sij*sinphi2
5680 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5681 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5683 do k=2,ntermd_2(itori,itori1,itori2)
5685 v1cdij = v2c(k,l,itori,itori1,itori2)
5686 v2cdij = v2c(l,k,itori,itori1,itori2)
5687 v1sdij = v2s(k,l,itori,itori1,itori2)
5688 v2sdij = v2s(l,k,itori,itori1,itori2)
5689 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5690 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5691 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5692 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5693 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5694 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5695 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5696 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5697 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5698 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5701 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5702 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5707 c------------------------------------------------------------------------------
5708 subroutine eback_sc_corr(esccor)
5709 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5710 c conformational states; temporarily implemented as differences
5711 c between UNRES torsional potentials (dependent on three types of
5712 c residues) and the torsional potentials dependent on all 20 types
5713 c of residues computed from AM1 energy surfaces of terminally-blocked
5714 c amino-acid residues.
5715 implicit real*8 (a-h,o-z)
5716 include 'DIMENSIONS'
5717 include 'COMMON.VAR'
5718 include 'COMMON.GEO'
5719 include 'COMMON.LOCAL'
5720 include 'COMMON.TORSION'
5721 include 'COMMON.SCCOR'
5722 include 'COMMON.INTERACT'
5723 include 'COMMON.DERIV'
5724 include 'COMMON.CHAIN'
5725 include 'COMMON.NAMES'
5726 include 'COMMON.IOUNITS'
5727 include 'COMMON.FFIELD'
5728 include 'COMMON.CONTROL'
5730 C Set lprn=.true. for debugging
5733 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5735 do i=itau_start,itau_end
5736 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5738 isccori=isccortyp(itype(i-2))
5739 isccori1=isccortyp(itype(i-1))
5740 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5742 do intertyp=1,3 !intertyp
5743 cc Added 09 May 2012 (Adasko)
5744 cc Intertyp means interaction type of backbone mainchain correlation:
5745 c 1 = SC...Ca...Ca...Ca
5746 c 2 = Ca...Ca...Ca...SC
5747 c 3 = SC...Ca...Ca...SCi
5749 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5750 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5751 & (itype(i-1).eq.ntyp1)))
5752 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5753 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5754 & .or.(itype(i).eq.ntyp1)))
5755 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5756 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5757 & (itype(i-3).eq.ntyp1)))) cycle
5758 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5759 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5761 do j=1,nterm_sccor(isccori,isccori1)
5762 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5763 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5764 cosphi=dcos(j*tauangle(intertyp,i))
5765 sinphi=dsin(j*tauangle(intertyp,i))
5766 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5767 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5769 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5770 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5772 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5773 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5774 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5775 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5776 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5782 c----------------------------------------------------------------------------
5783 subroutine multibody(ecorr)
5784 C This subroutine calculates multi-body contributions to energy following
5785 C the idea of Skolnick et al. If side chains I and J make a contact and
5786 C at the same time side chains I+1 and J+1 make a contact, an extra
5787 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5788 implicit real*8 (a-h,o-z)
5789 include 'DIMENSIONS'
5790 include 'COMMON.IOUNITS'
5791 include 'COMMON.DERIV'
5792 include 'COMMON.INTERACT'
5793 include 'COMMON.CONTACTS'
5794 double precision gx(3),gx1(3)
5797 C Set lprn=.true. for debugging
5801 write (iout,'(a)') 'Contact function values:'
5803 write (iout,'(i2,20(1x,i2,f10.5))')
5804 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5819 num_conti=num_cont(i)
5820 num_conti1=num_cont(i1)
5825 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5826 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5827 cd & ' ishift=',ishift
5828 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5829 C The system gains extra energy.
5830 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5831 endif ! j1==j+-ishift
5840 c------------------------------------------------------------------------------
5841 double precision function esccorr(i,j,k,l,jj,kk)
5842 implicit real*8 (a-h,o-z)
5843 include 'DIMENSIONS'
5844 include 'COMMON.IOUNITS'
5845 include 'COMMON.DERIV'
5846 include 'COMMON.INTERACT'
5847 include 'COMMON.CONTACTS'
5848 double precision gx(3),gx1(3)
5853 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5854 C Calculate the multi-body contribution to energy.
5855 C Calculate multi-body contributions to the gradient.
5856 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5857 cd & k,l,(gacont(m,kk,k),m=1,3)
5859 gx(m) =ekl*gacont(m,jj,i)
5860 gx1(m)=eij*gacont(m,kk,k)
5861 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5862 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5863 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5864 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5868 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5873 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5879 c------------------------------------------------------------------------------
5880 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5881 C This subroutine calculates multi-body contributions to hydrogen-bonding
5882 implicit real*8 (a-h,o-z)
5883 include 'DIMENSIONS'
5884 include 'COMMON.IOUNITS'
5887 parameter (max_cont=maxconts)
5888 parameter (max_dim=26)
5889 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5890 double precision zapas(max_dim,maxconts,max_fg_procs),
5891 & zapas_recv(max_dim,maxconts,max_fg_procs)
5892 common /przechowalnia/ zapas
5893 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5894 & status_array(MPI_STATUS_SIZE,maxconts*2)
5896 include 'COMMON.SETUP'
5897 include 'COMMON.FFIELD'
5898 include 'COMMON.DERIV'
5899 include 'COMMON.INTERACT'
5900 include 'COMMON.CONTACTS'
5901 include 'COMMON.CONTROL'
5902 include 'COMMON.LOCAL'
5903 double precision gx(3),gx1(3),time00
5906 C Set lprn=.true. for debugging
5911 if (nfgtasks.le.1) goto 30
5913 write (iout,'(a)') 'Contact function values before RECEIVE:'
5915 write (iout,'(2i3,50(1x,i2,f5.2))')
5916 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5917 & j=1,num_cont_hb(i))
5921 do i=1,ntask_cont_from
5924 do i=1,ntask_cont_to
5927 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5929 C Make the list of contacts to send to send to other procesors
5930 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5932 do i=iturn3_start,iturn3_end
5933 c write (iout,*) "make contact list turn3",i," num_cont",
5935 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5937 do i=iturn4_start,iturn4_end
5938 c write (iout,*) "make contact list turn4",i," num_cont",
5940 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5944 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5946 do j=1,num_cont_hb(i)
5949 iproc=iint_sent_local(k,jjc,ii)
5950 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5951 if (iproc.gt.0) then
5952 ncont_sent(iproc)=ncont_sent(iproc)+1
5953 nn=ncont_sent(iproc)
5955 zapas(2,nn,iproc)=jjc
5956 zapas(3,nn,iproc)=facont_hb(j,i)
5957 zapas(4,nn,iproc)=ees0p(j,i)
5958 zapas(5,nn,iproc)=ees0m(j,i)
5959 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5960 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5961 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5962 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5963 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5964 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5965 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5966 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5967 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5968 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5969 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5970 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5971 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5972 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5973 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5974 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5975 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5976 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5977 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5978 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5979 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5986 & "Numbers of contacts to be sent to other processors",
5987 & (ncont_sent(i),i=1,ntask_cont_to)
5988 write (iout,*) "Contacts sent"
5989 do ii=1,ntask_cont_to
5991 iproc=itask_cont_to(ii)
5992 write (iout,*) nn," contacts to processor",iproc,
5993 & " of CONT_TO_COMM group"
5995 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6003 CorrelID1=nfgtasks+fg_rank+1
6005 C Receive the numbers of needed contacts from other processors
6006 do ii=1,ntask_cont_from
6007 iproc=itask_cont_from(ii)
6009 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6010 & FG_COMM,req(ireq),IERR)
6012 c write (iout,*) "IRECV ended"
6014 C Send the number of contacts needed by other processors
6015 do ii=1,ntask_cont_to
6016 iproc=itask_cont_to(ii)
6018 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6019 & FG_COMM,req(ireq),IERR)
6021 c write (iout,*) "ISEND ended"
6022 c write (iout,*) "number of requests (nn)",ireq
6025 & call MPI_Waitall(ireq,req,status_array,ierr)
6027 c & "Numbers of contacts to be received from other processors",
6028 c & (ncont_recv(i),i=1,ntask_cont_from)
6032 do ii=1,ntask_cont_from
6033 iproc=itask_cont_from(ii)
6035 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6036 c & " of CONT_TO_COMM group"
6040 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6041 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6042 c write (iout,*) "ireq,req",ireq,req(ireq)
6045 C Send the contacts to processors that need them
6046 do ii=1,ntask_cont_to
6047 iproc=itask_cont_to(ii)
6049 c write (iout,*) nn," contacts to processor",iproc,
6050 c & " of CONT_TO_COMM group"
6053 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6054 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6055 c write (iout,*) "ireq,req",ireq,req(ireq)
6057 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6061 c write (iout,*) "number of requests (contacts)",ireq
6062 c write (iout,*) "req",(req(i),i=1,4)
6065 & call MPI_Waitall(ireq,req,status_array,ierr)
6066 do iii=1,ntask_cont_from
6067 iproc=itask_cont_from(iii)
6070 write (iout,*) "Received",nn," contacts from processor",iproc,
6071 & " of CONT_FROM_COMM group"
6074 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6079 ii=zapas_recv(1,i,iii)
6080 c Flag the received contacts to prevent double-counting
6081 jj=-zapas_recv(2,i,iii)
6082 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6084 nnn=num_cont_hb(ii)+1
6087 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6088 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6089 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6090 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6091 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6092 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6093 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6094 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6095 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6096 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6097 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6098 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6099 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6100 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6101 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6102 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6103 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6104 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6105 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6106 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6107 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6108 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6109 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6110 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6115 write (iout,'(a)') 'Contact function values after receive:'
6117 write (iout,'(2i3,50(1x,i3,f5.2))')
6118 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6119 & j=1,num_cont_hb(i))
6126 write (iout,'(a)') 'Contact function values:'
6128 write (iout,'(2i3,50(1x,i3,f5.2))')
6129 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6130 & j=1,num_cont_hb(i))
6134 C Remove the loop below after debugging !!!
6141 C Calculate the local-electrostatic correlation terms
6142 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6144 num_conti=num_cont_hb(i)
6145 num_conti1=num_cont_hb(i+1)
6152 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6153 c & ' jj=',jj,' kk=',kk
6154 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6155 & .or. j.lt.0 .and. j1.gt.0) .and.
6156 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6157 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6158 C The system gains extra energy.
6159 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6160 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6161 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6163 else if (j1.eq.j) then
6164 C Contacts I-J and I-(J+1) occur simultaneously.
6165 C The system loses extra energy.
6166 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6171 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6172 c & ' jj=',jj,' kk=',kk
6174 C Contacts I-J and (I+1)-J occur simultaneously.
6175 C The system loses extra energy.
6176 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6183 c------------------------------------------------------------------------------
6184 subroutine add_hb_contact(ii,jj,itask)
6185 implicit real*8 (a-h,o-z)
6186 include "DIMENSIONS"
6187 include "COMMON.IOUNITS"
6190 parameter (max_cont=maxconts)
6191 parameter (max_dim=26)
6192 include "COMMON.CONTACTS"
6193 double precision zapas(max_dim,maxconts,max_fg_procs),
6194 & zapas_recv(max_dim,maxconts,max_fg_procs)
6195 common /przechowalnia/ zapas
6196 integer i,j,ii,jj,iproc,itask(4),nn
6197 c write (iout,*) "itask",itask
6200 if (iproc.gt.0) then
6201 do j=1,num_cont_hb(ii)
6203 c write (iout,*) "i",ii," j",jj," jjc",jjc
6205 ncont_sent(iproc)=ncont_sent(iproc)+1
6206 nn=ncont_sent(iproc)
6207 zapas(1,nn,iproc)=ii
6208 zapas(2,nn,iproc)=jjc
6209 zapas(3,nn,iproc)=facont_hb(j,ii)
6210 zapas(4,nn,iproc)=ees0p(j,ii)
6211 zapas(5,nn,iproc)=ees0m(j,ii)
6212 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6213 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6214 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6215 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6216 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6217 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6218 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6219 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6220 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6221 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6222 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6223 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6224 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6225 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6226 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6227 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6228 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6229 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6230 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6231 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6232 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6240 c------------------------------------------------------------------------------
6241 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6243 C This subroutine calculates multi-body contributions to hydrogen-bonding
6244 implicit real*8 (a-h,o-z)
6245 include 'DIMENSIONS'
6246 include 'COMMON.IOUNITS'
6249 parameter (max_cont=maxconts)
6250 parameter (max_dim=70)
6251 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6252 double precision zapas(max_dim,maxconts,max_fg_procs),
6253 & zapas_recv(max_dim,maxconts,max_fg_procs)
6254 common /przechowalnia/ zapas
6255 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6256 & status_array(MPI_STATUS_SIZE,maxconts*2)
6258 include 'COMMON.SETUP'
6259 include 'COMMON.FFIELD'
6260 include 'COMMON.DERIV'
6261 include 'COMMON.LOCAL'
6262 include 'COMMON.INTERACT'
6263 include 'COMMON.CONTACTS'
6264 include 'COMMON.CHAIN'
6265 include 'COMMON.CONTROL'
6266 double precision gx(3),gx1(3)
6267 integer num_cont_hb_old(maxres)
6269 double precision eello4,eello5,eelo6,eello_turn6
6270 external eello4,eello5,eello6,eello_turn6
6271 C Set lprn=.true. for debugging
6276 num_cont_hb_old(i)=num_cont_hb(i)
6280 if (nfgtasks.le.1) goto 30
6282 write (iout,'(a)') 'Contact function values before RECEIVE:'
6284 write (iout,'(2i3,50(1x,i2,f5.2))')
6285 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6286 & j=1,num_cont_hb(i))
6290 do i=1,ntask_cont_from
6293 do i=1,ntask_cont_to
6296 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6298 C Make the list of contacts to send to send to other procesors
6299 do i=iturn3_start,iturn3_end
6300 c write (iout,*) "make contact list turn3",i," num_cont",
6302 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6304 do i=iturn4_start,iturn4_end
6305 c write (iout,*) "make contact list turn4",i," num_cont",
6307 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6311 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6313 do j=1,num_cont_hb(i)
6316 iproc=iint_sent_local(k,jjc,ii)
6317 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6318 if (iproc.ne.0) then
6319 ncont_sent(iproc)=ncont_sent(iproc)+1
6320 nn=ncont_sent(iproc)
6322 zapas(2,nn,iproc)=jjc
6323 zapas(3,nn,iproc)=d_cont(j,i)
6327 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6332 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6340 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6351 & "Numbers of contacts to be sent to other processors",
6352 & (ncont_sent(i),i=1,ntask_cont_to)
6353 write (iout,*) "Contacts sent"
6354 do ii=1,ntask_cont_to
6356 iproc=itask_cont_to(ii)
6357 write (iout,*) nn," contacts to processor",iproc,
6358 & " of CONT_TO_COMM group"
6360 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6368 CorrelID1=nfgtasks+fg_rank+1
6370 C Receive the numbers of needed contacts from other processors
6371 do ii=1,ntask_cont_from
6372 iproc=itask_cont_from(ii)
6374 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6375 & FG_COMM,req(ireq),IERR)
6377 c write (iout,*) "IRECV ended"
6379 C Send the number of contacts needed by other processors
6380 do ii=1,ntask_cont_to
6381 iproc=itask_cont_to(ii)
6383 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6384 & FG_COMM,req(ireq),IERR)
6386 c write (iout,*) "ISEND ended"
6387 c write (iout,*) "number of requests (nn)",ireq
6390 & call MPI_Waitall(ireq,req,status_array,ierr)
6392 c & "Numbers of contacts to be received from other processors",
6393 c & (ncont_recv(i),i=1,ntask_cont_from)
6397 do ii=1,ntask_cont_from
6398 iproc=itask_cont_from(ii)
6400 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6401 c & " of CONT_TO_COMM group"
6405 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6406 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6407 c write (iout,*) "ireq,req",ireq,req(ireq)
6410 C Send the contacts to processors that need them
6411 do ii=1,ntask_cont_to
6412 iproc=itask_cont_to(ii)
6414 c write (iout,*) nn," contacts to processor",iproc,
6415 c & " of CONT_TO_COMM group"
6418 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6419 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6420 c write (iout,*) "ireq,req",ireq,req(ireq)
6422 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6426 c write (iout,*) "number of requests (contacts)",ireq
6427 c write (iout,*) "req",(req(i),i=1,4)
6430 & call MPI_Waitall(ireq,req,status_array,ierr)
6431 do iii=1,ntask_cont_from
6432 iproc=itask_cont_from(iii)
6435 write (iout,*) "Received",nn," contacts from processor",iproc,
6436 & " of CONT_FROM_COMM group"
6439 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6444 ii=zapas_recv(1,i,iii)
6445 c Flag the received contacts to prevent double-counting
6446 jj=-zapas_recv(2,i,iii)
6447 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6449 nnn=num_cont_hb(ii)+1
6452 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6456 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6461 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6469 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6478 write (iout,'(a)') 'Contact function values after receive:'
6480 write (iout,'(2i3,50(1x,i3,5f6.3))')
6481 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6482 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6489 write (iout,'(a)') 'Contact function values:'
6491 write (iout,'(2i3,50(1x,i2,5f6.3))')
6492 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6493 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6499 C Remove the loop below after debugging !!!
6506 C Calculate the dipole-dipole interaction energies
6507 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6508 do i=iatel_s,iatel_e+1
6509 num_conti=num_cont_hb(i)
6518 C Calculate the local-electrostatic correlation terms
6519 c write (iout,*) "gradcorr5 in eello5 before loop"
6521 c write (iout,'(i5,3f10.5)')
6522 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6524 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6525 c write (iout,*) "corr loop i",i
6527 num_conti=num_cont_hb(i)
6528 num_conti1=num_cont_hb(i+1)
6535 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6536 c & ' jj=',jj,' kk=',kk
6537 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6538 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6539 & .or. j.lt.0 .and. j1.gt.0) .and.
6540 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6541 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6542 C The system gains extra energy.
6544 sqd1=dsqrt(d_cont(jj,i))
6545 sqd2=dsqrt(d_cont(kk,i1))
6546 sred_geom = sqd1*sqd2
6547 IF (sred_geom.lt.cutoff_corr) THEN
6548 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6550 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6551 cd & ' jj=',jj,' kk=',kk
6552 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6553 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6555 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6556 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6559 cd write (iout,*) 'sred_geom=',sred_geom,
6560 cd & ' ekont=',ekont,' fprim=',fprimcont,
6561 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6562 cd write (iout,*) "g_contij",g_contij
6563 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6564 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6565 call calc_eello(i,jp,i+1,jp1,jj,kk)
6566 if (wcorr4.gt.0.0d0)
6567 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6568 if (energy_dec.and.wcorr4.gt.0.0d0)
6569 1 write (iout,'(a6,4i5,0pf7.3)')
6570 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6571 c write (iout,*) "gradcorr5 before eello5"
6573 c write (iout,'(i5,3f10.5)')
6574 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6576 if (wcorr5.gt.0.0d0)
6577 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6578 c write (iout,*) "gradcorr5 after eello5"
6580 c write (iout,'(i5,3f10.5)')
6581 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6583 if (energy_dec.and.wcorr5.gt.0.0d0)
6584 1 write (iout,'(a6,4i5,0pf7.3)')
6585 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6586 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6587 cd write(2,*)'ijkl',i,jp,i+1,jp1
6588 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6589 & .or. wturn6.eq.0.0d0))then
6590 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6591 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6592 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6593 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6594 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6595 cd & 'ecorr6=',ecorr6
6596 cd write (iout,'(4e15.5)') sred_geom,
6597 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6598 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6599 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6600 else if (wturn6.gt.0.0d0
6601 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6602 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6603 eturn6=eturn6+eello_turn6(i,jj,kk)
6604 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6605 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6606 cd write (2,*) 'multibody_eello:eturn6',eturn6
6615 num_cont_hb(i)=num_cont_hb_old(i)
6617 c write (iout,*) "gradcorr5 in eello5"
6619 c write (iout,'(i5,3f10.5)')
6620 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6624 c------------------------------------------------------------------------------
6625 subroutine add_hb_contact_eello(ii,jj,itask)
6626 implicit real*8 (a-h,o-z)
6627 include "DIMENSIONS"
6628 include "COMMON.IOUNITS"
6631 parameter (max_cont=maxconts)
6632 parameter (max_dim=70)
6633 include "COMMON.CONTACTS"
6634 double precision zapas(max_dim,maxconts,max_fg_procs),
6635 & zapas_recv(max_dim,maxconts,max_fg_procs)
6636 common /przechowalnia/ zapas
6637 integer i,j,ii,jj,iproc,itask(4),nn
6638 c write (iout,*) "itask",itask
6641 if (iproc.gt.0) then
6642 do j=1,num_cont_hb(ii)
6644 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6646 ncont_sent(iproc)=ncont_sent(iproc)+1
6647 nn=ncont_sent(iproc)
6648 zapas(1,nn,iproc)=ii
6649 zapas(2,nn,iproc)=jjc
6650 zapas(3,nn,iproc)=d_cont(j,ii)
6654 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6659 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6667 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6679 c------------------------------------------------------------------------------
6680 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6681 implicit real*8 (a-h,o-z)
6682 include 'DIMENSIONS'
6683 include 'COMMON.IOUNITS'
6684 include 'COMMON.DERIV'
6685 include 'COMMON.INTERACT'
6686 include 'COMMON.CONTACTS'
6687 double precision gx(3),gx1(3)
6697 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6698 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6699 C Following 4 lines for diagnostics.
6704 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6705 c & 'Contacts ',i,j,
6706 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6707 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6709 C Calculate the multi-body contribution to energy.
6710 c ecorr=ecorr+ekont*ees
6711 C Calculate multi-body contributions to the gradient.
6712 coeffpees0pij=coeffp*ees0pij
6713 coeffmees0mij=coeffm*ees0mij
6714 coeffpees0pkl=coeffp*ees0pkl
6715 coeffmees0mkl=coeffm*ees0mkl
6717 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6718 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6719 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6720 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6721 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6722 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6723 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6724 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6725 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6726 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6727 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6728 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6729 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6730 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6731 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6732 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6733 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6734 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6735 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6736 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6737 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6738 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6739 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6740 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6741 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6746 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6747 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6748 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6749 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6754 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6755 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6756 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6757 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6760 c write (iout,*) "ehbcorr",ekont*ees
6765 C---------------------------------------------------------------------------
6766 subroutine dipole(i,j,jj)
6767 implicit real*8 (a-h,o-z)
6768 include 'DIMENSIONS'
6769 include 'COMMON.IOUNITS'
6770 include 'COMMON.CHAIN'
6771 include 'COMMON.FFIELD'
6772 include 'COMMON.DERIV'
6773 include 'COMMON.INTERACT'
6774 include 'COMMON.CONTACTS'
6775 include 'COMMON.TORSION'
6776 include 'COMMON.VAR'
6777 include 'COMMON.GEO'
6778 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6780 iti1 = itortyp(itype(i+1))
6781 if (j.lt.nres-1) then
6782 itj1 = itortyp(itype(j+1))
6787 dipi(iii,1)=Ub2(iii,i)
6788 dipderi(iii)=Ub2der(iii,i)
6789 dipi(iii,2)=b1(iii,iti1)
6790 dipj(iii,1)=Ub2(iii,j)
6791 dipderj(iii)=Ub2der(iii,j)
6792 dipj(iii,2)=b1(iii,itj1)
6796 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6799 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6806 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6810 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6815 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6816 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6818 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6820 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6822 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6827 C---------------------------------------------------------------------------
6828 subroutine calc_eello(i,j,k,l,jj,kk)
6830 C This subroutine computes matrices and vectors needed to calculate
6831 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6833 implicit real*8 (a-h,o-z)
6834 include 'DIMENSIONS'
6835 include 'COMMON.IOUNITS'
6836 include 'COMMON.CHAIN'
6837 include 'COMMON.DERIV'
6838 include 'COMMON.INTERACT'
6839 include 'COMMON.CONTACTS'
6840 include 'COMMON.TORSION'
6841 include 'COMMON.VAR'
6842 include 'COMMON.GEO'
6843 include 'COMMON.FFIELD'
6844 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6845 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6848 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6849 cd & ' jj=',jj,' kk=',kk
6850 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6851 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6852 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6855 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6856 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6859 call transpose2(aa1(1,1),aa1t(1,1))
6860 call transpose2(aa2(1,1),aa2t(1,1))
6863 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6864 & aa1tder(1,1,lll,kkk))
6865 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6866 & aa2tder(1,1,lll,kkk))
6870 C parallel orientation of the two CA-CA-CA frames.
6872 iti=itortyp(itype(i))
6876 itk1=itortyp(itype(k+1))
6877 itj=itortyp(itype(j))
6878 if (l.lt.nres-1) then
6879 itl1=itortyp(itype(l+1))
6883 C A1 kernel(j+1) A2T
6885 cd write (iout,'(3f10.5,5x,3f10.5)')
6886 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6888 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6889 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6890 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6891 C Following matrices are needed only for 6-th order cumulants
6892 IF (wcorr6.gt.0.0d0) THEN
6893 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6894 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6895 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6896 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6897 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6898 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6899 & ADtEAderx(1,1,1,1,1,1))
6901 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6902 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6903 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6904 & ADtEA1derx(1,1,1,1,1,1))
6906 C End 6-th order cumulants
6909 cd write (2,*) 'In calc_eello6'
6911 cd write (2,*) 'iii=',iii
6913 cd write (2,*) 'kkk=',kkk
6915 cd write (2,'(3(2f10.5),5x)')
6916 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6921 call transpose2(EUgder(1,1,k),auxmat(1,1))
6922 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6923 call transpose2(EUg(1,1,k),auxmat(1,1))
6924 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6925 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6929 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6930 & EAEAderx(1,1,lll,kkk,iii,1))
6934 C A1T kernel(i+1) A2
6935 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6936 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6937 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6938 C Following matrices are needed only for 6-th order cumulants
6939 IF (wcorr6.gt.0.0d0) THEN
6940 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6941 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6942 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6943 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6944 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6945 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6946 & ADtEAderx(1,1,1,1,1,2))
6947 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6948 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6949 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6950 & ADtEA1derx(1,1,1,1,1,2))
6952 C End 6-th order cumulants
6953 call transpose2(EUgder(1,1,l),auxmat(1,1))
6954 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6955 call transpose2(EUg(1,1,l),auxmat(1,1))
6956 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6957 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6961 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6962 & EAEAderx(1,1,lll,kkk,iii,2))
6967 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6968 C They are needed only when the fifth- or the sixth-order cumulants are
6970 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6971 call transpose2(AEA(1,1,1),auxmat(1,1))
6972 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6973 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6974 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6975 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6976 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6977 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6978 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6979 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6980 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6981 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6982 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6983 call transpose2(AEA(1,1,2),auxmat(1,1))
6984 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6985 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6986 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6987 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6988 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6989 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6990 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6991 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6992 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6993 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6994 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6995 C Calculate the Cartesian derivatives of the vectors.
6999 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7000 call matvec2(auxmat(1,1),b1(1,iti),
7001 & AEAb1derx(1,lll,kkk,iii,1,1))
7002 call matvec2(auxmat(1,1),Ub2(1,i),
7003 & AEAb2derx(1,lll,kkk,iii,1,1))
7004 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7005 & AEAb1derx(1,lll,kkk,iii,2,1))
7006 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7007 & AEAb2derx(1,lll,kkk,iii,2,1))
7008 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7009 call matvec2(auxmat(1,1),b1(1,itj),
7010 & AEAb1derx(1,lll,kkk,iii,1,2))
7011 call matvec2(auxmat(1,1),Ub2(1,j),
7012 & AEAb2derx(1,lll,kkk,iii,1,2))
7013 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7014 & AEAb1derx(1,lll,kkk,iii,2,2))
7015 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7016 & AEAb2derx(1,lll,kkk,iii,2,2))
7023 C Antiparallel orientation of the two CA-CA-CA frames.
7025 iti=itortyp(itype(i))
7029 itk1=itortyp(itype(k+1))
7030 itl=itortyp(itype(l))
7031 itj=itortyp(itype(j))
7032 if (j.lt.nres-1) then
7033 itj1=itortyp(itype(j+1))
7037 C A2 kernel(j-1)T A1T
7038 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7039 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7040 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7041 C Following matrices are needed only for 6-th order cumulants
7042 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7043 & j.eq.i+4 .and. l.eq.i+3)) THEN
7044 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7045 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7046 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7047 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7048 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7049 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7050 & ADtEAderx(1,1,1,1,1,1))
7051 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7052 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7053 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7054 & ADtEA1derx(1,1,1,1,1,1))
7056 C End 6-th order cumulants
7057 call transpose2(EUgder(1,1,k),auxmat(1,1))
7058 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7059 call transpose2(EUg(1,1,k),auxmat(1,1))
7060 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7061 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7065 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7066 & EAEAderx(1,1,lll,kkk,iii,1))
7070 C A2T kernel(i+1)T A1
7071 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7072 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7073 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7074 C Following matrices are needed only for 6-th order cumulants
7075 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7076 & j.eq.i+4 .and. l.eq.i+3)) THEN
7077 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7078 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7079 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7080 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7081 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7082 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7083 & ADtEAderx(1,1,1,1,1,2))
7084 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7085 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7086 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7087 & ADtEA1derx(1,1,1,1,1,2))
7089 C End 6-th order cumulants
7090 call transpose2(EUgder(1,1,j),auxmat(1,1))
7091 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7092 call transpose2(EUg(1,1,j),auxmat(1,1))
7093 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7094 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7098 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7099 & EAEAderx(1,1,lll,kkk,iii,2))
7104 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7105 C They are needed only when the fifth- or the sixth-order cumulants are
7107 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7108 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7109 call transpose2(AEA(1,1,1),auxmat(1,1))
7110 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7111 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7112 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7113 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7114 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7115 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7116 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7117 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7118 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7119 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7120 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7121 call transpose2(AEA(1,1,2),auxmat(1,1))
7122 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7123 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7124 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7125 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7126 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7127 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7128 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7129 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7130 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7131 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7132 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7133 C Calculate the Cartesian derivatives of the vectors.
7137 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7138 call matvec2(auxmat(1,1),b1(1,iti),
7139 & AEAb1derx(1,lll,kkk,iii,1,1))
7140 call matvec2(auxmat(1,1),Ub2(1,i),
7141 & AEAb2derx(1,lll,kkk,iii,1,1))
7142 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7143 & AEAb1derx(1,lll,kkk,iii,2,1))
7144 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7145 & AEAb2derx(1,lll,kkk,iii,2,1))
7146 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7147 call matvec2(auxmat(1,1),b1(1,itl),
7148 & AEAb1derx(1,lll,kkk,iii,1,2))
7149 call matvec2(auxmat(1,1),Ub2(1,l),
7150 & AEAb2derx(1,lll,kkk,iii,1,2))
7151 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7152 & AEAb1derx(1,lll,kkk,iii,2,2))
7153 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7154 & AEAb2derx(1,lll,kkk,iii,2,2))
7163 C---------------------------------------------------------------------------
7164 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7165 & KK,KKderg,AKA,AKAderg,AKAderx)
7169 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7170 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7171 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7176 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7178 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7181 cd if (lprn) write (2,*) 'In kernel'
7183 cd if (lprn) write (2,*) 'kkk=',kkk
7185 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7186 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7188 cd write (2,*) 'lll=',lll
7189 cd write (2,*) 'iii=1'
7191 cd write (2,'(3(2f10.5),5x)')
7192 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7195 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7196 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7198 cd write (2,*) 'lll=',lll
7199 cd write (2,*) 'iii=2'
7201 cd write (2,'(3(2f10.5),5x)')
7202 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7209 C---------------------------------------------------------------------------
7210 double precision function eello4(i,j,k,l,jj,kk)
7211 implicit real*8 (a-h,o-z)
7212 include 'DIMENSIONS'
7213 include 'COMMON.IOUNITS'
7214 include 'COMMON.CHAIN'
7215 include 'COMMON.DERIV'
7216 include 'COMMON.INTERACT'
7217 include 'COMMON.CONTACTS'
7218 include 'COMMON.TORSION'
7219 include 'COMMON.VAR'
7220 include 'COMMON.GEO'
7221 double precision pizda(2,2),ggg1(3),ggg2(3)
7222 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7226 cd print *,'eello4:',i,j,k,l,jj,kk
7227 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7228 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7229 cold eij=facont_hb(jj,i)
7230 cold ekl=facont_hb(kk,k)
7232 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7233 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7234 gcorr_loc(k-1)=gcorr_loc(k-1)
7235 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7237 gcorr_loc(l-1)=gcorr_loc(l-1)
7238 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7240 gcorr_loc(j-1)=gcorr_loc(j-1)
7241 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7246 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7247 & -EAEAderx(2,2,lll,kkk,iii,1)
7248 cd derx(lll,kkk,iii)=0.0d0
7252 cd gcorr_loc(l-1)=0.0d0
7253 cd gcorr_loc(j-1)=0.0d0
7254 cd gcorr_loc(k-1)=0.0d0
7256 cd write (iout,*)'Contacts have occurred for peptide groups',
7257 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7258 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7259 if (j.lt.nres-1) then
7266 if (l.lt.nres-1) then
7274 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7275 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7276 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7277 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7278 cgrad ghalf=0.5d0*ggg1(ll)
7279 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7280 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7281 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7282 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7283 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7284 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7285 cgrad ghalf=0.5d0*ggg2(ll)
7286 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7287 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7288 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7289 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7290 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7291 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7295 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7300 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7305 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7310 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7314 cd write (2,*) iii,gcorr_loc(iii)
7317 cd write (2,*) 'ekont',ekont
7318 cd write (iout,*) 'eello4',ekont*eel4
7321 C---------------------------------------------------------------------------
7322 double precision function eello5(i,j,k,l,jj,kk)
7323 implicit real*8 (a-h,o-z)
7324 include 'DIMENSIONS'
7325 include 'COMMON.IOUNITS'
7326 include 'COMMON.CHAIN'
7327 include 'COMMON.DERIV'
7328 include 'COMMON.INTERACT'
7329 include 'COMMON.CONTACTS'
7330 include 'COMMON.TORSION'
7331 include 'COMMON.VAR'
7332 include 'COMMON.GEO'
7333 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7334 double precision ggg1(3),ggg2(3)
7335 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7340 C /l\ / \ \ / \ / \ / C
7341 C / \ / \ \ / \ / \ / C
7342 C j| o |l1 | o | o| o | | o |o C
7343 C \ |/k\| |/ \| / |/ \| |/ \| C
7344 C \i/ \ / \ / / \ / \ C
7346 C (I) (II) (III) (IV) C
7348 C eello5_1 eello5_2 eello5_3 eello5_4 C
7350 C Antiparallel chains C
7353 C /j\ / \ \ / \ / \ / C
7354 C / \ / \ \ / \ / \ / C
7355 C j1| o |l | 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 o denotes a local interaction, vertical lines an electrostatic interaction. C
7365 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7366 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7371 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7373 itk=itortyp(itype(k))
7374 itl=itortyp(itype(l))
7375 itj=itortyp(itype(j))
7380 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7381 cd & eel5_3_num,eel5_4_num)
7385 derx(lll,kkk,iii)=0.0d0
7389 cd eij=facont_hb(jj,i)
7390 cd ekl=facont_hb(kk,k)
7392 cd write (iout,*)'Contacts have occurred for peptide groups',
7393 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7395 C Contribution from the graph I.
7396 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7397 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7398 call transpose2(EUg(1,1,k),auxmat(1,1))
7399 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7400 vv(1)=pizda(1,1)-pizda(2,2)
7401 vv(2)=pizda(1,2)+pizda(2,1)
7402 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7403 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7404 C Explicit gradient in virtual-dihedral angles.
7405 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7406 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7407 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7408 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7409 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7410 vv(1)=pizda(1,1)-pizda(2,2)
7411 vv(2)=pizda(1,2)+pizda(2,1)
7412 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7413 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7414 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7415 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7416 vv(1)=pizda(1,1)-pizda(2,2)
7417 vv(2)=pizda(1,2)+pizda(2,1)
7419 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7420 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7421 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7423 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7424 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7425 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7427 C Cartesian gradient
7431 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7433 vv(1)=pizda(1,1)-pizda(2,2)
7434 vv(2)=pizda(1,2)+pizda(2,1)
7435 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7436 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7437 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7443 C Contribution from graph II
7444 call transpose2(EE(1,1,itk),auxmat(1,1))
7445 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7446 vv(1)=pizda(1,1)+pizda(2,2)
7447 vv(2)=pizda(2,1)-pizda(1,2)
7448 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7449 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7450 C Explicit gradient in virtual-dihedral angles.
7451 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7452 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7453 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7454 vv(1)=pizda(1,1)+pizda(2,2)
7455 vv(2)=pizda(2,1)-pizda(1,2)
7457 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7458 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7459 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7461 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7462 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7463 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7465 C Cartesian gradient
7469 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7471 vv(1)=pizda(1,1)+pizda(2,2)
7472 vv(2)=pizda(2,1)-pizda(1,2)
7473 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7474 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7475 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7483 C Parallel orientation
7484 C Contribution from graph III
7485 call transpose2(EUg(1,1,l),auxmat(1,1))
7486 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7487 vv(1)=pizda(1,1)-pizda(2,2)
7488 vv(2)=pizda(1,2)+pizda(2,1)
7489 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7490 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7491 C Explicit gradient in virtual-dihedral angles.
7492 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7493 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7494 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7495 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7496 vv(1)=pizda(1,1)-pizda(2,2)
7497 vv(2)=pizda(1,2)+pizda(2,1)
7498 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7499 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7500 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7501 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7502 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7503 vv(1)=pizda(1,1)-pizda(2,2)
7504 vv(2)=pizda(1,2)+pizda(2,1)
7505 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7506 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7507 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7508 C Cartesian gradient
7512 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7514 vv(1)=pizda(1,1)-pizda(2,2)
7515 vv(2)=pizda(1,2)+pizda(2,1)
7516 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7517 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7518 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7523 C Contribution from graph IV
7525 call transpose2(EE(1,1,itl),auxmat(1,1))
7526 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7527 vv(1)=pizda(1,1)+pizda(2,2)
7528 vv(2)=pizda(2,1)-pizda(1,2)
7529 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7530 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7531 C Explicit gradient in virtual-dihedral angles.
7532 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7533 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7534 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7535 vv(1)=pizda(1,1)+pizda(2,2)
7536 vv(2)=pizda(2,1)-pizda(1,2)
7537 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7538 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7539 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7540 C Cartesian gradient
7544 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7546 vv(1)=pizda(1,1)+pizda(2,2)
7547 vv(2)=pizda(2,1)-pizda(1,2)
7548 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7549 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7550 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7555 C Antiparallel orientation
7556 C Contribution from graph III
7558 call transpose2(EUg(1,1,j),auxmat(1,1))
7559 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7560 vv(1)=pizda(1,1)-pizda(2,2)
7561 vv(2)=pizda(1,2)+pizda(2,1)
7562 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7563 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7564 C Explicit gradient in virtual-dihedral angles.
7565 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7566 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7567 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7568 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7569 vv(1)=pizda(1,1)-pizda(2,2)
7570 vv(2)=pizda(1,2)+pizda(2,1)
7571 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7572 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7573 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7574 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7575 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7576 vv(1)=pizda(1,1)-pizda(2,2)
7577 vv(2)=pizda(1,2)+pizda(2,1)
7578 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7579 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7580 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7581 C Cartesian gradient
7585 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7587 vv(1)=pizda(1,1)-pizda(2,2)
7588 vv(2)=pizda(1,2)+pizda(2,1)
7589 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7590 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7591 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7596 C Contribution from graph IV
7598 call transpose2(EE(1,1,itj),auxmat(1,1))
7599 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7600 vv(1)=pizda(1,1)+pizda(2,2)
7601 vv(2)=pizda(2,1)-pizda(1,2)
7602 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7603 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7604 C Explicit gradient in virtual-dihedral angles.
7605 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7606 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7607 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7608 vv(1)=pizda(1,1)+pizda(2,2)
7609 vv(2)=pizda(2,1)-pizda(1,2)
7610 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7611 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7612 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7613 C Cartesian gradient
7617 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7619 vv(1)=pizda(1,1)+pizda(2,2)
7620 vv(2)=pizda(2,1)-pizda(1,2)
7621 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7622 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7623 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7629 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7630 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7631 cd write (2,*) 'ijkl',i,j,k,l
7632 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7633 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7635 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7636 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7637 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7638 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7639 if (j.lt.nres-1) then
7646 if (l.lt.nres-1) then
7656 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7657 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7658 C summed up outside the subrouine as for the other subroutines
7659 C handling long-range interactions. The old code is commented out
7660 C with "cgrad" to keep track of changes.
7662 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7663 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7664 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7665 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7666 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7667 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7668 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7669 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7670 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7671 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7673 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7674 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7675 cgrad ghalf=0.5d0*ggg1(ll)
7677 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7678 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7679 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7680 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7681 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7682 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7683 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7684 cgrad ghalf=0.5d0*ggg2(ll)
7686 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7687 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7688 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7689 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7690 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7691 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7696 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7697 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7702 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7703 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7709 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7714 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7718 cd write (2,*) iii,g_corr5_loc(iii)
7721 cd write (2,*) 'ekont',ekont
7722 cd write (iout,*) 'eello5',ekont*eel5
7725 c--------------------------------------------------------------------------
7726 double precision function eello6(i,j,k,l,jj,kk)
7727 implicit real*8 (a-h,o-z)
7728 include 'DIMENSIONS'
7729 include 'COMMON.IOUNITS'
7730 include 'COMMON.CHAIN'
7731 include 'COMMON.DERIV'
7732 include 'COMMON.INTERACT'
7733 include 'COMMON.CONTACTS'
7734 include 'COMMON.TORSION'
7735 include 'COMMON.VAR'
7736 include 'COMMON.GEO'
7737 include 'COMMON.FFIELD'
7738 double precision ggg1(3),ggg2(3)
7739 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7744 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7752 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7753 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7757 derx(lll,kkk,iii)=0.0d0
7761 cd eij=facont_hb(jj,i)
7762 cd ekl=facont_hb(kk,k)
7768 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7769 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7770 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7771 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7772 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7773 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7775 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7776 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7777 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7778 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7779 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7780 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7784 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7786 C If turn contributions are considered, they will be handled separately.
7787 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7788 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7789 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7790 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7791 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7792 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7793 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7795 if (j.lt.nres-1) then
7802 if (l.lt.nres-1) then
7810 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7811 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7812 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7813 cgrad ghalf=0.5d0*ggg1(ll)
7815 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7816 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7817 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7818 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7819 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7820 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7821 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7822 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7823 cgrad ghalf=0.5d0*ggg2(ll)
7824 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7826 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7827 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7828 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7829 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7830 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7831 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7836 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7837 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7842 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7843 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7849 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7854 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7858 cd write (2,*) iii,g_corr6_loc(iii)
7861 cd write (2,*) 'ekont',ekont
7862 cd write (iout,*) 'eello6',ekont*eel6
7865 c--------------------------------------------------------------------------
7866 double precision function eello6_graph1(i,j,k,l,imat,swap)
7867 implicit real*8 (a-h,o-z)
7868 include 'DIMENSIONS'
7869 include 'COMMON.IOUNITS'
7870 include 'COMMON.CHAIN'
7871 include 'COMMON.DERIV'
7872 include 'COMMON.INTERACT'
7873 include 'COMMON.CONTACTS'
7874 include 'COMMON.TORSION'
7875 include 'COMMON.VAR'
7876 include 'COMMON.GEO'
7877 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7881 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7883 C Parallel Antiparallel C
7889 C \ j|/k\| / \ |/k\|l / C
7894 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7895 itk=itortyp(itype(k))
7896 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7897 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7898 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7899 call transpose2(EUgC(1,1,k),auxmat(1,1))
7900 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7901 vv1(1)=pizda1(1,1)-pizda1(2,2)
7902 vv1(2)=pizda1(1,2)+pizda1(2,1)
7903 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7904 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7905 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7906 s5=scalar2(vv(1),Dtobr2(1,i))
7907 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7908 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7909 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7910 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7911 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7912 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7913 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7914 & +scalar2(vv(1),Dtobr2der(1,i)))
7915 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7916 vv1(1)=pizda1(1,1)-pizda1(2,2)
7917 vv1(2)=pizda1(1,2)+pizda1(2,1)
7918 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7919 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7921 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7922 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7923 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7924 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7925 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7927 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7928 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7929 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7930 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7931 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7933 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7934 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7935 vv1(1)=pizda1(1,1)-pizda1(2,2)
7936 vv1(2)=pizda1(1,2)+pizda1(2,1)
7937 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7938 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7939 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7940 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7949 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7950 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7951 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7952 call transpose2(EUgC(1,1,k),auxmat(1,1))
7953 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7955 vv1(1)=pizda1(1,1)-pizda1(2,2)
7956 vv1(2)=pizda1(1,2)+pizda1(2,1)
7957 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7958 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7959 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7960 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7961 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7962 s5=scalar2(vv(1),Dtobr2(1,i))
7963 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7969 c----------------------------------------------------------------------------
7970 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7971 implicit real*8 (a-h,o-z)
7972 include 'DIMENSIONS'
7973 include 'COMMON.IOUNITS'
7974 include 'COMMON.CHAIN'
7975 include 'COMMON.DERIV'
7976 include 'COMMON.INTERACT'
7977 include 'COMMON.CONTACTS'
7978 include 'COMMON.TORSION'
7979 include 'COMMON.VAR'
7980 include 'COMMON.GEO'
7982 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7983 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7986 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7988 C Parallel Antiparallel C
7994 C \ j|/k\| \ |/k\|l C
7999 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8000 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8001 C AL 7/4/01 s1 would occur in the sixth-order moment,
8002 C but not in a cluster cumulant
8004 s1=dip(1,jj,i)*dip(1,kk,k)
8006 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8007 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8008 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8009 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8010 call transpose2(EUg(1,1,k),auxmat(1,1))
8011 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8012 vv(1)=pizda(1,1)-pizda(2,2)
8013 vv(2)=pizda(1,2)+pizda(2,1)
8014 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8015 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8017 eello6_graph2=-(s1+s2+s3+s4)
8019 eello6_graph2=-(s2+s3+s4)
8022 C Derivatives in gamma(i-1)
8025 s1=dipderg(1,jj,i)*dip(1,kk,k)
8027 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8028 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8029 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8030 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8032 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8034 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8036 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8038 C Derivatives in gamma(k-1)
8040 s1=dip(1,jj,i)*dipderg(1,kk,k)
8042 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8043 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8044 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8045 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8046 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8047 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8048 vv(1)=pizda(1,1)-pizda(2,2)
8049 vv(2)=pizda(1,2)+pizda(2,1)
8050 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8052 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8054 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8056 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8057 C Derivatives in gamma(j-1) or gamma(l-1)
8060 s1=dipderg(3,jj,i)*dip(1,kk,k)
8062 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8063 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8064 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8065 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8066 vv(1)=pizda(1,1)-pizda(2,2)
8067 vv(2)=pizda(1,2)+pizda(2,1)
8068 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8071 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8073 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8076 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8077 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8079 C Derivatives in gamma(l-1) or gamma(j-1)
8082 s1=dip(1,jj,i)*dipderg(3,kk,k)
8084 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8085 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8086 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8087 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8088 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8089 vv(1)=pizda(1,1)-pizda(2,2)
8090 vv(2)=pizda(1,2)+pizda(2,1)
8091 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8094 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8096 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8099 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8100 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8102 C Cartesian derivatives.
8104 write (2,*) 'In eello6_graph2'
8106 write (2,*) 'iii=',iii
8108 write (2,*) 'kkk=',kkk
8110 write (2,'(3(2f10.5),5x)')
8111 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8121 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8123 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8126 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8128 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8129 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8131 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8132 call transpose2(EUg(1,1,k),auxmat(1,1))
8133 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8135 vv(1)=pizda(1,1)-pizda(2,2)
8136 vv(2)=pizda(1,2)+pizda(2,1)
8137 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8138 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8140 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8142 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8145 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8147 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8154 c----------------------------------------------------------------------------
8155 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8156 implicit real*8 (a-h,o-z)
8157 include 'DIMENSIONS'
8158 include 'COMMON.IOUNITS'
8159 include 'COMMON.CHAIN'
8160 include 'COMMON.DERIV'
8161 include 'COMMON.INTERACT'
8162 include 'COMMON.CONTACTS'
8163 include 'COMMON.TORSION'
8164 include 'COMMON.VAR'
8165 include 'COMMON.GEO'
8166 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8168 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8170 C Parallel Antiparallel C
8176 C j|/k\| / |/k\|l / C
8181 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8183 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8184 C energy moment and not to the cluster cumulant.
8185 iti=itortyp(itype(i))
8186 if (j.lt.nres-1) then
8187 itj1=itortyp(itype(j+1))
8191 itk=itortyp(itype(k))
8192 itk1=itortyp(itype(k+1))
8193 if (l.lt.nres-1) then
8194 itl1=itortyp(itype(l+1))
8199 s1=dip(4,jj,i)*dip(4,kk,k)
8201 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8202 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8203 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8204 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8205 call transpose2(EE(1,1,itk),auxmat(1,1))
8206 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8207 vv(1)=pizda(1,1)+pizda(2,2)
8208 vv(2)=pizda(2,1)-pizda(1,2)
8209 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8210 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8211 cd & "sum",-(s2+s3+s4)
8213 eello6_graph3=-(s1+s2+s3+s4)
8215 eello6_graph3=-(s2+s3+s4)
8218 C Derivatives in gamma(k-1)
8219 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8220 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8221 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8222 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8223 C Derivatives in gamma(l-1)
8224 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8225 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8226 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8227 vv(1)=pizda(1,1)+pizda(2,2)
8228 vv(2)=pizda(2,1)-pizda(1,2)
8229 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8230 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8231 C Cartesian derivatives.
8237 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8239 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8242 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8244 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8245 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8247 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8248 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8250 vv(1)=pizda(1,1)+pizda(2,2)
8251 vv(2)=pizda(2,1)-pizda(1,2)
8252 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8254 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8256 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8259 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8261 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8263 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8269 c----------------------------------------------------------------------------
8270 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8271 implicit real*8 (a-h,o-z)
8272 include 'DIMENSIONS'
8273 include 'COMMON.IOUNITS'
8274 include 'COMMON.CHAIN'
8275 include 'COMMON.DERIV'
8276 include 'COMMON.INTERACT'
8277 include 'COMMON.CONTACTS'
8278 include 'COMMON.TORSION'
8279 include 'COMMON.VAR'
8280 include 'COMMON.GEO'
8281 include 'COMMON.FFIELD'
8282 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8283 & auxvec1(2),auxmat1(2,2)
8285 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8287 C Parallel Antiparallel C
8293 C \ j|/k\| \ |/k\|l C
8298 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8300 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8301 C energy moment and not to the cluster cumulant.
8302 cd write (2,*) 'eello_graph4: wturn6',wturn6
8303 iti=itortyp(itype(i))
8304 itj=itortyp(itype(j))
8305 if (j.lt.nres-1) then
8306 itj1=itortyp(itype(j+1))
8310 itk=itortyp(itype(k))
8311 if (k.lt.nres-1) then
8312 itk1=itortyp(itype(k+1))
8316 itl=itortyp(itype(l))
8317 if (l.lt.nres-1) then
8318 itl1=itortyp(itype(l+1))
8322 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8323 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8324 cd & ' itl',itl,' itl1',itl1
8327 s1=dip(3,jj,i)*dip(3,kk,k)
8329 s1=dip(2,jj,j)*dip(2,kk,l)
8332 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8333 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8335 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8336 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8338 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8339 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8341 call transpose2(EUg(1,1,k),auxmat(1,1))
8342 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8343 vv(1)=pizda(1,1)-pizda(2,2)
8344 vv(2)=pizda(2,1)+pizda(1,2)
8345 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8346 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8348 eello6_graph4=-(s1+s2+s3+s4)
8350 eello6_graph4=-(s2+s3+s4)
8352 C Derivatives in gamma(i-1)
8356 s1=dipderg(2,jj,i)*dip(3,kk,k)
8358 s1=dipderg(4,jj,j)*dip(2,kk,l)
8361 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8363 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8364 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8366 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8367 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8369 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8370 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8371 cd write (2,*) 'turn6 derivatives'
8373 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8375 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8379 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8381 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8385 C Derivatives in gamma(k-1)
8388 s1=dip(3,jj,i)*dipderg(2,kk,k)
8390 s1=dip(2,jj,j)*dipderg(4,kk,l)
8393 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8394 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8396 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8397 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8399 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8400 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8402 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8403 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8404 vv(1)=pizda(1,1)-pizda(2,2)
8405 vv(2)=pizda(2,1)+pizda(1,2)
8406 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8407 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8409 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8411 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8415 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8417 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8420 C Derivatives in gamma(j-1) or gamma(l-1)
8421 if (l.eq.j+1 .and. l.gt.1) then
8422 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8423 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8424 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8425 vv(1)=pizda(1,1)-pizda(2,2)
8426 vv(2)=pizda(2,1)+pizda(1,2)
8427 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8428 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8429 else if (j.gt.1) then
8430 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8431 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8432 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8433 vv(1)=pizda(1,1)-pizda(2,2)
8434 vv(2)=pizda(2,1)+pizda(1,2)
8435 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8436 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8437 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8439 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8442 C Cartesian derivatives.
8449 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8451 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8455 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8457 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8461 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8463 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8465 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8466 & b1(1,itj1),auxvec(1))
8467 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8469 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8470 & b1(1,itl1),auxvec(1))
8471 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8473 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8475 vv(1)=pizda(1,1)-pizda(2,2)
8476 vv(2)=pizda(2,1)+pizda(1,2)
8477 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8479 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8481 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8484 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8487 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8490 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8492 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8494 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8498 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8500 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8503 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8505 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8513 c----------------------------------------------------------------------------
8514 double precision function eello_turn6(i,jj,kk)
8515 implicit real*8 (a-h,o-z)
8516 include 'DIMENSIONS'
8517 include 'COMMON.IOUNITS'
8518 include 'COMMON.CHAIN'
8519 include 'COMMON.DERIV'
8520 include 'COMMON.INTERACT'
8521 include 'COMMON.CONTACTS'
8522 include 'COMMON.TORSION'
8523 include 'COMMON.VAR'
8524 include 'COMMON.GEO'
8525 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8526 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8528 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8529 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8530 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8531 C the respective energy moment and not to the cluster cumulant.
8540 iti=itortyp(itype(i))
8541 itk=itortyp(itype(k))
8542 itk1=itortyp(itype(k+1))
8543 itl=itortyp(itype(l))
8544 itj=itortyp(itype(j))
8545 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8546 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8547 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8552 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8554 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8558 derx_turn(lll,kkk,iii)=0.0d0
8565 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8567 cd write (2,*) 'eello6_5',eello6_5
8569 call transpose2(AEA(1,1,1),auxmat(1,1))
8570 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8571 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8572 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8574 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8575 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8576 s2 = scalar2(b1(1,itk),vtemp1(1))
8578 call transpose2(AEA(1,1,2),atemp(1,1))
8579 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8580 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8581 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8583 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8584 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8585 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8587 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8588 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8589 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8590 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8591 ss13 = scalar2(b1(1,itk),vtemp4(1))
8592 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8594 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8600 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8601 C Derivatives in gamma(i+2)
8605 call transpose2(AEA(1,1,1),auxmatd(1,1))
8606 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8607 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8608 call transpose2(AEAderg(1,1,2),atempd(1,1))
8609 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8610 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8612 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8613 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8614 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8620 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8621 C Derivatives in gamma(i+3)
8623 call transpose2(AEA(1,1,1),auxmatd(1,1))
8624 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8625 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8626 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8628 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8629 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8630 s2d = scalar2(b1(1,itk),vtemp1d(1))
8632 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8633 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8635 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8637 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8638 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8639 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8647 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8648 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8650 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8651 & -0.5d0*ekont*(s2d+s12d)
8653 C Derivatives in gamma(i+4)
8654 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8655 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8656 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8658 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8659 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8660 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8668 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8670 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8672 C Derivatives in gamma(i+5)
8674 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8675 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8676 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8678 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8679 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8680 s2d = scalar2(b1(1,itk),vtemp1d(1))
8682 call transpose2(AEA(1,1,2),atempd(1,1))
8683 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8684 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8686 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8687 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8689 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8690 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8691 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8699 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8700 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8702 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8703 & -0.5d0*ekont*(s2d+s12d)
8705 C Cartesian derivatives
8710 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8711 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8712 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8714 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8715 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8717 s2d = scalar2(b1(1,itk),vtemp1d(1))
8719 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8720 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8721 s8d = -(atempd(1,1)+atempd(2,2))*
8722 & scalar2(cc(1,1,itl),vtemp2(1))
8724 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8726 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8727 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8734 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8737 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8741 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8742 & - 0.5d0*(s8d+s12d)
8744 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8753 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8755 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8756 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8757 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8758 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8759 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8761 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8762 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8763 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8767 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8768 cd & 16*eel_turn6_num
8770 if (j.lt.nres-1) then
8777 if (l.lt.nres-1) then
8785 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8786 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8787 cgrad ghalf=0.5d0*ggg1(ll)
8789 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8790 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8791 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8792 & +ekont*derx_turn(ll,2,1)
8793 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8794 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8795 & +ekont*derx_turn(ll,4,1)
8796 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8797 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8798 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8799 cgrad ghalf=0.5d0*ggg2(ll)
8801 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8802 & +ekont*derx_turn(ll,2,2)
8803 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8804 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8805 & +ekont*derx_turn(ll,4,2)
8806 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8807 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8808 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8813 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8818 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8824 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8829 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8833 cd write (2,*) iii,g_corr6_loc(iii)
8835 eello_turn6=ekont*eel_turn6
8836 cd write (2,*) 'ekont',ekont
8837 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8841 C-----------------------------------------------------------------------------
8842 double precision function scalar(u,v)
8843 !DIR$ INLINEALWAYS scalar
8845 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8848 double precision u(3),v(3)
8849 cd double precision sc
8857 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8860 crc-------------------------------------------------
8861 SUBROUTINE MATVEC2(A1,V1,V2)
8862 !DIR$ INLINEALWAYS MATVEC2
8864 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8866 implicit real*8 (a-h,o-z)
8867 include 'DIMENSIONS'
8868 DIMENSION A1(2,2),V1(2),V2(2)
8872 c 3 VI=VI+A1(I,K)*V1(K)
8876 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8877 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8882 C---------------------------------------
8883 SUBROUTINE MATMAT2(A1,A2,A3)
8885 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8887 implicit real*8 (a-h,o-z)
8888 include 'DIMENSIONS'
8889 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8890 c DIMENSION AI3(2,2)
8894 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8900 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8901 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8902 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8903 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8911 c-------------------------------------------------------------------------
8912 double precision function scalar2(u,v)
8913 !DIR$ INLINEALWAYS scalar2
8915 double precision u(2),v(2)
8918 scalar2=u(1)*v(1)+u(2)*v(2)
8922 C-----------------------------------------------------------------------------
8924 subroutine transpose2(a,at)
8925 !DIR$ INLINEALWAYS transpose2
8927 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8930 double precision a(2,2),at(2,2)
8937 c--------------------------------------------------------------------------
8938 subroutine transpose(n,a,at)
8941 double precision a(n,n),at(n,n)
8949 C---------------------------------------------------------------------------
8950 subroutine prodmat3(a1,a2,kk,transp,prod)
8951 !DIR$ INLINEALWAYS prodmat3
8953 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8957 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8959 crc double precision auxmat(2,2),prod_(2,2)
8962 crc call transpose2(kk(1,1),auxmat(1,1))
8963 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8964 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8966 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8967 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8968 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8969 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8970 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8971 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8972 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8973 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8976 crc call matmat2(a1(1,1),kk(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(2,1))*a2(1,1)
8980 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8981 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8982 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8983 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8984 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8985 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8986 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8989 c call transpose2(a2(1,1),a2t(1,1))
8992 crc print *,((prod_(i,j),i=1,2),j=1,2)
8993 crc print *,((prod(i,j),i=1,2),j=1,2)