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) cycle
5564 itori=itortyp(itype(i-2))
5565 itori1=itortyp(itype(i-1))
5568 C Regular cosine and sine terms
5569 do j=1,nterm(itori,itori1)
5570 v1ij=v1(j,itori,itori1)
5571 v2ij=v2(j,itori,itori1)
5574 etors=etors+v1ij*cosphi+v2ij*sinphi
5575 if (energy_dec) etors_ii=etors_ii+
5576 & v1ij*cosphi+v2ij*sinphi
5577 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5581 C E = SUM ----------------------------------- - v1
5582 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5584 cosphi=dcos(0.5d0*phii)
5585 sinphi=dsin(0.5d0*phii)
5586 do j=1,nlor(itori,itori1)
5587 vl1ij=vlor1(j,itori,itori1)
5588 vl2ij=vlor2(j,itori,itori1)
5589 vl3ij=vlor3(j,itori,itori1)
5590 pom=vl2ij*cosphi+vl3ij*sinphi
5591 pom1=1.0d0/(pom*pom+1.0d0)
5592 etors=etors+vl1ij*pom1
5593 if (energy_dec) etors_ii=etors_ii+
5596 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5598 C Subtract the constant term
5599 etors=etors-v0(itori,itori1)
5600 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5601 & 'etor',i,etors_ii-v0(itori,itori1)
5603 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5604 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5605 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5606 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5607 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5609 ! 6/20/98 - dihedral angle constraints
5611 c do i=1,ndih_constr
5612 do i=idihconstr_start,idihconstr_end
5613 itori=idih_constr(i)
5615 difi=pinorm(phii-phi0(i))
5616 if (difi.gt.drange(i)) then
5618 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5619 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5620 else if (difi.lt.-drange(i)) then
5622 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5623 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5627 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5628 cd & rad2deg*phi0(i), rad2deg*drange(i),
5629 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5631 cd write (iout,*) 'edihcnstr',edihcnstr
5634 c----------------------------------------------------------------------------
5635 subroutine etor_d(etors_d)
5636 C 6/23/01 Compute double torsional energy
5637 implicit real*8 (a-h,o-z)
5638 include 'DIMENSIONS'
5639 include 'COMMON.VAR'
5640 include 'COMMON.GEO'
5641 include 'COMMON.LOCAL'
5642 include 'COMMON.TORSION'
5643 include 'COMMON.INTERACT'
5644 include 'COMMON.DERIV'
5645 include 'COMMON.CHAIN'
5646 include 'COMMON.NAMES'
5647 include 'COMMON.IOUNITS'
5648 include 'COMMON.FFIELD'
5649 include 'COMMON.TORCNSTR'
5651 C Set lprn=.true. for debugging
5655 C write(iout,*) "a tu??"
5656 do i=iphid_start,iphid_end
5657 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
5658 & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
5659 itori=itortyp(itype(i-2))
5660 itori1=itortyp(itype(i-1))
5661 itori2=itortyp(itype(i))
5666 C Regular cosine and sine terms
5667 do j=1,ntermd_1(itori,itori1,itori2)
5668 v1cij=v1c(1,j,itori,itori1,itori2)
5669 v1sij=v1s(1,j,itori,itori1,itori2)
5670 v2cij=v1c(2,j,itori,itori1,itori2)
5671 v2sij=v1s(2,j,itori,itori1,itori2)
5672 cosphi1=dcos(j*phii)
5673 sinphi1=dsin(j*phii)
5674 cosphi2=dcos(j*phii1)
5675 sinphi2=dsin(j*phii1)
5676 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5677 & v2cij*cosphi2+v2sij*sinphi2
5678 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5679 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5681 do k=2,ntermd_2(itori,itori1,itori2)
5683 v1cdij = v2c(k,l,itori,itori1,itori2)
5684 v2cdij = v2c(l,k,itori,itori1,itori2)
5685 v1sdij = v2s(k,l,itori,itori1,itori2)
5686 v2sdij = v2s(l,k,itori,itori1,itori2)
5687 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5688 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5689 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5690 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5691 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5692 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5693 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5694 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5695 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5696 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5699 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5700 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5705 c------------------------------------------------------------------------------
5706 subroutine eback_sc_corr(esccor)
5707 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5708 c conformational states; temporarily implemented as differences
5709 c between UNRES torsional potentials (dependent on three types of
5710 c residues) and the torsional potentials dependent on all 20 types
5711 c of residues computed from AM1 energy surfaces of terminally-blocked
5712 c amino-acid residues.
5713 implicit real*8 (a-h,o-z)
5714 include 'DIMENSIONS'
5715 include 'COMMON.VAR'
5716 include 'COMMON.GEO'
5717 include 'COMMON.LOCAL'
5718 include 'COMMON.TORSION'
5719 include 'COMMON.SCCOR'
5720 include 'COMMON.INTERACT'
5721 include 'COMMON.DERIV'
5722 include 'COMMON.CHAIN'
5723 include 'COMMON.NAMES'
5724 include 'COMMON.IOUNITS'
5725 include 'COMMON.FFIELD'
5726 include 'COMMON.CONTROL'
5728 C Set lprn=.true. for debugging
5731 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5733 do i=itau_start,itau_end
5734 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5736 isccori=isccortyp(itype(i-2))
5737 isccori1=isccortyp(itype(i-1))
5738 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5740 do intertyp=1,3 !intertyp
5741 cc Added 09 May 2012 (Adasko)
5742 cc Intertyp means interaction type of backbone mainchain correlation:
5743 c 1 = SC...Ca...Ca...Ca
5744 c 2 = Ca...Ca...Ca...SC
5745 c 3 = SC...Ca...Ca...SCi
5747 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5748 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5749 & (itype(i-1).eq.ntyp1)))
5750 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5751 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5752 & .or.(itype(i).eq.ntyp1)))
5753 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5754 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5755 & (itype(i-3).eq.ntyp1)))) cycle
5756 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5757 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5759 do j=1,nterm_sccor(isccori,isccori1)
5760 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5761 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5762 cosphi=dcos(j*tauangle(intertyp,i))
5763 sinphi=dsin(j*tauangle(intertyp,i))
5764 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5765 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5767 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5768 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5770 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5771 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5772 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5773 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5774 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5780 c----------------------------------------------------------------------------
5781 subroutine multibody(ecorr)
5782 C This subroutine calculates multi-body contributions to energy following
5783 C the idea of Skolnick et al. If side chains I and J make a contact and
5784 C at the same time side chains I+1 and J+1 make a contact, an extra
5785 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5786 implicit real*8 (a-h,o-z)
5787 include 'DIMENSIONS'
5788 include 'COMMON.IOUNITS'
5789 include 'COMMON.DERIV'
5790 include 'COMMON.INTERACT'
5791 include 'COMMON.CONTACTS'
5792 double precision gx(3),gx1(3)
5795 C Set lprn=.true. for debugging
5799 write (iout,'(a)') 'Contact function values:'
5801 write (iout,'(i2,20(1x,i2,f10.5))')
5802 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5817 num_conti=num_cont(i)
5818 num_conti1=num_cont(i1)
5823 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5824 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5825 cd & ' ishift=',ishift
5826 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5827 C The system gains extra energy.
5828 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5829 endif ! j1==j+-ishift
5838 c------------------------------------------------------------------------------
5839 double precision function esccorr(i,j,k,l,jj,kk)
5840 implicit real*8 (a-h,o-z)
5841 include 'DIMENSIONS'
5842 include 'COMMON.IOUNITS'
5843 include 'COMMON.DERIV'
5844 include 'COMMON.INTERACT'
5845 include 'COMMON.CONTACTS'
5846 double precision gx(3),gx1(3)
5851 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5852 C Calculate the multi-body contribution to energy.
5853 C Calculate multi-body contributions to the gradient.
5854 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5855 cd & k,l,(gacont(m,kk,k),m=1,3)
5857 gx(m) =ekl*gacont(m,jj,i)
5858 gx1(m)=eij*gacont(m,kk,k)
5859 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5860 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5861 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5862 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5866 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5871 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5877 c------------------------------------------------------------------------------
5878 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5879 C This subroutine calculates multi-body contributions to hydrogen-bonding
5880 implicit real*8 (a-h,o-z)
5881 include 'DIMENSIONS'
5882 include 'COMMON.IOUNITS'
5885 parameter (max_cont=maxconts)
5886 parameter (max_dim=26)
5887 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5888 double precision zapas(max_dim,maxconts,max_fg_procs),
5889 & zapas_recv(max_dim,maxconts,max_fg_procs)
5890 common /przechowalnia/ zapas
5891 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5892 & status_array(MPI_STATUS_SIZE,maxconts*2)
5894 include 'COMMON.SETUP'
5895 include 'COMMON.FFIELD'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.INTERACT'
5898 include 'COMMON.CONTACTS'
5899 include 'COMMON.CONTROL'
5900 include 'COMMON.LOCAL'
5901 double precision gx(3),gx1(3),time00
5904 C Set lprn=.true. for debugging
5909 if (nfgtasks.le.1) goto 30
5911 write (iout,'(a)') 'Contact function values before RECEIVE:'
5913 write (iout,'(2i3,50(1x,i2,f5.2))')
5914 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5915 & j=1,num_cont_hb(i))
5919 do i=1,ntask_cont_from
5922 do i=1,ntask_cont_to
5925 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5927 C Make the list of contacts to send to send to other procesors
5928 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5930 do i=iturn3_start,iturn3_end
5931 c write (iout,*) "make contact list turn3",i," num_cont",
5933 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5935 do i=iturn4_start,iturn4_end
5936 c write (iout,*) "make contact list turn4",i," num_cont",
5938 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5942 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5944 do j=1,num_cont_hb(i)
5947 iproc=iint_sent_local(k,jjc,ii)
5948 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5949 if (iproc.gt.0) then
5950 ncont_sent(iproc)=ncont_sent(iproc)+1
5951 nn=ncont_sent(iproc)
5953 zapas(2,nn,iproc)=jjc
5954 zapas(3,nn,iproc)=facont_hb(j,i)
5955 zapas(4,nn,iproc)=ees0p(j,i)
5956 zapas(5,nn,iproc)=ees0m(j,i)
5957 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5958 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5959 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5960 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5961 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5962 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5963 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5964 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5965 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5966 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5967 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5968 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5969 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5970 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5971 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5972 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5973 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5974 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5975 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5976 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5977 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5984 & "Numbers of contacts to be sent to other processors",
5985 & (ncont_sent(i),i=1,ntask_cont_to)
5986 write (iout,*) "Contacts sent"
5987 do ii=1,ntask_cont_to
5989 iproc=itask_cont_to(ii)
5990 write (iout,*) nn," contacts to processor",iproc,
5991 & " of CONT_TO_COMM group"
5993 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6001 CorrelID1=nfgtasks+fg_rank+1
6003 C Receive the numbers of needed contacts from other processors
6004 do ii=1,ntask_cont_from
6005 iproc=itask_cont_from(ii)
6007 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6008 & FG_COMM,req(ireq),IERR)
6010 c write (iout,*) "IRECV ended"
6012 C Send the number of contacts needed by other processors
6013 do ii=1,ntask_cont_to
6014 iproc=itask_cont_to(ii)
6016 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6017 & FG_COMM,req(ireq),IERR)
6019 c write (iout,*) "ISEND ended"
6020 c write (iout,*) "number of requests (nn)",ireq
6023 & call MPI_Waitall(ireq,req,status_array,ierr)
6025 c & "Numbers of contacts to be received from other processors",
6026 c & (ncont_recv(i),i=1,ntask_cont_from)
6030 do ii=1,ntask_cont_from
6031 iproc=itask_cont_from(ii)
6033 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6034 c & " of CONT_TO_COMM group"
6038 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6039 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6040 c write (iout,*) "ireq,req",ireq,req(ireq)
6043 C Send the contacts to processors that need them
6044 do ii=1,ntask_cont_to
6045 iproc=itask_cont_to(ii)
6047 c write (iout,*) nn," contacts to processor",iproc,
6048 c & " of CONT_TO_COMM group"
6051 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6052 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6053 c write (iout,*) "ireq,req",ireq,req(ireq)
6055 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6059 c write (iout,*) "number of requests (contacts)",ireq
6060 c write (iout,*) "req",(req(i),i=1,4)
6063 & call MPI_Waitall(ireq,req,status_array,ierr)
6064 do iii=1,ntask_cont_from
6065 iproc=itask_cont_from(iii)
6068 write (iout,*) "Received",nn," contacts from processor",iproc,
6069 & " of CONT_FROM_COMM group"
6072 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6077 ii=zapas_recv(1,i,iii)
6078 c Flag the received contacts to prevent double-counting
6079 jj=-zapas_recv(2,i,iii)
6080 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6082 nnn=num_cont_hb(ii)+1
6085 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6086 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6087 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6088 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6089 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6090 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6091 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6092 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6093 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6094 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6095 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6096 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6097 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6098 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6099 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6100 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6101 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6102 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6103 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6104 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6105 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6106 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6107 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6108 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6113 write (iout,'(a)') 'Contact function values after receive:'
6115 write (iout,'(2i3,50(1x,i3,f5.2))')
6116 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6117 & j=1,num_cont_hb(i))
6124 write (iout,'(a)') 'Contact function values:'
6126 write (iout,'(2i3,50(1x,i3,f5.2))')
6127 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6128 & j=1,num_cont_hb(i))
6132 C Remove the loop below after debugging !!!
6139 C Calculate the local-electrostatic correlation terms
6140 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6142 num_conti=num_cont_hb(i)
6143 num_conti1=num_cont_hb(i+1)
6150 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6151 c & ' jj=',jj,' kk=',kk
6152 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6153 & .or. j.lt.0 .and. j1.gt.0) .and.
6154 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6155 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6156 C The system gains extra energy.
6157 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6158 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6159 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6161 else if (j1.eq.j) then
6162 C Contacts I-J and I-(J+1) occur simultaneously.
6163 C The system loses extra energy.
6164 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6169 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6170 c & ' jj=',jj,' kk=',kk
6172 C Contacts I-J and (I+1)-J occur simultaneously.
6173 C The system loses extra energy.
6174 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6181 c------------------------------------------------------------------------------
6182 subroutine add_hb_contact(ii,jj,itask)
6183 implicit real*8 (a-h,o-z)
6184 include "DIMENSIONS"
6185 include "COMMON.IOUNITS"
6188 parameter (max_cont=maxconts)
6189 parameter (max_dim=26)
6190 include "COMMON.CONTACTS"
6191 double precision zapas(max_dim,maxconts,max_fg_procs),
6192 & zapas_recv(max_dim,maxconts,max_fg_procs)
6193 common /przechowalnia/ zapas
6194 integer i,j,ii,jj,iproc,itask(4),nn
6195 c write (iout,*) "itask",itask
6198 if (iproc.gt.0) then
6199 do j=1,num_cont_hb(ii)
6201 c write (iout,*) "i",ii," j",jj," jjc",jjc
6203 ncont_sent(iproc)=ncont_sent(iproc)+1
6204 nn=ncont_sent(iproc)
6205 zapas(1,nn,iproc)=ii
6206 zapas(2,nn,iproc)=jjc
6207 zapas(3,nn,iproc)=facont_hb(j,ii)
6208 zapas(4,nn,iproc)=ees0p(j,ii)
6209 zapas(5,nn,iproc)=ees0m(j,ii)
6210 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6211 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6212 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6213 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6214 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6215 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6216 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6217 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6218 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6219 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6220 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6221 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6222 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6223 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6224 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6225 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6226 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6227 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6228 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6229 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6230 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6238 c------------------------------------------------------------------------------
6239 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6241 C This subroutine calculates multi-body contributions to hydrogen-bonding
6242 implicit real*8 (a-h,o-z)
6243 include 'DIMENSIONS'
6244 include 'COMMON.IOUNITS'
6247 parameter (max_cont=maxconts)
6248 parameter (max_dim=70)
6249 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6250 double precision zapas(max_dim,maxconts,max_fg_procs),
6251 & zapas_recv(max_dim,maxconts,max_fg_procs)
6252 common /przechowalnia/ zapas
6253 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6254 & status_array(MPI_STATUS_SIZE,maxconts*2)
6256 include 'COMMON.SETUP'
6257 include 'COMMON.FFIELD'
6258 include 'COMMON.DERIV'
6259 include 'COMMON.LOCAL'
6260 include 'COMMON.INTERACT'
6261 include 'COMMON.CONTACTS'
6262 include 'COMMON.CHAIN'
6263 include 'COMMON.CONTROL'
6264 double precision gx(3),gx1(3)
6265 integer num_cont_hb_old(maxres)
6267 double precision eello4,eello5,eelo6,eello_turn6
6268 external eello4,eello5,eello6,eello_turn6
6269 C Set lprn=.true. for debugging
6274 num_cont_hb_old(i)=num_cont_hb(i)
6278 if (nfgtasks.le.1) goto 30
6280 write (iout,'(a)') 'Contact function values before RECEIVE:'
6282 write (iout,'(2i3,50(1x,i2,f5.2))')
6283 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6284 & j=1,num_cont_hb(i))
6288 do i=1,ntask_cont_from
6291 do i=1,ntask_cont_to
6294 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6296 C Make the list of contacts to send to send to other procesors
6297 do i=iturn3_start,iturn3_end
6298 c write (iout,*) "make contact list turn3",i," num_cont",
6300 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6302 do i=iturn4_start,iturn4_end
6303 c write (iout,*) "make contact list turn4",i," num_cont",
6305 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6309 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6311 do j=1,num_cont_hb(i)
6314 iproc=iint_sent_local(k,jjc,ii)
6315 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6316 if (iproc.ne.0) then
6317 ncont_sent(iproc)=ncont_sent(iproc)+1
6318 nn=ncont_sent(iproc)
6320 zapas(2,nn,iproc)=jjc
6321 zapas(3,nn,iproc)=d_cont(j,i)
6325 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6330 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6338 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6349 & "Numbers of contacts to be sent to other processors",
6350 & (ncont_sent(i),i=1,ntask_cont_to)
6351 write (iout,*) "Contacts sent"
6352 do ii=1,ntask_cont_to
6354 iproc=itask_cont_to(ii)
6355 write (iout,*) nn," contacts to processor",iproc,
6356 & " of CONT_TO_COMM group"
6358 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6366 CorrelID1=nfgtasks+fg_rank+1
6368 C Receive the numbers of needed contacts from other processors
6369 do ii=1,ntask_cont_from
6370 iproc=itask_cont_from(ii)
6372 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6373 & FG_COMM,req(ireq),IERR)
6375 c write (iout,*) "IRECV ended"
6377 C Send the number of contacts needed by other processors
6378 do ii=1,ntask_cont_to
6379 iproc=itask_cont_to(ii)
6381 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6382 & FG_COMM,req(ireq),IERR)
6384 c write (iout,*) "ISEND ended"
6385 c write (iout,*) "number of requests (nn)",ireq
6388 & call MPI_Waitall(ireq,req,status_array,ierr)
6390 c & "Numbers of contacts to be received from other processors",
6391 c & (ncont_recv(i),i=1,ntask_cont_from)
6395 do ii=1,ntask_cont_from
6396 iproc=itask_cont_from(ii)
6398 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6399 c & " of CONT_TO_COMM group"
6403 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6404 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6405 c write (iout,*) "ireq,req",ireq,req(ireq)
6408 C Send the contacts to processors that need them
6409 do ii=1,ntask_cont_to
6410 iproc=itask_cont_to(ii)
6412 c write (iout,*) nn," contacts to processor",iproc,
6413 c & " of CONT_TO_COMM group"
6416 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6417 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6418 c write (iout,*) "ireq,req",ireq,req(ireq)
6420 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6424 c write (iout,*) "number of requests (contacts)",ireq
6425 c write (iout,*) "req",(req(i),i=1,4)
6428 & call MPI_Waitall(ireq,req,status_array,ierr)
6429 do iii=1,ntask_cont_from
6430 iproc=itask_cont_from(iii)
6433 write (iout,*) "Received",nn," contacts from processor",iproc,
6434 & " of CONT_FROM_COMM group"
6437 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6442 ii=zapas_recv(1,i,iii)
6443 c Flag the received contacts to prevent double-counting
6444 jj=-zapas_recv(2,i,iii)
6445 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6447 nnn=num_cont_hb(ii)+1
6450 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6454 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6459 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6467 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6476 write (iout,'(a)') 'Contact function values after receive:'
6478 write (iout,'(2i3,50(1x,i3,5f6.3))')
6479 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6480 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6487 write (iout,'(a)') 'Contact function values:'
6489 write (iout,'(2i3,50(1x,i2,5f6.3))')
6490 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6491 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6497 C Remove the loop below after debugging !!!
6504 C Calculate the dipole-dipole interaction energies
6505 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6506 do i=iatel_s,iatel_e+1
6507 num_conti=num_cont_hb(i)
6516 C Calculate the local-electrostatic correlation terms
6517 c write (iout,*) "gradcorr5 in eello5 before loop"
6519 c write (iout,'(i5,3f10.5)')
6520 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6522 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6523 c write (iout,*) "corr loop i",i
6525 num_conti=num_cont_hb(i)
6526 num_conti1=num_cont_hb(i+1)
6533 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6534 c & ' jj=',jj,' kk=',kk
6535 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6536 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6537 & .or. j.lt.0 .and. j1.gt.0) .and.
6538 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6539 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6540 C The system gains extra energy.
6542 sqd1=dsqrt(d_cont(jj,i))
6543 sqd2=dsqrt(d_cont(kk,i1))
6544 sred_geom = sqd1*sqd2
6545 IF (sred_geom.lt.cutoff_corr) THEN
6546 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6548 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6549 cd & ' jj=',jj,' kk=',kk
6550 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6551 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6553 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6554 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6557 cd write (iout,*) 'sred_geom=',sred_geom,
6558 cd & ' ekont=',ekont,' fprim=',fprimcont,
6559 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6560 cd write (iout,*) "g_contij",g_contij
6561 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6562 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6563 call calc_eello(i,jp,i+1,jp1,jj,kk)
6564 if (wcorr4.gt.0.0d0)
6565 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6566 if (energy_dec.and.wcorr4.gt.0.0d0)
6567 1 write (iout,'(a6,4i5,0pf7.3)')
6568 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6569 c write (iout,*) "gradcorr5 before eello5"
6571 c write (iout,'(i5,3f10.5)')
6572 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6574 if (wcorr5.gt.0.0d0)
6575 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6576 c write (iout,*) "gradcorr5 after eello5"
6578 c write (iout,'(i5,3f10.5)')
6579 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6581 if (energy_dec.and.wcorr5.gt.0.0d0)
6582 1 write (iout,'(a6,4i5,0pf7.3)')
6583 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6584 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6585 cd write(2,*)'ijkl',i,jp,i+1,jp1
6586 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6587 & .or. wturn6.eq.0.0d0))then
6588 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6589 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6590 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6591 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6592 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6593 cd & 'ecorr6=',ecorr6
6594 cd write (iout,'(4e15.5)') sred_geom,
6595 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6596 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6597 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6598 else if (wturn6.gt.0.0d0
6599 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6600 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6601 eturn6=eturn6+eello_turn6(i,jj,kk)
6602 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6603 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6604 cd write (2,*) 'multibody_eello:eturn6',eturn6
6613 num_cont_hb(i)=num_cont_hb_old(i)
6615 c write (iout,*) "gradcorr5 in eello5"
6617 c write (iout,'(i5,3f10.5)')
6618 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6622 c------------------------------------------------------------------------------
6623 subroutine add_hb_contact_eello(ii,jj,itask)
6624 implicit real*8 (a-h,o-z)
6625 include "DIMENSIONS"
6626 include "COMMON.IOUNITS"
6629 parameter (max_cont=maxconts)
6630 parameter (max_dim=70)
6631 include "COMMON.CONTACTS"
6632 double precision zapas(max_dim,maxconts,max_fg_procs),
6633 & zapas_recv(max_dim,maxconts,max_fg_procs)
6634 common /przechowalnia/ zapas
6635 integer i,j,ii,jj,iproc,itask(4),nn
6636 c write (iout,*) "itask",itask
6639 if (iproc.gt.0) then
6640 do j=1,num_cont_hb(ii)
6642 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6644 ncont_sent(iproc)=ncont_sent(iproc)+1
6645 nn=ncont_sent(iproc)
6646 zapas(1,nn,iproc)=ii
6647 zapas(2,nn,iproc)=jjc
6648 zapas(3,nn,iproc)=d_cont(j,ii)
6652 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6657 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6665 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6677 c------------------------------------------------------------------------------
6678 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6679 implicit real*8 (a-h,o-z)
6680 include 'DIMENSIONS'
6681 include 'COMMON.IOUNITS'
6682 include 'COMMON.DERIV'
6683 include 'COMMON.INTERACT'
6684 include 'COMMON.CONTACTS'
6685 double precision gx(3),gx1(3)
6695 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6696 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6697 C Following 4 lines for diagnostics.
6702 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6703 c & 'Contacts ',i,j,
6704 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6705 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6707 C Calculate the multi-body contribution to energy.
6708 c ecorr=ecorr+ekont*ees
6709 C Calculate multi-body contributions to the gradient.
6710 coeffpees0pij=coeffp*ees0pij
6711 coeffmees0mij=coeffm*ees0mij
6712 coeffpees0pkl=coeffp*ees0pkl
6713 coeffmees0mkl=coeffm*ees0mkl
6715 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6716 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6717 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6718 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6719 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6720 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6721 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6722 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6723 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6724 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6725 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6726 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6727 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6728 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6729 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6730 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6731 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6732 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6733 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6734 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6735 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6736 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6737 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6738 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6739 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6744 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6745 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6746 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6747 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6752 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6753 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6754 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6755 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6758 c write (iout,*) "ehbcorr",ekont*ees
6763 C---------------------------------------------------------------------------
6764 subroutine dipole(i,j,jj)
6765 implicit real*8 (a-h,o-z)
6766 include 'DIMENSIONS'
6767 include 'COMMON.IOUNITS'
6768 include 'COMMON.CHAIN'
6769 include 'COMMON.FFIELD'
6770 include 'COMMON.DERIV'
6771 include 'COMMON.INTERACT'
6772 include 'COMMON.CONTACTS'
6773 include 'COMMON.TORSION'
6774 include 'COMMON.VAR'
6775 include 'COMMON.GEO'
6776 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6778 iti1 = itortyp(itype(i+1))
6779 if (j.lt.nres-1) then
6780 itj1 = itortyp(itype(j+1))
6785 dipi(iii,1)=Ub2(iii,i)
6786 dipderi(iii)=Ub2der(iii,i)
6787 dipi(iii,2)=b1(iii,iti1)
6788 dipj(iii,1)=Ub2(iii,j)
6789 dipderj(iii)=Ub2der(iii,j)
6790 dipj(iii,2)=b1(iii,itj1)
6794 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6797 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6804 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6808 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6813 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6814 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6816 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6818 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6820 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6825 C---------------------------------------------------------------------------
6826 subroutine calc_eello(i,j,k,l,jj,kk)
6828 C This subroutine computes matrices and vectors needed to calculate
6829 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6831 implicit real*8 (a-h,o-z)
6832 include 'DIMENSIONS'
6833 include 'COMMON.IOUNITS'
6834 include 'COMMON.CHAIN'
6835 include 'COMMON.DERIV'
6836 include 'COMMON.INTERACT'
6837 include 'COMMON.CONTACTS'
6838 include 'COMMON.TORSION'
6839 include 'COMMON.VAR'
6840 include 'COMMON.GEO'
6841 include 'COMMON.FFIELD'
6842 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6843 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6846 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6847 cd & ' jj=',jj,' kk=',kk
6848 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6849 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6850 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6853 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6854 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6857 call transpose2(aa1(1,1),aa1t(1,1))
6858 call transpose2(aa2(1,1),aa2t(1,1))
6861 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6862 & aa1tder(1,1,lll,kkk))
6863 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6864 & aa2tder(1,1,lll,kkk))
6868 C parallel orientation of the two CA-CA-CA frames.
6870 iti=itortyp(itype(i))
6874 itk1=itortyp(itype(k+1))
6875 itj=itortyp(itype(j))
6876 if (l.lt.nres-1) then
6877 itl1=itortyp(itype(l+1))
6881 C A1 kernel(j+1) A2T
6883 cd write (iout,'(3f10.5,5x,3f10.5)')
6884 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6886 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6887 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6888 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6889 C Following matrices are needed only for 6-th order cumulants
6890 IF (wcorr6.gt.0.0d0) THEN
6891 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6892 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6893 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6894 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6895 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6896 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6897 & ADtEAderx(1,1,1,1,1,1))
6899 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6900 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6901 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6902 & ADtEA1derx(1,1,1,1,1,1))
6904 C End 6-th order cumulants
6907 cd write (2,*) 'In calc_eello6'
6909 cd write (2,*) 'iii=',iii
6911 cd write (2,*) 'kkk=',kkk
6913 cd write (2,'(3(2f10.5),5x)')
6914 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6919 call transpose2(EUgder(1,1,k),auxmat(1,1))
6920 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6921 call transpose2(EUg(1,1,k),auxmat(1,1))
6922 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6923 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6927 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6928 & EAEAderx(1,1,lll,kkk,iii,1))
6932 C A1T kernel(i+1) A2
6933 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6934 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6935 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6936 C Following matrices are needed only for 6-th order cumulants
6937 IF (wcorr6.gt.0.0d0) THEN
6938 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6939 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6940 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6941 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6942 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6943 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6944 & ADtEAderx(1,1,1,1,1,2))
6945 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6946 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6947 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6948 & ADtEA1derx(1,1,1,1,1,2))
6950 C End 6-th order cumulants
6951 call transpose2(EUgder(1,1,l),auxmat(1,1))
6952 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6953 call transpose2(EUg(1,1,l),auxmat(1,1))
6954 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6955 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6959 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6960 & EAEAderx(1,1,lll,kkk,iii,2))
6965 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6966 C They are needed only when the fifth- or the sixth-order cumulants are
6968 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6969 call transpose2(AEA(1,1,1),auxmat(1,1))
6970 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6971 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6972 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6973 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6974 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6975 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6976 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6977 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6978 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6979 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6980 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6981 call transpose2(AEA(1,1,2),auxmat(1,1))
6982 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6983 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6984 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6985 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6986 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6987 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6988 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6989 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6990 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6991 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6992 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6993 C Calculate the Cartesian derivatives of the vectors.
6997 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6998 call matvec2(auxmat(1,1),b1(1,iti),
6999 & AEAb1derx(1,lll,kkk,iii,1,1))
7000 call matvec2(auxmat(1,1),Ub2(1,i),
7001 & AEAb2derx(1,lll,kkk,iii,1,1))
7002 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7003 & AEAb1derx(1,lll,kkk,iii,2,1))
7004 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7005 & AEAb2derx(1,lll,kkk,iii,2,1))
7006 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7007 call matvec2(auxmat(1,1),b1(1,itj),
7008 & AEAb1derx(1,lll,kkk,iii,1,2))
7009 call matvec2(auxmat(1,1),Ub2(1,j),
7010 & AEAb2derx(1,lll,kkk,iii,1,2))
7011 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7012 & AEAb1derx(1,lll,kkk,iii,2,2))
7013 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7014 & AEAb2derx(1,lll,kkk,iii,2,2))
7021 C Antiparallel orientation of the two CA-CA-CA frames.
7023 iti=itortyp(itype(i))
7027 itk1=itortyp(itype(k+1))
7028 itl=itortyp(itype(l))
7029 itj=itortyp(itype(j))
7030 if (j.lt.nres-1) then
7031 itj1=itortyp(itype(j+1))
7035 C A2 kernel(j-1)T A1T
7036 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7037 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7038 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7039 C Following matrices are needed only for 6-th order cumulants
7040 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7041 & j.eq.i+4 .and. l.eq.i+3)) THEN
7042 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7043 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7044 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7045 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7046 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7047 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7048 & ADtEAderx(1,1,1,1,1,1))
7049 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7050 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7051 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7052 & ADtEA1derx(1,1,1,1,1,1))
7054 C End 6-th order cumulants
7055 call transpose2(EUgder(1,1,k),auxmat(1,1))
7056 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7057 call transpose2(EUg(1,1,k),auxmat(1,1))
7058 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7059 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7063 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7064 & EAEAderx(1,1,lll,kkk,iii,1))
7068 C A2T kernel(i+1)T A1
7069 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7070 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7071 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7072 C Following matrices are needed only for 6-th order cumulants
7073 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7074 & j.eq.i+4 .and. l.eq.i+3)) THEN
7075 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7076 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7077 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7078 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7079 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7080 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7081 & ADtEAderx(1,1,1,1,1,2))
7082 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7083 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7084 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7085 & ADtEA1derx(1,1,1,1,1,2))
7087 C End 6-th order cumulants
7088 call transpose2(EUgder(1,1,j),auxmat(1,1))
7089 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7090 call transpose2(EUg(1,1,j),auxmat(1,1))
7091 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7092 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7096 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7097 & EAEAderx(1,1,lll,kkk,iii,2))
7102 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7103 C They are needed only when the fifth- or the sixth-order cumulants are
7105 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7106 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7107 call transpose2(AEA(1,1,1),auxmat(1,1))
7108 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7109 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7110 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7111 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7112 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7113 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7114 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7115 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7116 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7117 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7118 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7119 call transpose2(AEA(1,1,2),auxmat(1,1))
7120 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7121 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7122 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7123 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7124 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7125 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7126 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7127 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7128 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7129 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7130 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7131 C Calculate the Cartesian derivatives of the vectors.
7135 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7136 call matvec2(auxmat(1,1),b1(1,iti),
7137 & AEAb1derx(1,lll,kkk,iii,1,1))
7138 call matvec2(auxmat(1,1),Ub2(1,i),
7139 & AEAb2derx(1,lll,kkk,iii,1,1))
7140 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7141 & AEAb1derx(1,lll,kkk,iii,2,1))
7142 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7143 & AEAb2derx(1,lll,kkk,iii,2,1))
7144 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7145 call matvec2(auxmat(1,1),b1(1,itl),
7146 & AEAb1derx(1,lll,kkk,iii,1,2))
7147 call matvec2(auxmat(1,1),Ub2(1,l),
7148 & AEAb2derx(1,lll,kkk,iii,1,2))
7149 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7150 & AEAb1derx(1,lll,kkk,iii,2,2))
7151 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7152 & AEAb2derx(1,lll,kkk,iii,2,2))
7161 C---------------------------------------------------------------------------
7162 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7163 & KK,KKderg,AKA,AKAderg,AKAderx)
7167 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7168 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7169 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7174 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7176 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7179 cd if (lprn) write (2,*) 'In kernel'
7181 cd if (lprn) write (2,*) 'kkk=',kkk
7183 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7184 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7186 cd write (2,*) 'lll=',lll
7187 cd write (2,*) 'iii=1'
7189 cd write (2,'(3(2f10.5),5x)')
7190 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7193 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7194 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7196 cd write (2,*) 'lll=',lll
7197 cd write (2,*) 'iii=2'
7199 cd write (2,'(3(2f10.5),5x)')
7200 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7207 C---------------------------------------------------------------------------
7208 double precision function eello4(i,j,k,l,jj,kk)
7209 implicit real*8 (a-h,o-z)
7210 include 'DIMENSIONS'
7211 include 'COMMON.IOUNITS'
7212 include 'COMMON.CHAIN'
7213 include 'COMMON.DERIV'
7214 include 'COMMON.INTERACT'
7215 include 'COMMON.CONTACTS'
7216 include 'COMMON.TORSION'
7217 include 'COMMON.VAR'
7218 include 'COMMON.GEO'
7219 double precision pizda(2,2),ggg1(3),ggg2(3)
7220 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7224 cd print *,'eello4:',i,j,k,l,jj,kk
7225 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7226 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7227 cold eij=facont_hb(jj,i)
7228 cold ekl=facont_hb(kk,k)
7230 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7231 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7232 gcorr_loc(k-1)=gcorr_loc(k-1)
7233 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7235 gcorr_loc(l-1)=gcorr_loc(l-1)
7236 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7238 gcorr_loc(j-1)=gcorr_loc(j-1)
7239 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7244 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7245 & -EAEAderx(2,2,lll,kkk,iii,1)
7246 cd derx(lll,kkk,iii)=0.0d0
7250 cd gcorr_loc(l-1)=0.0d0
7251 cd gcorr_loc(j-1)=0.0d0
7252 cd gcorr_loc(k-1)=0.0d0
7254 cd write (iout,*)'Contacts have occurred for peptide groups',
7255 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7256 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7257 if (j.lt.nres-1) then
7264 if (l.lt.nres-1) then
7272 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7273 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7274 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7275 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7276 cgrad ghalf=0.5d0*ggg1(ll)
7277 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7278 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7279 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7280 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7281 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7282 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7283 cgrad ghalf=0.5d0*ggg2(ll)
7284 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7285 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7286 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7287 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7288 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7289 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7293 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7298 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7303 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7308 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7312 cd write (2,*) iii,gcorr_loc(iii)
7315 cd write (2,*) 'ekont',ekont
7316 cd write (iout,*) 'eello4',ekont*eel4
7319 C---------------------------------------------------------------------------
7320 double precision function eello5(i,j,k,l,jj,kk)
7321 implicit real*8 (a-h,o-z)
7322 include 'DIMENSIONS'
7323 include 'COMMON.IOUNITS'
7324 include 'COMMON.CHAIN'
7325 include 'COMMON.DERIV'
7326 include 'COMMON.INTERACT'
7327 include 'COMMON.CONTACTS'
7328 include 'COMMON.TORSION'
7329 include 'COMMON.VAR'
7330 include 'COMMON.GEO'
7331 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7332 double precision ggg1(3),ggg2(3)
7333 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7338 C /l\ / \ \ / \ / \ / C
7339 C / \ / \ \ / \ / \ / C
7340 C j| o |l1 | o | o| o | | o |o C
7341 C \ |/k\| |/ \| / |/ \| |/ \| C
7342 C \i/ \ / \ / / \ / \ C
7344 C (I) (II) (III) (IV) C
7346 C eello5_1 eello5_2 eello5_3 eello5_4 C
7348 C Antiparallel chains C
7351 C /j\ / \ \ / \ / \ / C
7352 C / \ / \ \ / \ / \ / C
7353 C j1| o |l | o | o| o | | o |o C
7354 C \ |/k\| |/ \| / |/ \| |/ \| C
7355 C \i/ \ / \ / / \ / \ C
7357 C (I) (II) (III) (IV) C
7359 C eello5_1 eello5_2 eello5_3 eello5_4 C
7361 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7363 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7364 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7369 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7371 itk=itortyp(itype(k))
7372 itl=itortyp(itype(l))
7373 itj=itortyp(itype(j))
7378 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7379 cd & eel5_3_num,eel5_4_num)
7383 derx(lll,kkk,iii)=0.0d0
7387 cd eij=facont_hb(jj,i)
7388 cd ekl=facont_hb(kk,k)
7390 cd write (iout,*)'Contacts have occurred for peptide groups',
7391 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7393 C Contribution from the graph I.
7394 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7395 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7396 call transpose2(EUg(1,1,k),auxmat(1,1))
7397 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7398 vv(1)=pizda(1,1)-pizda(2,2)
7399 vv(2)=pizda(1,2)+pizda(2,1)
7400 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7401 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7402 C Explicit gradient in virtual-dihedral angles.
7403 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7404 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7405 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7406 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7407 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7408 vv(1)=pizda(1,1)-pizda(2,2)
7409 vv(2)=pizda(1,2)+pizda(2,1)
7410 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7411 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7412 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7413 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7414 vv(1)=pizda(1,1)-pizda(2,2)
7415 vv(2)=pizda(1,2)+pizda(2,1)
7417 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7418 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7419 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7421 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7422 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7423 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7425 C Cartesian gradient
7429 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7431 vv(1)=pizda(1,1)-pizda(2,2)
7432 vv(2)=pizda(1,2)+pizda(2,1)
7433 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7434 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7435 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7441 C Contribution from graph II
7442 call transpose2(EE(1,1,itk),auxmat(1,1))
7443 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7444 vv(1)=pizda(1,1)+pizda(2,2)
7445 vv(2)=pizda(2,1)-pizda(1,2)
7446 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7447 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7448 C Explicit gradient in virtual-dihedral angles.
7449 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7450 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7451 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7452 vv(1)=pizda(1,1)+pizda(2,2)
7453 vv(2)=pizda(2,1)-pizda(1,2)
7455 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7456 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7457 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7459 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7460 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7461 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7463 C Cartesian gradient
7467 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7469 vv(1)=pizda(1,1)+pizda(2,2)
7470 vv(2)=pizda(2,1)-pizda(1,2)
7471 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7472 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7473 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7481 C Parallel orientation
7482 C Contribution from graph III
7483 call transpose2(EUg(1,1,l),auxmat(1,1))
7484 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7485 vv(1)=pizda(1,1)-pizda(2,2)
7486 vv(2)=pizda(1,2)+pizda(2,1)
7487 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7488 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7489 C Explicit gradient in virtual-dihedral angles.
7490 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7491 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7492 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7493 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7494 vv(1)=pizda(1,1)-pizda(2,2)
7495 vv(2)=pizda(1,2)+pizda(2,1)
7496 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7497 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7498 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7499 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7500 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7501 vv(1)=pizda(1,1)-pizda(2,2)
7502 vv(2)=pizda(1,2)+pizda(2,1)
7503 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7504 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7505 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7506 C Cartesian gradient
7510 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7512 vv(1)=pizda(1,1)-pizda(2,2)
7513 vv(2)=pizda(1,2)+pizda(2,1)
7514 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7515 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7516 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7521 C Contribution from graph IV
7523 call transpose2(EE(1,1,itl),auxmat(1,1))
7524 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7525 vv(1)=pizda(1,1)+pizda(2,2)
7526 vv(2)=pizda(2,1)-pizda(1,2)
7527 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7528 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7529 C Explicit gradient in virtual-dihedral angles.
7530 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7531 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7532 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7533 vv(1)=pizda(1,1)+pizda(2,2)
7534 vv(2)=pizda(2,1)-pizda(1,2)
7535 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7536 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7537 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7538 C Cartesian gradient
7542 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7544 vv(1)=pizda(1,1)+pizda(2,2)
7545 vv(2)=pizda(2,1)-pizda(1,2)
7546 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7547 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7548 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7553 C Antiparallel orientation
7554 C Contribution from graph III
7556 call transpose2(EUg(1,1,j),auxmat(1,1))
7557 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7558 vv(1)=pizda(1,1)-pizda(2,2)
7559 vv(2)=pizda(1,2)+pizda(2,1)
7560 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7561 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7562 C Explicit gradient in virtual-dihedral angles.
7563 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7564 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7565 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7566 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7567 vv(1)=pizda(1,1)-pizda(2,2)
7568 vv(2)=pizda(1,2)+pizda(2,1)
7569 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7570 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7571 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7572 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7573 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7574 vv(1)=pizda(1,1)-pizda(2,2)
7575 vv(2)=pizda(1,2)+pizda(2,1)
7576 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7577 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7578 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7579 C Cartesian gradient
7583 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7585 vv(1)=pizda(1,1)-pizda(2,2)
7586 vv(2)=pizda(1,2)+pizda(2,1)
7587 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7588 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7589 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7594 C Contribution from graph IV
7596 call transpose2(EE(1,1,itj),auxmat(1,1))
7597 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7598 vv(1)=pizda(1,1)+pizda(2,2)
7599 vv(2)=pizda(2,1)-pizda(1,2)
7600 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7601 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7602 C Explicit gradient in virtual-dihedral angles.
7603 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7604 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7605 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7606 vv(1)=pizda(1,1)+pizda(2,2)
7607 vv(2)=pizda(2,1)-pizda(1,2)
7608 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7609 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7610 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7611 C Cartesian gradient
7615 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7617 vv(1)=pizda(1,1)+pizda(2,2)
7618 vv(2)=pizda(2,1)-pizda(1,2)
7619 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7620 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7621 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7627 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7628 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7629 cd write (2,*) 'ijkl',i,j,k,l
7630 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7631 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7633 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7634 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7635 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7636 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7637 if (j.lt.nres-1) then
7644 if (l.lt.nres-1) then
7654 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7655 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7656 C summed up outside the subrouine as for the other subroutines
7657 C handling long-range interactions. The old code is commented out
7658 C with "cgrad" to keep track of changes.
7660 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7661 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7662 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7663 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7664 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7665 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7666 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7667 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7668 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7669 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7671 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7672 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7673 cgrad ghalf=0.5d0*ggg1(ll)
7675 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7676 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7677 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7678 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7679 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7680 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7681 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7682 cgrad ghalf=0.5d0*ggg2(ll)
7684 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7685 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7686 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7687 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7688 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7689 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7694 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7695 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7700 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7701 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7707 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7712 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7716 cd write (2,*) iii,g_corr5_loc(iii)
7719 cd write (2,*) 'ekont',ekont
7720 cd write (iout,*) 'eello5',ekont*eel5
7723 c--------------------------------------------------------------------------
7724 double precision function eello6(i,j,k,l,jj,kk)
7725 implicit real*8 (a-h,o-z)
7726 include 'DIMENSIONS'
7727 include 'COMMON.IOUNITS'
7728 include 'COMMON.CHAIN'
7729 include 'COMMON.DERIV'
7730 include 'COMMON.INTERACT'
7731 include 'COMMON.CONTACTS'
7732 include 'COMMON.TORSION'
7733 include 'COMMON.VAR'
7734 include 'COMMON.GEO'
7735 include 'COMMON.FFIELD'
7736 double precision ggg1(3),ggg2(3)
7737 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7742 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7750 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7751 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7755 derx(lll,kkk,iii)=0.0d0
7759 cd eij=facont_hb(jj,i)
7760 cd ekl=facont_hb(kk,k)
7766 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7767 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7768 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7769 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7770 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7771 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7773 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7774 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7775 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7776 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7777 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7778 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7782 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7784 C If turn contributions are considered, they will be handled separately.
7785 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7786 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7787 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7788 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7789 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7790 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7791 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7793 if (j.lt.nres-1) then
7800 if (l.lt.nres-1) then
7808 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7809 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7810 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7811 cgrad ghalf=0.5d0*ggg1(ll)
7813 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7814 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7815 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7816 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7817 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7818 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7819 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7820 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7821 cgrad ghalf=0.5d0*ggg2(ll)
7822 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7824 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7825 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7826 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7827 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7828 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7829 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7834 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7835 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7840 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7841 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7847 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7852 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7856 cd write (2,*) iii,g_corr6_loc(iii)
7859 cd write (2,*) 'ekont',ekont
7860 cd write (iout,*) 'eello6',ekont*eel6
7863 c--------------------------------------------------------------------------
7864 double precision function eello6_graph1(i,j,k,l,imat,swap)
7865 implicit real*8 (a-h,o-z)
7866 include 'DIMENSIONS'
7867 include 'COMMON.IOUNITS'
7868 include 'COMMON.CHAIN'
7869 include 'COMMON.DERIV'
7870 include 'COMMON.INTERACT'
7871 include 'COMMON.CONTACTS'
7872 include 'COMMON.TORSION'
7873 include 'COMMON.VAR'
7874 include 'COMMON.GEO'
7875 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7879 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7881 C Parallel Antiparallel C
7887 C \ j|/k\| / \ |/k\|l / C
7892 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7893 itk=itortyp(itype(k))
7894 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7895 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7896 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7897 call transpose2(EUgC(1,1,k),auxmat(1,1))
7898 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7899 vv1(1)=pizda1(1,1)-pizda1(2,2)
7900 vv1(2)=pizda1(1,2)+pizda1(2,1)
7901 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7902 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7903 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7904 s5=scalar2(vv(1),Dtobr2(1,i))
7905 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7906 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7907 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7908 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7909 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7910 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7911 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7912 & +scalar2(vv(1),Dtobr2der(1,i)))
7913 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7914 vv1(1)=pizda1(1,1)-pizda1(2,2)
7915 vv1(2)=pizda1(1,2)+pizda1(2,1)
7916 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7917 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7919 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7920 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7921 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7922 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7923 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7925 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7926 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7927 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7928 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7929 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7931 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7932 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7933 vv1(1)=pizda1(1,1)-pizda1(2,2)
7934 vv1(2)=pizda1(1,2)+pizda1(2,1)
7935 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7936 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7937 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7938 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7947 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7948 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7949 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7950 call transpose2(EUgC(1,1,k),auxmat(1,1))
7951 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7953 vv1(1)=pizda1(1,1)-pizda1(2,2)
7954 vv1(2)=pizda1(1,2)+pizda1(2,1)
7955 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7956 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7957 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7958 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7959 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7960 s5=scalar2(vv(1),Dtobr2(1,i))
7961 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7967 c----------------------------------------------------------------------------
7968 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7969 implicit real*8 (a-h,o-z)
7970 include 'DIMENSIONS'
7971 include 'COMMON.IOUNITS'
7972 include 'COMMON.CHAIN'
7973 include 'COMMON.DERIV'
7974 include 'COMMON.INTERACT'
7975 include 'COMMON.CONTACTS'
7976 include 'COMMON.TORSION'
7977 include 'COMMON.VAR'
7978 include 'COMMON.GEO'
7980 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7981 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7984 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7986 C Parallel Antiparallel C
7992 C \ j|/k\| \ |/k\|l C
7997 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7998 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7999 C AL 7/4/01 s1 would occur in the sixth-order moment,
8000 C but not in a cluster cumulant
8002 s1=dip(1,jj,i)*dip(1,kk,k)
8004 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8005 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8006 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8007 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8008 call transpose2(EUg(1,1,k),auxmat(1,1))
8009 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8010 vv(1)=pizda(1,1)-pizda(2,2)
8011 vv(2)=pizda(1,2)+pizda(2,1)
8012 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8013 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8015 eello6_graph2=-(s1+s2+s3+s4)
8017 eello6_graph2=-(s2+s3+s4)
8020 C Derivatives in gamma(i-1)
8023 s1=dipderg(1,jj,i)*dip(1,kk,k)
8025 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8026 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8027 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8028 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8030 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8032 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8034 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8036 C Derivatives in gamma(k-1)
8038 s1=dip(1,jj,i)*dipderg(1,kk,k)
8040 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8041 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8042 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8043 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8044 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8045 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8046 vv(1)=pizda(1,1)-pizda(2,2)
8047 vv(2)=pizda(1,2)+pizda(2,1)
8048 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8050 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8052 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8054 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8055 C Derivatives in gamma(j-1) or gamma(l-1)
8058 s1=dipderg(3,jj,i)*dip(1,kk,k)
8060 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8061 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8062 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8063 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8064 vv(1)=pizda(1,1)-pizda(2,2)
8065 vv(2)=pizda(1,2)+pizda(2,1)
8066 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8069 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8071 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8074 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8075 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8077 C Derivatives in gamma(l-1) or gamma(j-1)
8080 s1=dip(1,jj,i)*dipderg(3,kk,k)
8082 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8083 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8084 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8085 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8086 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8087 vv(1)=pizda(1,1)-pizda(2,2)
8088 vv(2)=pizda(1,2)+pizda(2,1)
8089 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8092 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8094 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8097 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8098 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8100 C Cartesian derivatives.
8102 write (2,*) 'In eello6_graph2'
8104 write (2,*) 'iii=',iii
8106 write (2,*) 'kkk=',kkk
8108 write (2,'(3(2f10.5),5x)')
8109 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8119 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8121 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8124 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8126 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8127 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8129 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8130 call transpose2(EUg(1,1,k),auxmat(1,1))
8131 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8133 vv(1)=pizda(1,1)-pizda(2,2)
8134 vv(2)=pizda(1,2)+pizda(2,1)
8135 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8136 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8138 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8140 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8143 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8145 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8152 c----------------------------------------------------------------------------
8153 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8154 implicit real*8 (a-h,o-z)
8155 include 'DIMENSIONS'
8156 include 'COMMON.IOUNITS'
8157 include 'COMMON.CHAIN'
8158 include 'COMMON.DERIV'
8159 include 'COMMON.INTERACT'
8160 include 'COMMON.CONTACTS'
8161 include 'COMMON.TORSION'
8162 include 'COMMON.VAR'
8163 include 'COMMON.GEO'
8164 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8166 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8168 C Parallel Antiparallel C
8174 C j|/k\| / |/k\|l / C
8179 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8181 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8182 C energy moment and not to the cluster cumulant.
8183 iti=itortyp(itype(i))
8184 if (j.lt.nres-1) then
8185 itj1=itortyp(itype(j+1))
8189 itk=itortyp(itype(k))
8190 itk1=itortyp(itype(k+1))
8191 if (l.lt.nres-1) then
8192 itl1=itortyp(itype(l+1))
8197 s1=dip(4,jj,i)*dip(4,kk,k)
8199 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8200 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8201 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8202 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8203 call transpose2(EE(1,1,itk),auxmat(1,1))
8204 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8205 vv(1)=pizda(1,1)+pizda(2,2)
8206 vv(2)=pizda(2,1)-pizda(1,2)
8207 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8208 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8209 cd & "sum",-(s2+s3+s4)
8211 eello6_graph3=-(s1+s2+s3+s4)
8213 eello6_graph3=-(s2+s3+s4)
8216 C Derivatives in gamma(k-1)
8217 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8218 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8219 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8220 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8221 C Derivatives in gamma(l-1)
8222 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8223 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8224 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8225 vv(1)=pizda(1,1)+pizda(2,2)
8226 vv(2)=pizda(2,1)-pizda(1,2)
8227 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8228 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8229 C Cartesian derivatives.
8235 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8237 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8240 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8242 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8243 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8245 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8246 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8248 vv(1)=pizda(1,1)+pizda(2,2)
8249 vv(2)=pizda(2,1)-pizda(1,2)
8250 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8252 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8254 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8257 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8259 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8261 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8267 c----------------------------------------------------------------------------
8268 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8269 implicit real*8 (a-h,o-z)
8270 include 'DIMENSIONS'
8271 include 'COMMON.IOUNITS'
8272 include 'COMMON.CHAIN'
8273 include 'COMMON.DERIV'
8274 include 'COMMON.INTERACT'
8275 include 'COMMON.CONTACTS'
8276 include 'COMMON.TORSION'
8277 include 'COMMON.VAR'
8278 include 'COMMON.GEO'
8279 include 'COMMON.FFIELD'
8280 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8281 & auxvec1(2),auxmat1(2,2)
8283 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8285 C Parallel Antiparallel C
8291 C \ j|/k\| \ |/k\|l C
8296 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8298 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8299 C energy moment and not to the cluster cumulant.
8300 cd write (2,*) 'eello_graph4: wturn6',wturn6
8301 iti=itortyp(itype(i))
8302 itj=itortyp(itype(j))
8303 if (j.lt.nres-1) then
8304 itj1=itortyp(itype(j+1))
8308 itk=itortyp(itype(k))
8309 if (k.lt.nres-1) then
8310 itk1=itortyp(itype(k+1))
8314 itl=itortyp(itype(l))
8315 if (l.lt.nres-1) then
8316 itl1=itortyp(itype(l+1))
8320 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8321 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8322 cd & ' itl',itl,' itl1',itl1
8325 s1=dip(3,jj,i)*dip(3,kk,k)
8327 s1=dip(2,jj,j)*dip(2,kk,l)
8330 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8331 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8333 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8334 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8336 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8337 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8339 call transpose2(EUg(1,1,k),auxmat(1,1))
8340 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8341 vv(1)=pizda(1,1)-pizda(2,2)
8342 vv(2)=pizda(2,1)+pizda(1,2)
8343 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8344 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8346 eello6_graph4=-(s1+s2+s3+s4)
8348 eello6_graph4=-(s2+s3+s4)
8350 C Derivatives in gamma(i-1)
8354 s1=dipderg(2,jj,i)*dip(3,kk,k)
8356 s1=dipderg(4,jj,j)*dip(2,kk,l)
8359 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8361 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8362 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8364 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8365 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8367 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8368 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8369 cd write (2,*) 'turn6 derivatives'
8371 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8373 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8377 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8379 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8383 C Derivatives in gamma(k-1)
8386 s1=dip(3,jj,i)*dipderg(2,kk,k)
8388 s1=dip(2,jj,j)*dipderg(4,kk,l)
8391 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8392 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8394 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8395 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8397 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8398 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8400 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8401 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8402 vv(1)=pizda(1,1)-pizda(2,2)
8403 vv(2)=pizda(2,1)+pizda(1,2)
8404 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8405 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8407 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8409 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8413 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8415 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8418 C Derivatives in gamma(j-1) or gamma(l-1)
8419 if (l.eq.j+1 .and. l.gt.1) then
8420 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8421 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8422 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8423 vv(1)=pizda(1,1)-pizda(2,2)
8424 vv(2)=pizda(2,1)+pizda(1,2)
8425 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8426 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8427 else if (j.gt.1) then
8428 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8429 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8430 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8431 vv(1)=pizda(1,1)-pizda(2,2)
8432 vv(2)=pizda(2,1)+pizda(1,2)
8433 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8434 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8435 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8437 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8440 C Cartesian derivatives.
8447 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8449 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8453 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8455 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8459 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8461 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8463 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8464 & b1(1,itj1),auxvec(1))
8465 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8467 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8468 & b1(1,itl1),auxvec(1))
8469 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8471 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8473 vv(1)=pizda(1,1)-pizda(2,2)
8474 vv(2)=pizda(2,1)+pizda(1,2)
8475 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8477 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8479 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8482 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8485 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8488 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8490 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8492 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8496 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8498 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8501 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8503 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8511 c----------------------------------------------------------------------------
8512 double precision function eello_turn6(i,jj,kk)
8513 implicit real*8 (a-h,o-z)
8514 include 'DIMENSIONS'
8515 include 'COMMON.IOUNITS'
8516 include 'COMMON.CHAIN'
8517 include 'COMMON.DERIV'
8518 include 'COMMON.INTERACT'
8519 include 'COMMON.CONTACTS'
8520 include 'COMMON.TORSION'
8521 include 'COMMON.VAR'
8522 include 'COMMON.GEO'
8523 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8524 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8526 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8527 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8528 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8529 C the respective energy moment and not to the cluster cumulant.
8538 iti=itortyp(itype(i))
8539 itk=itortyp(itype(k))
8540 itk1=itortyp(itype(k+1))
8541 itl=itortyp(itype(l))
8542 itj=itortyp(itype(j))
8543 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8544 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8545 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8550 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8552 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8556 derx_turn(lll,kkk,iii)=0.0d0
8563 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8565 cd write (2,*) 'eello6_5',eello6_5
8567 call transpose2(AEA(1,1,1),auxmat(1,1))
8568 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8569 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8570 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8572 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8573 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8574 s2 = scalar2(b1(1,itk),vtemp1(1))
8576 call transpose2(AEA(1,1,2),atemp(1,1))
8577 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8578 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8579 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8581 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8582 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8583 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8585 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8586 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8587 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8588 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8589 ss13 = scalar2(b1(1,itk),vtemp4(1))
8590 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8592 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8598 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8599 C Derivatives in gamma(i+2)
8603 call transpose2(AEA(1,1,1),auxmatd(1,1))
8604 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8605 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8606 call transpose2(AEAderg(1,1,2),atempd(1,1))
8607 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8608 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8610 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8611 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8612 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8618 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8619 C Derivatives in gamma(i+3)
8621 call transpose2(AEA(1,1,1),auxmatd(1,1))
8622 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8623 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8624 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8626 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8627 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8628 s2d = scalar2(b1(1,itk),vtemp1d(1))
8630 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8631 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8633 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8635 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8636 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8637 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8645 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8646 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8648 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8649 & -0.5d0*ekont*(s2d+s12d)
8651 C Derivatives in gamma(i+4)
8652 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8653 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8654 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8656 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8657 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8658 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8666 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8668 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8670 C Derivatives in gamma(i+5)
8672 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8673 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8674 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8676 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8677 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8678 s2d = scalar2(b1(1,itk),vtemp1d(1))
8680 call transpose2(AEA(1,1,2),atempd(1,1))
8681 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8682 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8684 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8685 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8687 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8688 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8689 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8697 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8698 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8700 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8701 & -0.5d0*ekont*(s2d+s12d)
8703 C Cartesian derivatives
8708 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8709 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8710 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8712 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8713 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8715 s2d = scalar2(b1(1,itk),vtemp1d(1))
8717 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8718 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8719 s8d = -(atempd(1,1)+atempd(2,2))*
8720 & scalar2(cc(1,1,itl),vtemp2(1))
8722 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8724 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8725 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8732 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8735 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8739 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8740 & - 0.5d0*(s8d+s12d)
8742 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8751 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8753 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8754 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8755 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8756 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8757 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8759 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8760 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8761 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8765 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8766 cd & 16*eel_turn6_num
8768 if (j.lt.nres-1) then
8775 if (l.lt.nres-1) then
8783 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8784 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8785 cgrad ghalf=0.5d0*ggg1(ll)
8787 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8788 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8789 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8790 & +ekont*derx_turn(ll,2,1)
8791 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8792 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8793 & +ekont*derx_turn(ll,4,1)
8794 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8795 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8796 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8797 cgrad ghalf=0.5d0*ggg2(ll)
8799 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8800 & +ekont*derx_turn(ll,2,2)
8801 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8802 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8803 & +ekont*derx_turn(ll,4,2)
8804 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8805 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8806 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8811 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8816 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8822 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8827 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8831 cd write (2,*) iii,g_corr6_loc(iii)
8833 eello_turn6=ekont*eel_turn6
8834 cd write (2,*) 'ekont',ekont
8835 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8839 C-----------------------------------------------------------------------------
8840 double precision function scalar(u,v)
8841 !DIR$ INLINEALWAYS scalar
8843 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8846 double precision u(3),v(3)
8847 cd double precision sc
8855 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8858 crc-------------------------------------------------
8859 SUBROUTINE MATVEC2(A1,V1,V2)
8860 !DIR$ INLINEALWAYS MATVEC2
8862 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8864 implicit real*8 (a-h,o-z)
8865 include 'DIMENSIONS'
8866 DIMENSION A1(2,2),V1(2),V2(2)
8870 c 3 VI=VI+A1(I,K)*V1(K)
8874 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8875 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8880 C---------------------------------------
8881 SUBROUTINE MATMAT2(A1,A2,A3)
8883 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8885 implicit real*8 (a-h,o-z)
8886 include 'DIMENSIONS'
8887 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8888 c DIMENSION AI3(2,2)
8892 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8898 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8899 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8900 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8901 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8909 c-------------------------------------------------------------------------
8910 double precision function scalar2(u,v)
8911 !DIR$ INLINEALWAYS scalar2
8913 double precision u(2),v(2)
8916 scalar2=u(1)*v(1)+u(2)*v(2)
8920 C-----------------------------------------------------------------------------
8922 subroutine transpose2(a,at)
8923 !DIR$ INLINEALWAYS transpose2
8925 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8928 double precision a(2,2),at(2,2)
8935 c--------------------------------------------------------------------------
8936 subroutine transpose(n,a,at)
8939 double precision a(n,n),at(n,n)
8947 C---------------------------------------------------------------------------
8948 subroutine prodmat3(a1,a2,kk,transp,prod)
8949 !DIR$ INLINEALWAYS prodmat3
8951 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8955 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8957 crc double precision auxmat(2,2),prod_(2,2)
8960 crc call transpose2(kk(1,1),auxmat(1,1))
8961 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8962 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8964 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8965 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8966 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8967 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8968 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8969 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8970 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8971 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8974 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8975 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8977 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8978 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8979 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8980 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8981 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8982 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8983 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8984 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8987 c call transpose2(a2(1,1),a2t(1,1))
8990 crc print *,((prod_(i,j),i=1,2),j=1,2)
8991 crc print *,((prod(i,j),i=1,2),j=1,2)