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 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
124 c print *,"Processor",myrank," computed USCSC"
130 time_vec=time_vec+MPI_Wtime()-time01
132 c print *,"Processor",myrank," left VEC_AND_DERIV"
135 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
136 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
137 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
138 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
140 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
154 c write (iout,*) "Soft-spheer ELEC potential"
155 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
158 c print *,"Processor",myrank," computed UELEC"
160 C Calculate excluded-volume interaction energy between peptide groups
165 call escp(evdw2,evdw2_14)
171 c write (iout,*) "Soft-sphere SCP potential"
172 call escp_soft_sphere(evdw2,evdw2_14)
175 c Calculate the bond-stretching energy
179 C Calculate the disulfide-bridge and other energy and the contributions
180 C from other distance constraints.
181 cd print *,'Calling EHPB'
183 cd print *,'EHPB exitted succesfully.'
185 C Calculate the virtual-bond-angle energy.
187 if (wang.gt.0d0) then
192 c print *,"Processor",myrank," computed UB"
194 C Calculate the SC local energy.
197 c print *,"Processor",myrank," computed USC"
199 C Calculate the virtual-bond torsional energy.
201 cd print *,'nterm=',nterm
203 call etor(etors,edihcnstr)
208 c print *,"Processor",myrank," computed Utor"
210 C 6/23/01 Calculate double-torsional energy
212 if (wtor_d.gt.0) then
217 c print *,"Processor",myrank," computed Utord"
219 C 21/5/07 Calculate local sicdechain correlation energy
221 if (wsccor.gt.0.0d0) then
222 call eback_sc_corr(esccor)
226 c print *,"Processor",myrank," computed Usccorr"
228 C 12/1/95 Multi-body terms
232 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
233 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
234 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
235 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
236 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
243 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
245 cd write (iout,*) "multibody_hb ecorr",ecorr
247 c print *,"Processor",myrank," computed Ucorr"
249 C If performing constraint dynamics, call the constraint energy
250 C after the equilibration time
251 if(usampl.and.totT.gt.eq_time) then
259 time_enecalc=time_enecalc+MPI_Wtime()-time00
261 c print *,"Processor",myrank," computed Uconstr"
270 energia(2)=evdw2-evdw2_14
287 energia(8)=eello_turn3
288 energia(9)=eello_turn4
295 energia(19)=edihcnstr
297 energia(20)=Uconst+Uconst_back
299 c print *," Processor",myrank," calls SUM_ENERGY"
300 call sum_energy(energia,.true.)
301 c print *," Processor",myrank," left SUM_ENERGY"
303 time_sumene=time_sumene+MPI_Wtime()-time00
307 c-------------------------------------------------------------------------------
308 subroutine sum_energy(energia,reduce)
309 implicit real*8 (a-h,o-z)
314 cMS$ATTRIBUTES C :: proc_proc
320 include 'COMMON.SETUP'
321 include 'COMMON.IOUNITS'
322 double precision energia(0:n_ene),enebuff(0:n_ene+1)
323 include 'COMMON.FFIELD'
324 include 'COMMON.DERIV'
325 include 'COMMON.INTERACT'
326 include 'COMMON.SBRIDGE'
327 include 'COMMON.CHAIN'
329 include 'COMMON.CONTROL'
330 include 'COMMON.TIME1'
333 if (nfgtasks.gt.1 .and. reduce) then
335 write (iout,*) "energies before REDUCE"
336 call enerprint(energia)
340 enebuff(i)=energia(i)
343 call MPI_Barrier(FG_COMM,IERR)
344 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
346 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
347 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
349 write (iout,*) "energies after REDUCE"
350 call enerprint(energia)
353 time_Reduce=time_Reduce+MPI_Wtime()-time00
355 if (fg_rank.eq.0) then
359 evdw2=energia(2)+energia(18)
375 eello_turn3=energia(8)
376 eello_turn4=energia(9)
383 edihcnstr=energia(19)
388 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
389 & +wang*ebe+wtor*etors+wscloc*escloc
390 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
391 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
392 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
393 & +wbond*estr+Uconst+wsccor*esccor
395 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
396 & +wang*ebe+wtor*etors+wscloc*escloc
397 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
398 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
399 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
400 & +wbond*estr+Uconst+wsccor*esccor
406 if (isnan(etot).ne.0) energia(0)=1.0d+99
408 if (isnan(etot)) energia(0)=1.0d+99
413 idumm=proc_proc(etot,i)
415 call proc_proc(etot,i)
417 if(i.eq.1)energia(0)=1.0d+99
424 c-------------------------------------------------------------------------------
425 subroutine sum_gradient
426 implicit real*8 (a-h,o-z)
431 cMS$ATTRIBUTES C :: proc_proc
436 double precision gradbufc(3,maxres),gradbufx(3,maxres),
437 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
439 include 'COMMON.SETUP'
440 include 'COMMON.IOUNITS'
441 include 'COMMON.FFIELD'
442 include 'COMMON.DERIV'
443 include 'COMMON.INTERACT'
444 include 'COMMON.SBRIDGE'
445 include 'COMMON.CHAIN'
447 include 'COMMON.CONTROL'
448 include 'COMMON.TIME1'
449 include 'COMMON.MAXGRAD'
450 include 'COMMON.SCCOR'
455 write (iout,*) "sum_gradient gvdwc, gvdwx"
457 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
458 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
463 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
464 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
465 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
468 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
469 C in virtual-bond-vector coordinates
472 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
474 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
475 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
477 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
479 c write (iout,'(i5,3f10.5,2x,f10.5)')
480 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
482 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
484 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
485 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
493 gradbufc(j,i)=wsc*gvdwc(j,i)+
494 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
495 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
496 & wel_loc*gel_loc_long(j,i)+
497 & wcorr*gradcorr_long(j,i)+
498 & wcorr5*gradcorr5_long(j,i)+
499 & wcorr6*gradcorr6_long(j,i)+
500 & wturn6*gcorr6_turn_long(j,i)+
507 gradbufc(j,i)=wsc*gvdwc(j,i)+
508 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
509 & welec*gelc_long(j,i)+
511 & wel_loc*gel_loc_long(j,i)+
512 & wcorr*gradcorr_long(j,i)+
513 & wcorr5*gradcorr5_long(j,i)+
514 & wcorr6*gradcorr6_long(j,i)+
515 & wturn6*gcorr6_turn_long(j,i)+
521 if (nfgtasks.gt.1) then
524 write (iout,*) "gradbufc before allreduce"
526 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
532 gradbufc_sum(j,i)=gradbufc(j,i)
535 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
536 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
537 c time_reduce=time_reduce+MPI_Wtime()-time00
539 c write (iout,*) "gradbufc_sum after allreduce"
541 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
546 c time_allreduce=time_allreduce+MPI_Wtime()-time00
554 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
555 write (iout,*) (i," jgrad_start",jgrad_start(i),
556 & " jgrad_end ",jgrad_end(i),
557 & i=igrad_start,igrad_end)
560 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
561 c do not parallelize this part.
563 c do i=igrad_start,igrad_end
564 c do j=jgrad_start(i),jgrad_end(i)
566 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
571 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
575 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
579 write (iout,*) "gradbufc after summing"
581 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
588 write (iout,*) "gradbufc"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
596 gradbufc_sum(j,i)=gradbufc(j,i)
601 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
605 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
610 c gradbufc(k,i)=0.0d0
614 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
619 write (iout,*) "gradbufc after summing"
621 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
629 gradbufc(k,nres)=0.0d0
634 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
635 & wel_loc*gel_loc(j,i)+
636 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
637 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
638 & wel_loc*gel_loc_long(j,i)+
639 & wcorr*gradcorr_long(j,i)+
640 & wcorr5*gradcorr5_long(j,i)+
641 & wcorr6*gradcorr6_long(j,i)+
642 & wturn6*gcorr6_turn_long(j,i))+
644 & wcorr*gradcorr(j,i)+
645 & wturn3*gcorr3_turn(j,i)+
646 & wturn4*gcorr4_turn(j,i)+
647 & wcorr5*gradcorr5(j,i)+
648 & wcorr6*gradcorr6(j,i)+
649 & wturn6*gcorr6_turn(j,i)+
650 & wsccor*gsccorc(j,i)
651 & +wscloc*gscloc(j,i)
653 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
654 & wel_loc*gel_loc(j,i)+
655 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
656 & welec*gelc_long(j,i)
657 & wel_loc*gel_loc_long(j,i)+
658 & wcorr*gcorr_long(j,i)+
659 & wcorr5*gradcorr5_long(j,i)+
660 & wcorr6*gradcorr6_long(j,i)+
661 & wturn6*gcorr6_turn_long(j,i))+
663 & wcorr*gradcorr(j,i)+
664 & wturn3*gcorr3_turn(j,i)+
665 & wturn4*gcorr4_turn(j,i)+
666 & wcorr5*gradcorr5(j,i)+
667 & wcorr6*gradcorr6(j,i)+
668 & wturn6*gcorr6_turn(j,i)+
669 & wsccor*gsccorc(j,i)
670 & +wscloc*gscloc(j,i)
672 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
674 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
675 & wsccor*gsccorx(j,i)
676 & +wscloc*gsclocx(j,i)
680 write (iout,*) "gloc before adding corr"
682 write (iout,*) i,gloc(i,icg)
686 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
687 & +wcorr5*g_corr5_loc(i)
688 & +wcorr6*g_corr6_loc(i)
689 & +wturn4*gel_loc_turn4(i)
690 & +wturn3*gel_loc_turn3(i)
691 & +wturn6*gel_loc_turn6(i)
692 & +wel_loc*gel_loc_loc(i)
695 write (iout,*) "gloc after adding corr"
697 write (iout,*) i,gloc(i,icg)
701 if (nfgtasks.gt.1) then
704 gradbufc(j,i)=gradc(j,i,icg)
705 gradbufx(j,i)=gradx(j,i,icg)
709 glocbuf(i)=gloc(i,icg)
713 write (iout,*) "gloc_sc before reduce"
716 write (iout,*) i,j,gloc_sc(j,i,icg)
723 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
727 call MPI_Barrier(FG_COMM,IERR)
728 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
730 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
731 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
732 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
734 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
736 time_reduce=time_reduce+MPI_Wtime()-time00
737 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
738 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
739 time_reduce=time_reduce+MPI_Wtime()-time00
742 write (iout,*) "gloc_sc after reduce"
745 write (iout,*) i,j,gloc_sc(j,i,icg)
751 write (iout,*) "gloc after reduce"
753 write (iout,*) i,gloc(i,icg)
758 if (gnorm_check) then
760 c Compute the maximum elements of the gradient
770 gcorr3_turn_max=0.0d0
771 gcorr4_turn_max=0.0d0
774 gcorr6_turn_max=0.0d0
784 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
785 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
786 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
787 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
788 & gvdwc_scp_max=gvdwc_scp_norm
789 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
790 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
791 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
792 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
793 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
794 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
795 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
796 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
797 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
798 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
799 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
800 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
801 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
803 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
804 & gcorr3_turn_max=gcorr3_turn_norm
805 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
807 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
808 & gcorr4_turn_max=gcorr4_turn_norm
809 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
810 if (gradcorr5_norm.gt.gradcorr5_max)
811 & gradcorr5_max=gradcorr5_norm
812 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
813 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
814 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
816 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
817 & gcorr6_turn_max=gcorr6_turn_norm
818 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
819 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
820 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
821 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
822 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
823 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
824 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
825 if (gradx_scp_norm.gt.gradx_scp_max)
826 & gradx_scp_max=gradx_scp_norm
827 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
828 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
829 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
830 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
831 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
832 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
833 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
834 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
838 open(istat,file=statname,position="append")
840 open(istat,file=statname,access="append")
842 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
843 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
844 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
845 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
846 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
847 & gsccorx_max,gsclocx_max
849 if (gvdwc_max.gt.1.0d4) then
850 write (iout,*) "gvdwc gvdwx gradb gradbx"
852 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
853 & gradb(j,i),gradbx(j,i),j=1,3)
855 call pdbout(0.0d0,'cipiszcze',iout)
861 write (iout,*) "gradc gradx gloc"
863 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
864 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
868 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
872 c-------------------------------------------------------------------------------
873 subroutine rescale_weights(t_bath)
874 implicit real*8 (a-h,o-z)
876 include 'COMMON.IOUNITS'
877 include 'COMMON.FFIELD'
878 include 'COMMON.SBRIDGE'
879 double precision kfac /2.4d0/
880 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
882 c facT=2*temp0/(t_bath+temp0)
883 if (rescale_mode.eq.0) then
889 else if (rescale_mode.eq.1) then
890 facT=kfac/(kfac-1.0d0+t_bath/temp0)
891 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
892 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
893 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
894 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
895 else if (rescale_mode.eq.2) then
901 facT=licznik/dlog(dexp(x)+dexp(-x))
902 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
903 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
904 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
905 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
907 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
908 write (*,*) "Wrong RESCALE_MODE",rescale_mode
910 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
914 welec=weights(3)*fact
915 wcorr=weights(4)*fact3
916 wcorr5=weights(5)*fact4
917 wcorr6=weights(6)*fact5
918 wel_loc=weights(7)*fact2
919 wturn3=weights(8)*fact2
920 wturn4=weights(9)*fact3
921 wturn6=weights(10)*fact5
922 wtor=weights(13)*fact
923 wtor_d=weights(14)*fact2
924 wsccor=weights(21)*fact
928 C------------------------------------------------------------------------
929 subroutine enerprint(energia)
930 implicit real*8 (a-h,o-z)
932 include 'COMMON.IOUNITS'
933 include 'COMMON.FFIELD'
934 include 'COMMON.SBRIDGE'
936 double precision energia(0:n_ene)
941 evdw2=energia(2)+energia(18)
953 eello_turn3=energia(8)
954 eello_turn4=energia(9)
955 eello_turn6=energia(10)
961 edihcnstr=energia(19)
966 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
967 & estr,wbond,ebe,wang,
968 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
970 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
971 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
974 10 format (/'Virtual-chain energies:'//
975 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
976 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
977 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
978 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
979 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
980 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
981 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
982 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
983 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
984 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
985 & ' (SS bridges & dist. cnstr.)'/
986 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
987 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
988 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
989 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
990 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
991 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
992 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
993 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
994 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
995 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
996 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
997 & 'ETOT= ',1pE16.6,' (total)')
999 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1000 & estr,wbond,ebe,wang,
1001 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1003 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1004 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1005 & ebr*nss,Uconst,etot
1006 10 format (/'Virtual-chain energies:'//
1007 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1008 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1009 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1010 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1011 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1012 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1013 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1014 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1015 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1016 & ' (SS bridges & dist. cnstr.)'/
1017 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1018 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1019 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1021 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1022 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1023 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1024 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1025 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1026 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1027 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1028 & 'ETOT= ',1pE16.6,' (total)')
1032 C-----------------------------------------------------------------------
1033 subroutine elj(evdw)
1035 C This subroutine calculates the interaction energy of nonbonded side chains
1036 C assuming the LJ potential of interaction.
1038 implicit real*8 (a-h,o-z)
1039 include 'DIMENSIONS'
1040 parameter (accur=1.0d-10)
1041 include 'COMMON.GEO'
1042 include 'COMMON.VAR'
1043 include 'COMMON.LOCAL'
1044 include 'COMMON.CHAIN'
1045 include 'COMMON.DERIV'
1046 include 'COMMON.INTERACT'
1047 include 'COMMON.TORSION'
1048 include 'COMMON.SBRIDGE'
1049 include 'COMMON.NAMES'
1050 include 'COMMON.IOUNITS'
1051 include 'COMMON.CONTACTS'
1053 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1055 do i=iatsc_s,iatsc_e
1056 itypi=iabs(itype(i))
1057 if (itypi.eq.ntyp1) cycle
1058 itypi1=iabs(itype(i+1))
1065 C Calculate SC interaction energy.
1067 do iint=1,nint_gr(i)
1068 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1069 cd & 'iend=',iend(i,iint)
1070 do j=istart(i,iint),iend(i,iint)
1071 itypj=iabs(itype(j))
1072 if (itypj.eq.ntyp1) cycle
1076 C Change 12/1/95 to calculate four-body interactions
1077 rij=xj*xj+yj*yj+zj*zj
1079 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1080 eps0ij=eps(itypi,itypj)
1082 e1=fac*fac*aa(itypi,itypj)
1083 e2=fac*bb(itypi,itypj)
1085 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1086 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1087 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1088 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1089 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1090 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1093 C Calculate the components of the gradient in DC and X
1095 fac=-rrij*(e1+evdwij)
1100 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1101 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1102 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1103 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1107 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1111 C 12/1/95, revised on 5/20/97
1113 C Calculate the contact function. The ith column of the array JCONT will
1114 C contain the numbers of atoms that make contacts with the atom I (of numbers
1115 C greater than I). The arrays FACONT and GACONT will contain the values of
1116 C the contact function and its derivative.
1118 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1119 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1120 C Uncomment next line, if the correlation interactions are contact function only
1121 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1123 sigij=sigma(itypi,itypj)
1124 r0ij=rs0(itypi,itypj)
1126 C Check whether the SC's are not too far to make a contact.
1129 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1130 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1132 if (fcont.gt.0.0D0) then
1133 C If the SC-SC distance if close to sigma, apply spline.
1134 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1135 cAdam & fcont1,fprimcont1)
1136 cAdam fcont1=1.0d0-fcont1
1137 cAdam if (fcont1.gt.0.0d0) then
1138 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1139 cAdam fcont=fcont*fcont1
1141 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1142 cga eps0ij=1.0d0/dsqrt(eps0ij)
1144 cga gg(k)=gg(k)*eps0ij
1146 cga eps0ij=-evdwij*eps0ij
1147 C Uncomment for AL's type of SC correlation interactions.
1148 cadam eps0ij=-evdwij
1149 num_conti=num_conti+1
1150 jcont(num_conti,i)=j
1151 facont(num_conti,i)=fcont*eps0ij
1152 fprimcont=eps0ij*fprimcont/rij
1154 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1155 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1156 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1157 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1158 gacont(1,num_conti,i)=-fprimcont*xj
1159 gacont(2,num_conti,i)=-fprimcont*yj
1160 gacont(3,num_conti,i)=-fprimcont*zj
1161 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1162 cd write (iout,'(2i3,3f10.5)')
1163 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1169 num_cont(i)=num_conti
1173 gvdwc(j,i)=expon*gvdwc(j,i)
1174 gvdwx(j,i)=expon*gvdwx(j,i)
1177 C******************************************************************************
1181 C To save time, the factor of EXPON has been extracted from ALL components
1182 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1185 C******************************************************************************
1188 C-----------------------------------------------------------------------------
1189 subroutine eljk(evdw)
1191 C This subroutine calculates the interaction energy of nonbonded side chains
1192 C assuming the LJK potential of interaction.
1194 implicit real*8 (a-h,o-z)
1195 include 'DIMENSIONS'
1196 include 'COMMON.GEO'
1197 include 'COMMON.VAR'
1198 include 'COMMON.LOCAL'
1199 include 'COMMON.CHAIN'
1200 include 'COMMON.DERIV'
1201 include 'COMMON.INTERACT'
1202 include 'COMMON.IOUNITS'
1203 include 'COMMON.NAMES'
1206 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1208 do i=iatsc_s,iatsc_e
1209 itypi=iabs(itype(i))
1210 if (itypi.eq.ntyp1) cycle
1211 itypi1=iabs(itype(i+1))
1216 C Calculate SC interaction energy.
1218 do iint=1,nint_gr(i)
1219 do j=istart(i,iint),iend(i,iint)
1220 itypj=iabs(itype(j))
1221 if (itypj.eq.ntyp1) cycle
1225 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1226 fac_augm=rrij**expon
1227 e_augm=augm(itypi,itypj)*fac_augm
1228 r_inv_ij=dsqrt(rrij)
1230 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1231 fac=r_shift_inv**expon
1232 e1=fac*fac*aa(itypi,itypj)
1233 e2=fac*bb(itypi,itypj)
1235 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1236 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1237 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1238 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1239 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1240 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1241 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1244 C Calculate the components of the gradient in DC and X
1246 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1251 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1252 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1253 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1254 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1258 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1266 gvdwc(j,i)=expon*gvdwc(j,i)
1267 gvdwx(j,i)=expon*gvdwx(j,i)
1272 C-----------------------------------------------------------------------------
1273 subroutine ebp(evdw)
1275 C This subroutine calculates the interaction energy of nonbonded side chains
1276 C assuming the Berne-Pechukas potential of interaction.
1278 implicit real*8 (a-h,o-z)
1279 include 'DIMENSIONS'
1280 include 'COMMON.GEO'
1281 include 'COMMON.VAR'
1282 include 'COMMON.LOCAL'
1283 include 'COMMON.CHAIN'
1284 include 'COMMON.DERIV'
1285 include 'COMMON.NAMES'
1286 include 'COMMON.INTERACT'
1287 include 'COMMON.IOUNITS'
1288 include 'COMMON.CALC'
1289 common /srutu/ icall
1290 c double precision rrsave(maxdim)
1293 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1295 c if (icall.eq.0) then
1301 do i=iatsc_s,iatsc_e
1302 itypi=iabs(itype(i))
1303 if (itypi.eq.ntyp1) cycle
1304 itypi1=iabs(itype(i+1))
1308 dxi=dc_norm(1,nres+i)
1309 dyi=dc_norm(2,nres+i)
1310 dzi=dc_norm(3,nres+i)
1311 c dsci_inv=dsc_inv(itypi)
1312 dsci_inv=vbld_inv(i+nres)
1314 C Calculate SC interaction energy.
1316 do iint=1,nint_gr(i)
1317 do j=istart(i,iint),iend(i,iint)
1319 itypj=iabs(itype(j))
1320 if (itypj.eq.ntyp1) cycle
1321 c dscj_inv=dsc_inv(itypj)
1322 dscj_inv=vbld_inv(j+nres)
1323 chi1=chi(itypi,itypj)
1324 chi2=chi(itypj,itypi)
1331 alf12=0.5D0*(alf1+alf2)
1332 C For diagnostics only!!!
1345 dxj=dc_norm(1,nres+j)
1346 dyj=dc_norm(2,nres+j)
1347 dzj=dc_norm(3,nres+j)
1348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1349 cd if (icall.eq.0) then
1355 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1357 C Calculate whole angle-dependent part of epsilon and contributions
1358 C to its derivatives
1359 fac=(rrij*sigsq)**expon2
1360 e1=fac*fac*aa(itypi,itypj)
1361 e2=fac*bb(itypi,itypj)
1362 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1363 eps2der=evdwij*eps3rt
1364 eps3der=evdwij*eps2rt
1365 evdwij=evdwij*eps2rt*eps3rt
1368 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1369 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1370 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1371 cd & restyp(itypi),i,restyp(itypj),j,
1372 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1373 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1374 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1377 C Calculate gradient components.
1378 e1=e1*eps1*eps2rt**2*eps3rt**2
1379 fac=-expon*(e1+evdwij)
1382 C Calculate radial part of the gradient
1386 C Calculate the angular part of the gradient and sum add the contributions
1387 C to the appropriate components of the Cartesian gradient.
1395 C-----------------------------------------------------------------------------
1396 subroutine egb(evdw)
1398 C This subroutine calculates the interaction energy of nonbonded side chains
1399 C assuming the Gay-Berne potential of interaction.
1401 implicit real*8 (a-h,o-z)
1402 include 'DIMENSIONS'
1403 include 'COMMON.GEO'
1404 include 'COMMON.VAR'
1405 include 'COMMON.LOCAL'
1406 include 'COMMON.CHAIN'
1407 include 'COMMON.DERIV'
1408 include 'COMMON.NAMES'
1409 include 'COMMON.INTERACT'
1410 include 'COMMON.IOUNITS'
1411 include 'COMMON.CALC'
1412 include 'COMMON.CONTROL'
1415 ccccc energy_dec=.false.
1416 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1419 c if (icall.eq.0) lprn=.false.
1421 do i=iatsc_s,iatsc_e
1422 itypi=iabs(itype(i))
1423 if (itypi.eq.ntyp1) cycle
1424 itypi1=iabs(itype(i+1))
1428 dxi=dc_norm(1,nres+i)
1429 dyi=dc_norm(2,nres+i)
1430 dzi=dc_norm(3,nres+i)
1431 c dsci_inv=dsc_inv(itypi)
1432 dsci_inv=vbld_inv(i+nres)
1433 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1434 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1436 C Calculate SC interaction energy.
1438 do iint=1,nint_gr(i)
1439 do j=istart(i,iint),iend(i,iint)
1441 itypj=iabs(itype(j))
1442 if (itypj.eq.ntyp1) cycle
1443 c dscj_inv=dsc_inv(itypj)
1444 dscj_inv=vbld_inv(j+nres)
1445 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1446 c & 1.0d0/vbld(j+nres)
1447 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1448 sig0ij=sigma(itypi,itypj)
1449 chi1=chi(itypi,itypj)
1450 chi2=chi(itypj,itypi)
1457 alf12=0.5D0*(alf1+alf2)
1458 C For diagnostics only!!!
1471 dxj=dc_norm(1,nres+j)
1472 dyj=dc_norm(2,nres+j)
1473 dzj=dc_norm(3,nres+j)
1474 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1475 c write (iout,*) "j",j," dc_norm",
1476 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1477 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1479 C Calculate angle-dependent terms of energy and contributions to their
1483 sig=sig0ij*dsqrt(sigsq)
1484 rij_shift=1.0D0/rij-sig+sig0ij
1485 c for diagnostics; uncomment
1486 c rij_shift=1.2*sig0ij
1487 C I hate to put IF's in the loops, but here don't have another choice!!!!
1488 if (rij_shift.le.0.0D0) then
1490 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1491 cd & restyp(itypi),i,restyp(itypj),j,
1492 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1496 c---------------------------------------------------------------
1497 rij_shift=1.0D0/rij_shift
1498 fac=rij_shift**expon
1499 e1=fac*fac*aa(itypi,itypj)
1500 e2=fac*bb(itypi,itypj)
1501 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1502 eps2der=evdwij*eps3rt
1503 eps3der=evdwij*eps2rt
1504 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1505 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1506 evdwij=evdwij*eps2rt*eps3rt
1509 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1510 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1511 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1512 & restyp(itypi),i,restyp(itypj),j,
1513 & epsi,sigm,chi1,chi2,chip1,chip2,
1514 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1515 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1519 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1522 C Calculate gradient components.
1523 e1=e1*eps1*eps2rt**2*eps3rt**2
1524 fac=-expon*(e1+evdwij)*rij_shift
1528 C Calculate the radial part of the gradient
1532 C Calculate angular part of the gradient.
1537 c write (iout,*) "Number of loop steps in EGB:",ind
1538 cccc energy_dec=.false.
1541 C-----------------------------------------------------------------------------
1542 subroutine egbv(evdw)
1544 C This subroutine calculates the interaction energy of nonbonded side chains
1545 C assuming the Gay-Berne-Vorobjev potential of interaction.
1547 implicit real*8 (a-h,o-z)
1548 include 'DIMENSIONS'
1549 include 'COMMON.GEO'
1550 include 'COMMON.VAR'
1551 include 'COMMON.LOCAL'
1552 include 'COMMON.CHAIN'
1553 include 'COMMON.DERIV'
1554 include 'COMMON.NAMES'
1555 include 'COMMON.INTERACT'
1556 include 'COMMON.IOUNITS'
1557 include 'COMMON.CALC'
1558 common /srutu/ icall
1561 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1564 c if (icall.eq.0) lprn=.true.
1566 do i=iatsc_s,iatsc_e
1567 itypi=iabs(itype(i))
1568 if (itypi.eq.ntyp1) cycle
1569 itypi1=iabs(itype(i+1))
1573 dxi=dc_norm(1,nres+i)
1574 dyi=dc_norm(2,nres+i)
1575 dzi=dc_norm(3,nres+i)
1576 c dsci_inv=dsc_inv(itypi)
1577 dsci_inv=vbld_inv(i+nres)
1579 C Calculate SC interaction energy.
1581 do iint=1,nint_gr(i)
1582 do j=istart(i,iint),iend(i,iint)
1584 itypj=iabs(itype(j))
1585 if (itypj.eq.ntyp1) cycle
1586 c dscj_inv=dsc_inv(itypj)
1587 dscj_inv=vbld_inv(j+nres)
1588 sig0ij=sigma(itypi,itypj)
1589 r0ij=r0(itypi,itypj)
1590 chi1=chi(itypi,itypj)
1591 chi2=chi(itypj,itypi)
1598 alf12=0.5D0*(alf1+alf2)
1599 C For diagnostics only!!!
1612 dxj=dc_norm(1,nres+j)
1613 dyj=dc_norm(2,nres+j)
1614 dzj=dc_norm(3,nres+j)
1615 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1617 C Calculate angle-dependent terms of energy and contributions to their
1621 sig=sig0ij*dsqrt(sigsq)
1622 rij_shift=1.0D0/rij-sig+r0ij
1623 C I hate to put IF's in the loops, but here don't have another choice!!!!
1624 if (rij_shift.le.0.0D0) then
1629 c---------------------------------------------------------------
1630 rij_shift=1.0D0/rij_shift
1631 fac=rij_shift**expon
1632 e1=fac*fac*aa(itypi,itypj)
1633 e2=fac*bb(itypi,itypj)
1634 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1635 eps2der=evdwij*eps3rt
1636 eps3der=evdwij*eps2rt
1637 fac_augm=rrij**expon
1638 e_augm=augm(itypi,itypj)*fac_augm
1639 evdwij=evdwij*eps2rt*eps3rt
1640 evdw=evdw+evdwij+e_augm
1642 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1643 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1644 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1645 & restyp(itypi),i,restyp(itypj),j,
1646 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1647 & chi1,chi2,chip1,chip2,
1648 & eps1,eps2rt**2,eps3rt**2,
1649 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1652 C Calculate gradient components.
1653 e1=e1*eps1*eps2rt**2*eps3rt**2
1654 fac=-expon*(e1+evdwij)*rij_shift
1656 fac=rij*fac-2*expon*rrij*e_augm
1657 C Calculate the radial part of the gradient
1661 C Calculate angular part of the gradient.
1667 C-----------------------------------------------------------------------------
1668 subroutine sc_angular
1669 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1670 C om12. Called by ebp, egb, and egbv.
1672 include 'COMMON.CALC'
1673 include 'COMMON.IOUNITS'
1677 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1678 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1679 om12=dxi*dxj+dyi*dyj+dzi*dzj
1681 C Calculate eps1(om12) and its derivative in om12
1682 faceps1=1.0D0-om12*chiom12
1683 faceps1_inv=1.0D0/faceps1
1684 eps1=dsqrt(faceps1_inv)
1685 C Following variable is eps1*deps1/dom12
1686 eps1_om12=faceps1_inv*chiom12
1691 c write (iout,*) "om12",om12," eps1",eps1
1692 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1697 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1698 sigsq=1.0D0-facsig*faceps1_inv
1699 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1700 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1701 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1707 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1708 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1710 C Calculate eps2 and its derivatives in om1, om2, and om12.
1713 chipom12=chip12*om12
1714 facp=1.0D0-om12*chipom12
1716 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1717 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1718 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1719 C Following variable is the square root of eps2
1720 eps2rt=1.0D0-facp1*facp_inv
1721 C Following three variables are the derivatives of the square root of eps
1722 C in om1, om2, and om12.
1723 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1724 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1725 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1726 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1727 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1728 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1729 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1730 c & " eps2rt_om12",eps2rt_om12
1731 C Calculate whole angle-dependent part of epsilon and contributions
1732 C to its derivatives
1735 C----------------------------------------------------------------------------
1737 implicit real*8 (a-h,o-z)
1738 include 'DIMENSIONS'
1739 include 'COMMON.CHAIN'
1740 include 'COMMON.DERIV'
1741 include 'COMMON.CALC'
1742 include 'COMMON.IOUNITS'
1743 double precision dcosom1(3),dcosom2(3)
1744 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1745 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1746 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1747 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1751 c eom12=evdwij*eps1_om12
1753 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1754 c & " sigder",sigder
1755 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1756 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1758 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1759 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1762 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1764 c write (iout,*) "gg",(gg(k),k=1,3)
1766 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1767 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1768 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1769 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1770 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1771 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1772 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1773 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1774 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1775 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1778 C Calculate the components of the gradient in DC and X
1782 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1786 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1787 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1791 C-----------------------------------------------------------------------
1792 subroutine e_softsphere(evdw)
1794 C This subroutine calculates the interaction energy of nonbonded side chains
1795 C assuming the LJ potential of interaction.
1797 implicit real*8 (a-h,o-z)
1798 include 'DIMENSIONS'
1799 parameter (accur=1.0d-10)
1800 include 'COMMON.GEO'
1801 include 'COMMON.VAR'
1802 include 'COMMON.LOCAL'
1803 include 'COMMON.CHAIN'
1804 include 'COMMON.DERIV'
1805 include 'COMMON.INTERACT'
1806 include 'COMMON.TORSION'
1807 include 'COMMON.SBRIDGE'
1808 include 'COMMON.NAMES'
1809 include 'COMMON.IOUNITS'
1810 include 'COMMON.CONTACTS'
1812 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1814 do i=iatsc_s,iatsc_e
1815 itypi=iabs(itype(i))
1816 if (itypi.eq.ntyp1) cycle
1817 itypi1=iabs(itype(i+1))
1822 C Calculate SC interaction energy.
1824 do iint=1,nint_gr(i)
1825 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1826 cd & 'iend=',iend(i,iint)
1827 do j=istart(i,iint),iend(i,iint)
1828 itypj=iabs(itype(j))
1829 if (itypj.eq.ntyp1) cycle
1833 rij=xj*xj+yj*yj+zj*zj
1834 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1835 r0ij=r0(itypi,itypj)
1837 c print *,i,j,r0ij,dsqrt(rij)
1838 if (rij.lt.r0ijsq) then
1839 evdwij=0.25d0*(rij-r0ijsq)**2
1847 C Calculate the components of the gradient in DC and X
1853 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1854 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1855 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1856 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1860 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1868 C--------------------------------------------------------------------------
1869 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1872 C Soft-sphere potential of p-p interaction
1874 implicit real*8 (a-h,o-z)
1875 include 'DIMENSIONS'
1876 include 'COMMON.CONTROL'
1877 include 'COMMON.IOUNITS'
1878 include 'COMMON.GEO'
1879 include 'COMMON.VAR'
1880 include 'COMMON.LOCAL'
1881 include 'COMMON.CHAIN'
1882 include 'COMMON.DERIV'
1883 include 'COMMON.INTERACT'
1884 include 'COMMON.CONTACTS'
1885 include 'COMMON.TORSION'
1886 include 'COMMON.VECTORS'
1887 include 'COMMON.FFIELD'
1889 cd write(iout,*) 'In EELEC_soft_sphere'
1896 do i=iatel_s,iatel_e
1897 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1901 xmedi=c(1,i)+0.5d0*dxi
1902 ymedi=c(2,i)+0.5d0*dyi
1903 zmedi=c(3,i)+0.5d0*dzi
1905 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1906 do j=ielstart(i),ielend(i)
1907 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1911 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1912 r0ij=rpp(iteli,itelj)
1917 xj=c(1,j)+0.5D0*dxj-xmedi
1918 yj=c(2,j)+0.5D0*dyj-ymedi
1919 zj=c(3,j)+0.5D0*dzj-zmedi
1920 rij=xj*xj+yj*yj+zj*zj
1921 if (rij.lt.r0ijsq) then
1922 evdw1ij=0.25d0*(rij-r0ijsq)**2
1930 C Calculate contributions to the Cartesian gradient.
1936 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1937 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1940 * Loop over residues i+1 thru j-1.
1944 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1949 cgrad do i=nnt,nct-1
1951 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1953 cgrad do j=i+1,nct-1
1955 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1961 c------------------------------------------------------------------------------
1962 subroutine vec_and_deriv
1963 implicit real*8 (a-h,o-z)
1964 include 'DIMENSIONS'
1968 include 'COMMON.IOUNITS'
1969 include 'COMMON.GEO'
1970 include 'COMMON.VAR'
1971 include 'COMMON.LOCAL'
1972 include 'COMMON.CHAIN'
1973 include 'COMMON.VECTORS'
1974 include 'COMMON.SETUP'
1975 include 'COMMON.TIME1'
1976 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1977 C Compute the local reference systems. For reference system (i), the
1978 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1979 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1981 do i=ivec_start,ivec_end
1985 if (i.eq.nres-1) then
1986 C Case of the last full residue
1987 C Compute the Z-axis
1988 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1989 costh=dcos(pi-theta(nres))
1990 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1994 C Compute the derivatives of uz
1996 uzder(2,1,1)=-dc_norm(3,i-1)
1997 uzder(3,1,1)= dc_norm(2,i-1)
1998 uzder(1,2,1)= dc_norm(3,i-1)
2000 uzder(3,2,1)=-dc_norm(1,i-1)
2001 uzder(1,3,1)=-dc_norm(2,i-1)
2002 uzder(2,3,1)= dc_norm(1,i-1)
2005 uzder(2,1,2)= dc_norm(3,i)
2006 uzder(3,1,2)=-dc_norm(2,i)
2007 uzder(1,2,2)=-dc_norm(3,i)
2009 uzder(3,2,2)= dc_norm(1,i)
2010 uzder(1,3,2)= dc_norm(2,i)
2011 uzder(2,3,2)=-dc_norm(1,i)
2013 C Compute the Y-axis
2016 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2018 C Compute the derivatives of uy
2021 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2022 & -dc_norm(k,i)*dc_norm(j,i-1)
2023 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2025 uyder(j,j,1)=uyder(j,j,1)-costh
2026 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2031 uygrad(l,k,j,i)=uyder(l,k,j)
2032 uzgrad(l,k,j,i)=uzder(l,k,j)
2036 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2037 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2038 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2039 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2042 C Compute the Z-axis
2043 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2044 costh=dcos(pi-theta(i+2))
2045 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2049 C Compute the derivatives of uz
2051 uzder(2,1,1)=-dc_norm(3,i+1)
2052 uzder(3,1,1)= dc_norm(2,i+1)
2053 uzder(1,2,1)= dc_norm(3,i+1)
2055 uzder(3,2,1)=-dc_norm(1,i+1)
2056 uzder(1,3,1)=-dc_norm(2,i+1)
2057 uzder(2,3,1)= dc_norm(1,i+1)
2060 uzder(2,1,2)= dc_norm(3,i)
2061 uzder(3,1,2)=-dc_norm(2,i)
2062 uzder(1,2,2)=-dc_norm(3,i)
2064 uzder(3,2,2)= dc_norm(1,i)
2065 uzder(1,3,2)= dc_norm(2,i)
2066 uzder(2,3,2)=-dc_norm(1,i)
2068 C Compute the Y-axis
2071 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2073 C Compute the derivatives of uy
2076 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2077 & -dc_norm(k,i)*dc_norm(j,i+1)
2078 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2080 uyder(j,j,1)=uyder(j,j,1)-costh
2081 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2086 uygrad(l,k,j,i)=uyder(l,k,j)
2087 uzgrad(l,k,j,i)=uzder(l,k,j)
2091 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2092 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2093 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2094 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2098 vbld_inv_temp(1)=vbld_inv(i+1)
2099 if (i.lt.nres-1) then
2100 vbld_inv_temp(2)=vbld_inv(i+2)
2102 vbld_inv_temp(2)=vbld_inv(i)
2107 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2108 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2113 #if defined(PARVEC) && defined(MPI)
2114 if (nfgtasks1.gt.1) then
2116 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2117 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2118 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2119 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2120 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2122 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2123 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2125 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2126 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2127 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2128 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2129 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2130 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2131 time_gather=time_gather+MPI_Wtime()-time00
2133 c if (fg_rank.eq.0) then
2134 c write (iout,*) "Arrays UY and UZ"
2136 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2143 C-----------------------------------------------------------------------------
2144 subroutine check_vecgrad
2145 implicit real*8 (a-h,o-z)
2146 include 'DIMENSIONS'
2147 include 'COMMON.IOUNITS'
2148 include 'COMMON.GEO'
2149 include 'COMMON.VAR'
2150 include 'COMMON.LOCAL'
2151 include 'COMMON.CHAIN'
2152 include 'COMMON.VECTORS'
2153 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2154 dimension uyt(3,maxres),uzt(3,maxres)
2155 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2156 double precision delta /1.0d-7/
2159 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2160 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2161 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2162 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2163 cd & (dc_norm(if90,i),if90=1,3)
2164 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2165 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2166 cd write(iout,'(a)')
2172 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2173 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2186 cd write (iout,*) 'i=',i
2188 erij(k)=dc_norm(k,i)
2192 dc_norm(k,i)=erij(k)
2194 dc_norm(j,i)=dc_norm(j,i)+delta
2195 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2197 c dc_norm(k,i)=dc_norm(k,i)/fac
2199 c write (iout,*) (dc_norm(k,i),k=1,3)
2200 c write (iout,*) (erij(k),k=1,3)
2203 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2204 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2205 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2206 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2208 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2209 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2210 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2213 dc_norm(k,i)=erij(k)
2216 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2217 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2218 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2219 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2220 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2221 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2222 cd write (iout,'(a)')
2227 C--------------------------------------------------------------------------
2228 subroutine set_matrices
2229 implicit real*8 (a-h,o-z)
2230 include 'DIMENSIONS'
2233 include "COMMON.SETUP"
2235 integer status(MPI_STATUS_SIZE)
2237 include 'COMMON.IOUNITS'
2238 include 'COMMON.GEO'
2239 include 'COMMON.VAR'
2240 include 'COMMON.LOCAL'
2241 include 'COMMON.CHAIN'
2242 include 'COMMON.DERIV'
2243 include 'COMMON.INTERACT'
2244 include 'COMMON.CONTACTS'
2245 include 'COMMON.TORSION'
2246 include 'COMMON.VECTORS'
2247 include 'COMMON.FFIELD'
2248 double precision auxvec(2),auxmat(2,2)
2250 C Compute the virtual-bond-torsional-angle dependent quantities needed
2251 C to calculate the el-loc multibody terms of various order.
2254 do i=ivec_start+2,ivec_end+2
2258 if (i .lt. nres+1) then
2295 if (i .gt. 3 .and. i .lt. nres+1) then
2296 obrot_der(1,i-2)=-sin1
2297 obrot_der(2,i-2)= cos1
2298 Ugder(1,1,i-2)= sin1
2299 Ugder(1,2,i-2)=-cos1
2300 Ugder(2,1,i-2)=-cos1
2301 Ugder(2,2,i-2)=-sin1
2304 obrot2_der(1,i-2)=-dwasin2
2305 obrot2_der(2,i-2)= dwacos2
2306 Ug2der(1,1,i-2)= dwasin2
2307 Ug2der(1,2,i-2)=-dwacos2
2308 Ug2der(2,1,i-2)=-dwacos2
2309 Ug2der(2,2,i-2)=-dwasin2
2311 obrot_der(1,i-2)=0.0d0
2312 obrot_der(2,i-2)=0.0d0
2313 Ugder(1,1,i-2)=0.0d0
2314 Ugder(1,2,i-2)=0.0d0
2315 Ugder(2,1,i-2)=0.0d0
2316 Ugder(2,2,i-2)=0.0d0
2317 obrot2_der(1,i-2)=0.0d0
2318 obrot2_der(2,i-2)=0.0d0
2319 Ug2der(1,1,i-2)=0.0d0
2320 Ug2der(1,2,i-2)=0.0d0
2321 Ug2der(2,1,i-2)=0.0d0
2322 Ug2der(2,2,i-2)=0.0d0
2324 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2325 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2326 iti = itortyp(itype(i-2))
2330 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2331 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2332 iti1 = itortyp(itype(i-1))
2336 cd write (iout,*) '*******i',i,' iti1',iti
2337 cd write (iout,*) 'b1',b1(:,iti)
2338 cd write (iout,*) 'b2',b2(:,iti)
2339 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2340 c if (i .gt. iatel_s+2) then
2341 if (i .gt. nnt+2) then
2342 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2343 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2344 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2346 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2347 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2348 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2349 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2350 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2361 DtUg2(l,k,i-2)=0.0d0
2365 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2366 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2368 muder(k,i-2)=Ub2der(k,i-2)
2370 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2371 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2372 iti1 = itortyp(itype(i-1))
2377 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2379 cd write (iout,*) 'mu ',mu(:,i-2)
2380 cd write (iout,*) 'mu1',mu1(:,i-2)
2381 cd write (iout,*) 'mu2',mu2(:,i-2)
2382 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2384 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2385 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2386 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2387 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2388 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2389 C Vectors and matrices dependent on a single virtual-bond dihedral.
2390 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2391 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2392 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2393 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2394 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2395 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2396 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2397 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2398 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2401 C Matrices dependent on two consecutive virtual-bond dihedrals.
2402 C The order of matrices is from left to right.
2403 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2405 c do i=max0(ivec_start,2),ivec_end
2407 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2408 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2409 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2410 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2411 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2412 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2413 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2414 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2417 #if defined(MPI) && defined(PARMAT)
2419 c if (fg_rank.eq.0) then
2420 write (iout,*) "Arrays UG and UGDER before GATHER"
2422 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2423 & ((ug(l,k,i),l=1,2),k=1,2),
2424 & ((ugder(l,k,i),l=1,2),k=1,2)
2426 write (iout,*) "Arrays UG2 and UG2DER"
2428 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2429 & ((ug2(l,k,i),l=1,2),k=1,2),
2430 & ((ug2der(l,k,i),l=1,2),k=1,2)
2432 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2434 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2435 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2436 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2438 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2440 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2441 & costab(i),sintab(i),costab2(i),sintab2(i)
2443 write (iout,*) "Array MUDER"
2445 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2449 if (nfgtasks.gt.1) then
2451 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2452 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2453 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2455 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2456 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2458 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2459 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2461 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2462 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2464 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2465 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2467 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2468 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2470 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2471 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2473 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2474 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2475 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2476 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2477 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2478 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2479 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2480 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2481 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2482 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2483 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2484 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2485 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2487 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2488 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2490 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2491 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2493 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2494 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2496 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2497 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2499 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2500 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2502 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2503 & ivec_count(fg_rank1),
2504 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2506 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2509 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2510 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2512 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2515 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2516 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2518 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2519 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2521 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2524 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2527 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2528 & ivec_count(fg_rank1),
2529 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2531 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2532 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2534 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2535 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2537 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2538 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2540 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2543 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2544 & ivec_count(fg_rank1),
2545 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2547 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2548 & ivec_count(fg_rank1),
2549 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2551 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2552 & ivec_count(fg_rank1),
2553 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2554 & MPI_MAT2,FG_COMM1,IERR)
2555 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2556 & ivec_count(fg_rank1),
2557 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2558 & MPI_MAT2,FG_COMM1,IERR)
2561 c Passes matrix info through the ring
2564 if (irecv.lt.0) irecv=nfgtasks1-1
2567 if (inext.ge.nfgtasks1) inext=0
2569 c write (iout,*) "isend",isend," irecv",irecv
2571 lensend=lentyp(isend)
2572 lenrecv=lentyp(irecv)
2573 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2574 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2575 c & MPI_ROTAT1(lensend),inext,2200+isend,
2576 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2577 c & iprev,2200+irecv,FG_COMM,status,IERR)
2578 c write (iout,*) "Gather ROTAT1"
2580 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2581 c & MPI_ROTAT2(lensend),inext,3300+isend,
2582 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2583 c & iprev,3300+irecv,FG_COMM,status,IERR)
2584 c write (iout,*) "Gather ROTAT2"
2586 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2587 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2588 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2589 & iprev,4400+irecv,FG_COMM,status,IERR)
2590 c write (iout,*) "Gather ROTAT_OLD"
2592 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2593 & MPI_PRECOMP11(lensend),inext,5500+isend,
2594 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2595 & iprev,5500+irecv,FG_COMM,status,IERR)
2596 c write (iout,*) "Gather PRECOMP11"
2598 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2599 & MPI_PRECOMP12(lensend),inext,6600+isend,
2600 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2601 & iprev,6600+irecv,FG_COMM,status,IERR)
2602 c write (iout,*) "Gather PRECOMP12"
2604 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2606 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2607 & MPI_ROTAT2(lensend),inext,7700+isend,
2608 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2609 & iprev,7700+irecv,FG_COMM,status,IERR)
2610 c write (iout,*) "Gather PRECOMP21"
2612 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2613 & MPI_PRECOMP22(lensend),inext,8800+isend,
2614 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2615 & iprev,8800+irecv,FG_COMM,status,IERR)
2616 c write (iout,*) "Gather PRECOMP22"
2618 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2619 & MPI_PRECOMP23(lensend),inext,9900+isend,
2620 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2621 & MPI_PRECOMP23(lenrecv),
2622 & iprev,9900+irecv,FG_COMM,status,IERR)
2623 c write (iout,*) "Gather PRECOMP23"
2628 if (irecv.lt.0) irecv=nfgtasks1-1
2631 time_gather=time_gather+MPI_Wtime()-time00
2634 c if (fg_rank.eq.0) then
2635 write (iout,*) "Arrays UG and UGDER"
2637 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2638 & ((ug(l,k,i),l=1,2),k=1,2),
2639 & ((ugder(l,k,i),l=1,2),k=1,2)
2641 write (iout,*) "Arrays UG2 and UG2DER"
2643 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2644 & ((ug2(l,k,i),l=1,2),k=1,2),
2645 & ((ug2der(l,k,i),l=1,2),k=1,2)
2647 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2649 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2650 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2651 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2653 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2655 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2656 & costab(i),sintab(i),costab2(i),sintab2(i)
2658 write (iout,*) "Array MUDER"
2660 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2666 cd iti = itortyp(itype(i))
2669 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2670 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2675 C--------------------------------------------------------------------------
2676 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2678 C This subroutine calculates the average interaction energy and its gradient
2679 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2680 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2681 C The potential depends both on the distance of peptide-group centers and on
2682 C the orientation of the CA-CA virtual bonds.
2684 implicit real*8 (a-h,o-z)
2688 include 'DIMENSIONS'
2689 include 'COMMON.CONTROL'
2690 include 'COMMON.SETUP'
2691 include 'COMMON.IOUNITS'
2692 include 'COMMON.GEO'
2693 include 'COMMON.VAR'
2694 include 'COMMON.LOCAL'
2695 include 'COMMON.CHAIN'
2696 include 'COMMON.DERIV'
2697 include 'COMMON.INTERACT'
2698 include 'COMMON.CONTACTS'
2699 include 'COMMON.TORSION'
2700 include 'COMMON.VECTORS'
2701 include 'COMMON.FFIELD'
2702 include 'COMMON.TIME1'
2703 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2704 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2705 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2706 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2707 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2708 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2710 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2712 double precision scal_el /1.0d0/
2714 double precision scal_el /0.5d0/
2717 C 13-go grudnia roku pamietnego...
2718 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2719 & 0.0d0,1.0d0,0.0d0,
2720 & 0.0d0,0.0d0,1.0d0/
2721 cd write(iout,*) 'In EELEC'
2723 cd write(iout,*) 'Type',i
2724 cd write(iout,*) 'B1',B1(:,i)
2725 cd write(iout,*) 'B2',B2(:,i)
2726 cd write(iout,*) 'CC',CC(:,:,i)
2727 cd write(iout,*) 'DD',DD(:,:,i)
2728 cd write(iout,*) 'EE',EE(:,:,i)
2730 cd call check_vecgrad
2732 if (icheckgrad.eq.1) then
2734 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2736 dc_norm(k,i)=dc(k,i)*fac
2738 c write (iout,*) 'i',i,' fac',fac
2741 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2742 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2743 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2744 c call vec_and_deriv
2750 time_mat=time_mat+MPI_Wtime()-time01
2754 cd write (iout,*) 'i=',i
2756 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2759 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2760 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2773 cd print '(a)','Enter EELEC'
2774 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2776 gel_loc_loc(i)=0.0d0
2781 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2783 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2785 do i=iturn3_start,iturn3_end
2786 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2787 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2791 dx_normi=dc_norm(1,i)
2792 dy_normi=dc_norm(2,i)
2793 dz_normi=dc_norm(3,i)
2794 xmedi=c(1,i)+0.5d0*dxi
2795 ymedi=c(2,i)+0.5d0*dyi
2796 zmedi=c(3,i)+0.5d0*dzi
2798 call eelecij(i,i+2,ees,evdw1,eel_loc)
2799 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2800 num_cont_hb(i)=num_conti
2802 do i=iturn4_start,iturn4_end
2803 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2804 & .or. itype(i+3).eq.ntyp1
2805 & .or. itype(i+4).eq.ntyp1) cycle
2809 dx_normi=dc_norm(1,i)
2810 dy_normi=dc_norm(2,i)
2811 dz_normi=dc_norm(3,i)
2812 xmedi=c(1,i)+0.5d0*dxi
2813 ymedi=c(2,i)+0.5d0*dyi
2814 zmedi=c(3,i)+0.5d0*dzi
2815 num_conti=num_cont_hb(i)
2816 call eelecij(i,i+3,ees,evdw1,eel_loc)
2817 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2818 & call eturn4(i,eello_turn4)
2819 num_cont_hb(i)=num_conti
2822 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2824 do i=iatel_s,iatel_e
2825 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2829 dx_normi=dc_norm(1,i)
2830 dy_normi=dc_norm(2,i)
2831 dz_normi=dc_norm(3,i)
2832 xmedi=c(1,i)+0.5d0*dxi
2833 ymedi=c(2,i)+0.5d0*dyi
2834 zmedi=c(3,i)+0.5d0*dzi
2835 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2836 num_conti=num_cont_hb(i)
2837 do j=ielstart(i),ielend(i)
2838 c write (iout,*) i,j,itype(i),itype(j)
2839 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2840 call eelecij(i,j,ees,evdw1,eel_loc)
2842 num_cont_hb(i)=num_conti
2844 c write (iout,*) "Number of loop steps in EELEC:",ind
2846 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2847 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2849 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2850 ccc eel_loc=eel_loc+eello_turn3
2851 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2854 C-------------------------------------------------------------------------------
2855 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2856 implicit real*8 (a-h,o-z)
2857 include 'DIMENSIONS'
2861 include 'COMMON.CONTROL'
2862 include 'COMMON.IOUNITS'
2863 include 'COMMON.GEO'
2864 include 'COMMON.VAR'
2865 include 'COMMON.LOCAL'
2866 include 'COMMON.CHAIN'
2867 include 'COMMON.DERIV'
2868 include 'COMMON.INTERACT'
2869 include 'COMMON.CONTACTS'
2870 include 'COMMON.TORSION'
2871 include 'COMMON.VECTORS'
2872 include 'COMMON.FFIELD'
2873 include 'COMMON.TIME1'
2874 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2875 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2876 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2877 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2878 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2879 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2881 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2883 double precision scal_el /1.0d0/
2885 double precision scal_el /0.5d0/
2888 C 13-go grudnia roku pamietnego...
2889 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2890 & 0.0d0,1.0d0,0.0d0,
2891 & 0.0d0,0.0d0,1.0d0/
2892 c time00=MPI_Wtime()
2893 cd write (iout,*) "eelecij",i,j
2897 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2898 aaa=app(iteli,itelj)
2899 bbb=bpp(iteli,itelj)
2900 ael6i=ael6(iteli,itelj)
2901 ael3i=ael3(iteli,itelj)
2905 dx_normj=dc_norm(1,j)
2906 dy_normj=dc_norm(2,j)
2907 dz_normj=dc_norm(3,j)
2908 xj=c(1,j)+0.5D0*dxj-xmedi
2909 yj=c(2,j)+0.5D0*dyj-ymedi
2910 zj=c(3,j)+0.5D0*dzj-zmedi
2911 rij=xj*xj+yj*yj+zj*zj
2917 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2918 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2919 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2920 fac=cosa-3.0D0*cosb*cosg
2922 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2923 if (j.eq.i+2) ev1=scal_el*ev1
2928 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2931 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2932 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2935 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2936 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2937 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2938 cd & xmedi,ymedi,zmedi,xj,yj,zj
2940 if (energy_dec) then
2941 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2942 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2946 C Calculate contributions to the Cartesian gradient.
2949 facvdw=-6*rrmij*(ev1+evdwij)
2950 facel=-3*rrmij*(el1+eesij)
2956 * Radial derivatives. First process both termini of the fragment (i,j)
2962 c ghalf=0.5D0*ggg(k)
2963 c gelc(k,i)=gelc(k,i)+ghalf
2964 c gelc(k,j)=gelc(k,j)+ghalf
2966 c 9/28/08 AL Gradient compotents will be summed only at the end
2968 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2969 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2972 * Loop over residues i+1 thru j-1.
2976 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2983 c ghalf=0.5D0*ggg(k)
2984 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2985 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2987 c 9/28/08 AL Gradient compotents will be summed only at the end
2989 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2990 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2993 * Loop over residues i+1 thru j-1.
2997 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3004 fac=-3*rrmij*(facvdw+facvdw+facel)
3009 * Radial derivatives. First process both termini of the fragment (i,j)
3015 c ghalf=0.5D0*ggg(k)
3016 c gelc(k,i)=gelc(k,i)+ghalf
3017 c gelc(k,j)=gelc(k,j)+ghalf
3019 c 9/28/08 AL Gradient compotents will be summed only at the end
3021 gelc_long(k,j)=gelc(k,j)+ggg(k)
3022 gelc_long(k,i)=gelc(k,i)-ggg(k)
3025 * Loop over residues i+1 thru j-1.
3029 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3032 c 9/28/08 AL Gradient compotents will be summed only at the end
3037 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3038 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3044 ecosa=2.0D0*fac3*fac1+fac4
3047 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3048 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3050 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3051 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3053 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3054 cd & (dcosg(k),k=1,3)
3056 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3059 c ghalf=0.5D0*ggg(k)
3060 c gelc(k,i)=gelc(k,i)+ghalf
3061 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3062 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3063 c gelc(k,j)=gelc(k,j)+ghalf
3064 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3065 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3069 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3074 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3075 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3077 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3078 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3079 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3080 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3082 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3083 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3084 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3086 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3087 C energy of a peptide unit is assumed in the form of a second-order
3088 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3089 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3090 C are computed for EVERY pair of non-contiguous peptide groups.
3092 if (j.lt.nres-1) then
3103 muij(kkk)=mu(k,i)*mu(l,j)
3106 cd write (iout,*) 'EELEC: i',i,' j',j
3107 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3108 cd write(iout,*) 'muij',muij
3109 ury=scalar(uy(1,i),erij)
3110 urz=scalar(uz(1,i),erij)
3111 vry=scalar(uy(1,j),erij)
3112 vrz=scalar(uz(1,j),erij)
3113 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3114 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3115 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3116 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3117 fac=dsqrt(-ael6i)*r3ij
3122 cd write (iout,'(4i5,4f10.5)')
3123 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3124 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3125 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3126 cd & uy(:,j),uz(:,j)
3127 cd write (iout,'(4f10.5)')
3128 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3129 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3130 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3131 cd write (iout,'(9f10.5/)')
3132 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3133 C Derivatives of the elements of A in virtual-bond vectors
3134 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3136 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3137 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3138 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3139 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3140 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3141 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3142 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3143 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3144 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3145 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3146 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3147 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3149 C Compute radial contributions to the gradient
3167 C Add the contributions coming from er
3170 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3171 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3172 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3173 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3176 C Derivatives in DC(i)
3177 cgrad ghalf1=0.5d0*agg(k,1)
3178 cgrad ghalf2=0.5d0*agg(k,2)
3179 cgrad ghalf3=0.5d0*agg(k,3)
3180 cgrad ghalf4=0.5d0*agg(k,4)
3181 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3182 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3183 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3184 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3185 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3186 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3187 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3188 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3189 C Derivatives in DC(i+1)
3190 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3191 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3192 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3193 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3194 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3195 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3196 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3197 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3198 C Derivatives in DC(j)
3199 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3200 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3201 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3202 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3203 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3204 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3205 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3206 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3207 C Derivatives in DC(j+1) or DC(nres-1)
3208 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3209 & -3.0d0*vryg(k,3)*ury)
3210 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3211 & -3.0d0*vrzg(k,3)*ury)
3212 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3213 & -3.0d0*vryg(k,3)*urz)
3214 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3215 & -3.0d0*vrzg(k,3)*urz)
3216 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3218 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3231 aggi(k,l)=-aggi(k,l)
3232 aggi1(k,l)=-aggi1(k,l)
3233 aggj(k,l)=-aggj(k,l)
3234 aggj1(k,l)=-aggj1(k,l)
3237 if (j.lt.nres-1) then
3243 aggi(k,l)=-aggi(k,l)
3244 aggi1(k,l)=-aggi1(k,l)
3245 aggj(k,l)=-aggj(k,l)
3246 aggj1(k,l)=-aggj1(k,l)
3257 aggi(k,l)=-aggi(k,l)
3258 aggi1(k,l)=-aggi1(k,l)
3259 aggj(k,l)=-aggj(k,l)
3260 aggj1(k,l)=-aggj1(k,l)
3265 IF (wel_loc.gt.0.0d0) THEN
3266 C Contribution to the local-electrostatic energy coming from the i-j pair
3267 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3269 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3271 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3272 & 'eelloc',i,j,eel_loc_ij
3274 eel_loc=eel_loc+eel_loc_ij
3275 C Partial derivatives in virtual-bond dihedral angles gamma
3277 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3278 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3279 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3280 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3281 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3282 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3283 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3285 ggg(l)=agg(l,1)*muij(1)+
3286 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3287 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3288 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3289 cgrad ghalf=0.5d0*ggg(l)
3290 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3291 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3295 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3298 C Remaining derivatives of eello
3300 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3301 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3302 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3303 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3304 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3305 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3306 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3307 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3310 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3311 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3312 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3313 & .and. num_conti.le.maxconts) then
3314 c write (iout,*) i,j," entered corr"
3316 C Calculate the contact function. The ith column of the array JCONT will
3317 C contain the numbers of atoms that make contacts with the atom I (of numbers
3318 C greater than I). The arrays FACONT and GACONT will contain the values of
3319 C the contact function and its derivative.
3320 c r0ij=1.02D0*rpp(iteli,itelj)
3321 c r0ij=1.11D0*rpp(iteli,itelj)
3322 r0ij=2.20D0*rpp(iteli,itelj)
3323 c r0ij=1.55D0*rpp(iteli,itelj)
3324 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3325 if (fcont.gt.0.0D0) then
3326 num_conti=num_conti+1
3327 if (num_conti.gt.maxconts) then
3328 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3329 & ' will skip next contacts for this conf.'
3331 jcont_hb(num_conti,i)=j
3332 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3333 cd & " jcont_hb",jcont_hb(num_conti,i)
3334 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3335 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3336 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3338 d_cont(num_conti,i)=rij
3339 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3340 C --- Electrostatic-interaction matrix ---
3341 a_chuj(1,1,num_conti,i)=a22
3342 a_chuj(1,2,num_conti,i)=a23
3343 a_chuj(2,1,num_conti,i)=a32
3344 a_chuj(2,2,num_conti,i)=a33
3345 C --- Gradient of rij
3347 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3354 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3355 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3356 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3357 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3358 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3363 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3364 C Calculate contact energies
3366 wij=cosa-3.0D0*cosb*cosg
3369 c fac3=dsqrt(-ael6i)/r0ij**3
3370 fac3=dsqrt(-ael6i)*r3ij
3371 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3372 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3373 if (ees0tmp.gt.0) then
3374 ees0pij=dsqrt(ees0tmp)
3378 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3379 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3380 if (ees0tmp.gt.0) then
3381 ees0mij=dsqrt(ees0tmp)
3386 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3387 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3388 C Diagnostics. Comment out or remove after debugging!
3389 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3390 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3391 c ees0m(num_conti,i)=0.0D0
3393 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3394 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3395 C Angular derivatives of the contact function
3396 ees0pij1=fac3/ees0pij
3397 ees0mij1=fac3/ees0mij
3398 fac3p=-3.0D0*fac3*rrmij
3399 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3400 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3402 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3403 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3404 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3405 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3406 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3407 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3408 ecosap=ecosa1+ecosa2
3409 ecosbp=ecosb1+ecosb2
3410 ecosgp=ecosg1+ecosg2
3411 ecosam=ecosa1-ecosa2
3412 ecosbm=ecosb1-ecosb2
3413 ecosgm=ecosg1-ecosg2
3422 facont_hb(num_conti,i)=fcont
3423 fprimcont=fprimcont/rij
3424 cd facont_hb(num_conti,i)=1.0D0
3425 C Following line is for diagnostics.
3428 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3429 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3432 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3433 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3435 gggp(1)=gggp(1)+ees0pijp*xj
3436 gggp(2)=gggp(2)+ees0pijp*yj
3437 gggp(3)=gggp(3)+ees0pijp*zj
3438 gggm(1)=gggm(1)+ees0mijp*xj
3439 gggm(2)=gggm(2)+ees0mijp*yj
3440 gggm(3)=gggm(3)+ees0mijp*zj
3441 C Derivatives due to the contact function
3442 gacont_hbr(1,num_conti,i)=fprimcont*xj
3443 gacont_hbr(2,num_conti,i)=fprimcont*yj
3444 gacont_hbr(3,num_conti,i)=fprimcont*zj
3447 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3448 c following the change of gradient-summation algorithm.
3450 cgrad ghalfp=0.5D0*gggp(k)
3451 cgrad ghalfm=0.5D0*gggm(k)
3452 gacontp_hb1(k,num_conti,i)=!ghalfp
3453 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3454 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3455 gacontp_hb2(k,num_conti,i)=!ghalfp
3456 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3457 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3458 gacontp_hb3(k,num_conti,i)=gggp(k)
3459 gacontm_hb1(k,num_conti,i)=!ghalfm
3460 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3461 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3462 gacontm_hb2(k,num_conti,i)=!ghalfm
3463 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3464 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3465 gacontm_hb3(k,num_conti,i)=gggm(k)
3467 C Diagnostics. Comment out or remove after debugging!
3469 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3470 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3471 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3472 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3473 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3474 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3477 endif ! num_conti.le.maxconts
3480 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3483 ghalf=0.5d0*agg(l,k)
3484 aggi(l,k)=aggi(l,k)+ghalf
3485 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3486 aggj(l,k)=aggj(l,k)+ghalf
3489 if (j.eq.nres-1 .and. i.lt.j-2) then
3492 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3497 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3500 C-----------------------------------------------------------------------------
3501 subroutine eturn3(i,eello_turn3)
3502 C Third- and fourth-order contributions from turns
3503 implicit real*8 (a-h,o-z)
3504 include 'DIMENSIONS'
3505 include 'COMMON.IOUNITS'
3506 include 'COMMON.GEO'
3507 include 'COMMON.VAR'
3508 include 'COMMON.LOCAL'
3509 include 'COMMON.CHAIN'
3510 include 'COMMON.DERIV'
3511 include 'COMMON.INTERACT'
3512 include 'COMMON.CONTACTS'
3513 include 'COMMON.TORSION'
3514 include 'COMMON.VECTORS'
3515 include 'COMMON.FFIELD'
3516 include 'COMMON.CONTROL'
3518 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3519 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3520 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3521 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3522 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3523 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3524 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3527 c write (iout,*) "eturn3",i,j,j1,j2
3532 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3534 C Third-order contributions
3541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3542 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3543 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3544 call transpose2(auxmat(1,1),auxmat1(1,1))
3545 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3546 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3547 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3548 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3549 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3550 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3551 cd & ' eello_turn3_num',4*eello_turn3_num
3552 C Derivatives in gamma(i)
3553 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3554 call transpose2(auxmat2(1,1),auxmat3(1,1))
3555 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3556 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3557 C Derivatives in gamma(i+1)
3558 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3559 call transpose2(auxmat2(1,1),auxmat3(1,1))
3560 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3561 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3562 & +0.5d0*(pizda(1,1)+pizda(2,2))
3563 C Cartesian derivatives
3565 c ghalf1=0.5d0*agg(l,1)
3566 c ghalf2=0.5d0*agg(l,2)
3567 c ghalf3=0.5d0*agg(l,3)
3568 c ghalf4=0.5d0*agg(l,4)
3569 a_temp(1,1)=aggi(l,1)!+ghalf1
3570 a_temp(1,2)=aggi(l,2)!+ghalf2
3571 a_temp(2,1)=aggi(l,3)!+ghalf3
3572 a_temp(2,2)=aggi(l,4)!+ghalf4
3573 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3574 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3575 & +0.5d0*(pizda(1,1)+pizda(2,2))
3576 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3577 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3578 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3579 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3580 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3581 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3582 & +0.5d0*(pizda(1,1)+pizda(2,2))
3583 a_temp(1,1)=aggj(l,1)!+ghalf1
3584 a_temp(1,2)=aggj(l,2)!+ghalf2
3585 a_temp(2,1)=aggj(l,3)!+ghalf3
3586 a_temp(2,2)=aggj(l,4)!+ghalf4
3587 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3588 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3589 & +0.5d0*(pizda(1,1)+pizda(2,2))
3590 a_temp(1,1)=aggj1(l,1)
3591 a_temp(1,2)=aggj1(l,2)
3592 a_temp(2,1)=aggj1(l,3)
3593 a_temp(2,2)=aggj1(l,4)
3594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3595 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3596 & +0.5d0*(pizda(1,1)+pizda(2,2))
3600 C-------------------------------------------------------------------------------
3601 subroutine eturn4(i,eello_turn4)
3602 C Third- and fourth-order contributions from turns
3603 implicit real*8 (a-h,o-z)
3604 include 'DIMENSIONS'
3605 include 'COMMON.IOUNITS'
3606 include 'COMMON.GEO'
3607 include 'COMMON.VAR'
3608 include 'COMMON.LOCAL'
3609 include 'COMMON.CHAIN'
3610 include 'COMMON.DERIV'
3611 include 'COMMON.INTERACT'
3612 include 'COMMON.CONTACTS'
3613 include 'COMMON.TORSION'
3614 include 'COMMON.VECTORS'
3615 include 'COMMON.FFIELD'
3616 include 'COMMON.CONTROL'
3618 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3619 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3620 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3621 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3622 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3623 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3624 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3627 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3629 C Fourth-order contributions
3637 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3638 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3639 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3644 iti1=itortyp(itype(i+1))
3645 iti2=itortyp(itype(i+2))
3646 iti3=itortyp(itype(i+3))
3647 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3648 call transpose2(EUg(1,1,i+1),e1t(1,1))
3649 call transpose2(Eug(1,1,i+2),e2t(1,1))
3650 call transpose2(Eug(1,1,i+3),e3t(1,1))
3651 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3652 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3653 s1=scalar2(b1(1,iti2),auxvec(1))
3654 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3655 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3656 s2=scalar2(b1(1,iti1),auxvec(1))
3657 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3658 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3659 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3660 eello_turn4=eello_turn4-(s1+s2+s3)
3661 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3662 & 'eturn4',i,j,-(s1+s2+s3)
3663 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3664 cd & ' eello_turn4_num',8*eello_turn4_num
3665 C Derivatives in gamma(i)
3666 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3667 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3668 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3669 s1=scalar2(b1(1,iti2),auxvec(1))
3670 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3671 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3672 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3673 C Derivatives in gamma(i+1)
3674 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3675 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3676 s2=scalar2(b1(1,iti1),auxvec(1))
3677 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3678 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3679 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3680 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3681 C Derivatives in gamma(i+2)
3682 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3683 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3684 s1=scalar2(b1(1,iti2),auxvec(1))
3685 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3686 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3687 s2=scalar2(b1(1,iti1),auxvec(1))
3688 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3689 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3690 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3691 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3692 C Cartesian derivatives
3693 C Derivatives of this turn contributions in DC(i+2)
3694 if (j.lt.nres-1) then
3696 a_temp(1,1)=agg(l,1)
3697 a_temp(1,2)=agg(l,2)
3698 a_temp(2,1)=agg(l,3)
3699 a_temp(2,2)=agg(l,4)
3700 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3701 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3702 s1=scalar2(b1(1,iti2),auxvec(1))
3703 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3704 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3705 s2=scalar2(b1(1,iti1),auxvec(1))
3706 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3707 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3708 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3710 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3713 C Remaining derivatives of this turn contribution
3715 a_temp(1,1)=aggi(l,1)
3716 a_temp(1,2)=aggi(l,2)
3717 a_temp(2,1)=aggi(l,3)
3718 a_temp(2,2)=aggi(l,4)
3719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3724 s2=scalar2(b1(1,iti1),auxvec(1))
3725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3728 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3729 a_temp(1,1)=aggi1(l,1)
3730 a_temp(1,2)=aggi1(l,2)
3731 a_temp(2,1)=aggi1(l,3)
3732 a_temp(2,2)=aggi1(l,4)
3733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3735 s1=scalar2(b1(1,iti2),auxvec(1))
3736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3738 s2=scalar2(b1(1,iti1),auxvec(1))
3739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3742 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3743 a_temp(1,1)=aggj(l,1)
3744 a_temp(1,2)=aggj(l,2)
3745 a_temp(2,1)=aggj(l,3)
3746 a_temp(2,2)=aggj(l,4)
3747 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3748 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3749 s1=scalar2(b1(1,iti2),auxvec(1))
3750 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3751 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3752 s2=scalar2(b1(1,iti1),auxvec(1))
3753 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3754 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3755 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3756 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3757 a_temp(1,1)=aggj1(l,1)
3758 a_temp(1,2)=aggj1(l,2)
3759 a_temp(2,1)=aggj1(l,3)
3760 a_temp(2,2)=aggj1(l,4)
3761 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3762 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3763 s1=scalar2(b1(1,iti2),auxvec(1))
3764 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3765 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3766 s2=scalar2(b1(1,iti1),auxvec(1))
3767 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3768 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3769 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3770 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3771 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3775 C-----------------------------------------------------------------------------
3776 subroutine vecpr(u,v,w)
3777 implicit real*8(a-h,o-z)
3778 dimension u(3),v(3),w(3)
3779 w(1)=u(2)*v(3)-u(3)*v(2)
3780 w(2)=-u(1)*v(3)+u(3)*v(1)
3781 w(3)=u(1)*v(2)-u(2)*v(1)
3784 C-----------------------------------------------------------------------------
3785 subroutine unormderiv(u,ugrad,unorm,ungrad)
3786 C This subroutine computes the derivatives of a normalized vector u, given
3787 C the derivatives computed without normalization conditions, ugrad. Returns
3790 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3791 double precision vec(3)
3792 double precision scalar
3794 c write (2,*) 'ugrad',ugrad
3797 vec(i)=scalar(ugrad(1,i),u(1))
3799 c write (2,*) 'vec',vec
3802 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3805 c write (2,*) 'ungrad',ungrad
3808 C-----------------------------------------------------------------------------
3809 subroutine escp_soft_sphere(evdw2,evdw2_14)
3811 C This subroutine calculates the excluded-volume interaction energy between
3812 C peptide-group centers and side chains and its gradient in virtual-bond and
3813 C side-chain vectors.
3815 implicit real*8 (a-h,o-z)
3816 include 'DIMENSIONS'
3817 include 'COMMON.GEO'
3818 include 'COMMON.VAR'
3819 include 'COMMON.LOCAL'
3820 include 'COMMON.CHAIN'
3821 include 'COMMON.DERIV'
3822 include 'COMMON.INTERACT'
3823 include 'COMMON.FFIELD'
3824 include 'COMMON.IOUNITS'
3825 include 'COMMON.CONTROL'
3830 cd print '(a)','Enter ESCP'
3831 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3832 do i=iatscp_s,iatscp_e
3833 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3835 xi=0.5D0*(c(1,i)+c(1,i+1))
3836 yi=0.5D0*(c(2,i)+c(2,i+1))
3837 zi=0.5D0*(c(3,i)+c(3,i+1))
3839 do iint=1,nscp_gr(i)
3841 do j=iscpstart(i,iint),iscpend(i,iint)
3842 if (itype(j).eq.ntyp1) cycle
3843 itypj=iabs(itype(j))
3844 C Uncomment following three lines for SC-p interactions
3848 C Uncomment following three lines for Ca-p interactions
3852 rij=xj*xj+yj*yj+zj*zj
3855 if (rij.lt.r0ijsq) then
3856 evdwij=0.25d0*(rij-r0ijsq)**2
3864 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3869 cgrad if (j.lt.i) then
3870 cd write (iout,*) 'j<i'
3871 C Uncomment following three lines for SC-p interactions
3873 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3876 cd write (iout,*) 'j>i'
3878 cgrad ggg(k)=-ggg(k)
3879 C Uncomment following line for SC-p interactions
3880 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3884 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3886 cgrad kstart=min0(i+1,j)
3887 cgrad kend=max0(i-1,j-1)
3888 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3889 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3890 cgrad do k=kstart,kend
3892 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3896 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3897 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3905 C-----------------------------------------------------------------------------
3906 subroutine escp(evdw2,evdw2_14)
3908 C This subroutine calculates the excluded-volume interaction energy between
3909 C peptide-group centers and side chains and its gradient in virtual-bond and
3910 C side-chain vectors.
3912 implicit real*8 (a-h,o-z)
3913 include 'DIMENSIONS'
3914 include 'COMMON.GEO'
3915 include 'COMMON.VAR'
3916 include 'COMMON.LOCAL'
3917 include 'COMMON.CHAIN'
3918 include 'COMMON.DERIV'
3919 include 'COMMON.INTERACT'
3920 include 'COMMON.FFIELD'
3921 include 'COMMON.IOUNITS'
3922 include 'COMMON.CONTROL'
3926 cd print '(a)','Enter ESCP'
3927 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3928 do i=iatscp_s,iatscp_e
3929 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3931 xi=0.5D0*(c(1,i)+c(1,i+1))
3932 yi=0.5D0*(c(2,i)+c(2,i+1))
3933 zi=0.5D0*(c(3,i)+c(3,i+1))
3935 do iint=1,nscp_gr(i)
3937 do j=iscpstart(i,iint),iscpend(i,iint)
3938 itypj=iabs(itype(j))
3939 if (itypj.eq.ntyp1) cycle
3940 C Uncomment following three lines for SC-p interactions
3944 C Uncomment following three lines for Ca-p interactions
3948 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3950 e1=fac*fac*aad(itypj,iteli)
3951 e2=fac*bad(itypj,iteli)
3952 if (iabs(j-i) .le. 2) then
3955 evdw2_14=evdw2_14+e1+e2
3959 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3960 & 'evdw2',i,j,evdwij
3962 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3964 fac=-(evdwij+e1)*rrij
3968 cgrad if (j.lt.i) then
3969 cd write (iout,*) 'j<i'
3970 C Uncomment following three lines for SC-p interactions
3972 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3975 cd write (iout,*) 'j>i'
3977 cgrad ggg(k)=-ggg(k)
3978 C Uncomment following line for SC-p interactions
3979 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3980 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3984 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3986 cgrad kstart=min0(i+1,j)
3987 cgrad kend=max0(i-1,j-1)
3988 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3989 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3990 cgrad do k=kstart,kend
3992 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3996 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3997 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4005 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4006 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4007 gradx_scp(j,i)=expon*gradx_scp(j,i)
4010 C******************************************************************************
4014 C To save time the factor EXPON has been extracted from ALL components
4015 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4018 C******************************************************************************
4021 C--------------------------------------------------------------------------
4022 subroutine edis(ehpb)
4024 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4026 implicit real*8 (a-h,o-z)
4027 include 'DIMENSIONS'
4028 include 'COMMON.SBRIDGE'
4029 include 'COMMON.CHAIN'
4030 include 'COMMON.DERIV'
4031 include 'COMMON.VAR'
4032 include 'COMMON.INTERACT'
4033 include 'COMMON.IOUNITS'
4036 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4037 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4038 if (link_end.eq.0) return
4039 do i=link_start,link_end
4040 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4041 C CA-CA distance used in regularization of structure.
4044 C iii and jjj point to the residues for which the distance is assigned.
4045 if (ii.gt.nres) then
4052 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4053 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4054 C distance and angle dependent SS bond potential.
4055 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4056 & iabs(itype(jjj)).eq.1) then
4057 call ssbond_ene(iii,jjj,eij)
4059 cd write (iout,*) "eij",eij
4061 C Calculate the distance between the two points and its difference from the
4065 C Get the force constant corresponding to this distance.
4067 C Calculate the contribution to energy.
4068 ehpb=ehpb+waga*rdis*rdis
4070 C Evaluate gradient.
4073 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4074 cd & ' waga=',waga,' fac=',fac
4076 ggg(j)=fac*(c(j,jj)-c(j,ii))
4078 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4079 C If this is a SC-SC distance, we need to calculate the contributions to the
4080 C Cartesian gradient in the SC vectors (ghpbx).
4083 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4084 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4087 cgrad do j=iii,jjj-1
4089 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4093 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4094 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4101 C--------------------------------------------------------------------------
4102 subroutine ssbond_ene(i,j,eij)
4104 C Calculate the distance and angle dependent SS-bond potential energy
4105 C using a free-energy function derived based on RHF/6-31G** ab initio
4106 C calculations of diethyl disulfide.
4108 C A. Liwo and U. Kozlowska, 11/24/03
4110 implicit real*8 (a-h,o-z)
4111 include 'DIMENSIONS'
4112 include 'COMMON.SBRIDGE'
4113 include 'COMMON.CHAIN'
4114 include 'COMMON.DERIV'
4115 include 'COMMON.LOCAL'
4116 include 'COMMON.INTERACT'
4117 include 'COMMON.VAR'
4118 include 'COMMON.IOUNITS'
4119 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4120 itypi=iabs(itype(i))
4124 dxi=dc_norm(1,nres+i)
4125 dyi=dc_norm(2,nres+i)
4126 dzi=dc_norm(3,nres+i)
4127 c dsci_inv=dsc_inv(itypi)
4128 dsci_inv=vbld_inv(nres+i)
4129 itypj=iabs(itype(j))
4130 c dscj_inv=dsc_inv(itypj)
4131 dscj_inv=vbld_inv(nres+j)
4135 dxj=dc_norm(1,nres+j)
4136 dyj=dc_norm(2,nres+j)
4137 dzj=dc_norm(3,nres+j)
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4143 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4144 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4145 om12=dxi*dxj+dyi*dyj+dzi*dzj
4147 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4148 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4154 deltat12=om2-om1+2.0d0
4156 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4157 & +akct*deltad*deltat12
4158 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4159 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4160 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4161 c & " deltat12",deltat12," eij",eij
4162 ed=2*akcm*deltad+akct*deltat12
4164 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4165 eom1=-2*akth*deltat1-pom1-om2*pom2
4166 eom2= 2*akth*deltat2+pom1-om1*pom2
4169 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4170 ghpbx(k,i)=ghpbx(k,i)-ggk
4171 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4172 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4173 ghpbx(k,j)=ghpbx(k,j)+ggk
4174 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4175 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4176 ghpbc(k,i)=ghpbc(k,i)-ggk
4177 ghpbc(k,j)=ghpbc(k,j)+ggk
4180 C Calculate the components of the gradient in DC and X
4184 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4189 C--------------------------------------------------------------------------
4190 subroutine ebond(estr)
4192 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4194 implicit real*8 (a-h,o-z)
4195 include 'DIMENSIONS'
4196 include 'COMMON.LOCAL'
4197 include 'COMMON.GEO'
4198 include 'COMMON.INTERACT'
4199 include 'COMMON.DERIV'
4200 include 'COMMON.VAR'
4201 include 'COMMON.CHAIN'
4202 include 'COMMON.IOUNITS'
4203 include 'COMMON.NAMES'
4204 include 'COMMON.FFIELD'
4205 include 'COMMON.CONTROL'
4206 include 'COMMON.SETUP'
4207 double precision u(3),ud(3)
4210 do i=ibondp_start,ibondp_end
4211 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4212 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4214 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4215 & *dc(j,i-1)/vbld(i)
4217 if (energy_dec) write(iout,*)
4218 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4220 diff = vbld(i)-vbldp0
4221 if (energy_dec) write (iout,*)
4222 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4225 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4227 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4230 estr=0.5d0*AKP*estr+estr1
4232 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4234 do i=ibond_start,ibond_end
4236 if (iti.ne.10 .and. iti.ne.ntyp1) then
4239 diff=vbld(i+nres)-vbldsc0(1,iti)
4240 if (energy_dec) write (iout,*)
4241 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4242 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4243 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4245 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4249 diff=vbld(i+nres)-vbldsc0(j,iti)
4250 ud(j)=aksc(j,iti)*diff
4251 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4265 uprod2=uprod2*u(k)*u(k)
4269 usumsqder=usumsqder+ud(j)*uprod2
4271 estr=estr+uprod/usum
4273 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4281 C--------------------------------------------------------------------------
4282 subroutine ebend(etheta)
4284 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4285 C angles gamma and its derivatives in consecutive thetas and gammas.
4287 implicit real*8 (a-h,o-z)
4288 include 'DIMENSIONS'
4289 include 'COMMON.LOCAL'
4290 include 'COMMON.GEO'
4291 include 'COMMON.INTERACT'
4292 include 'COMMON.DERIV'
4293 include 'COMMON.VAR'
4294 include 'COMMON.CHAIN'
4295 include 'COMMON.IOUNITS'
4296 include 'COMMON.NAMES'
4297 include 'COMMON.FFIELD'
4298 include 'COMMON.CONTROL'
4299 common /calcthet/ term1,term2,termm,diffak,ratak,
4300 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4301 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4302 double precision y(2),z(2)
4304 c time11=dexp(-2*time)
4307 c write (*,'(a,i2)') 'EBEND ICG=',icg
4308 do i=ithet_start,ithet_end
4309 if (itype(i-1).eq.ntyp1) cycle
4310 C Zero the energy function and its derivative at 0 or pi.
4311 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4313 ichir1=isign(1,itype(i-2))
4314 ichir2=isign(1,itype(i))
4315 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4316 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4317 if (itype(i-1).eq.10) then
4318 itype1=isign(10,itype(i-2))
4319 ichir11=isign(1,itype(i-2))
4320 ichir12=isign(1,itype(i-2))
4321 itype2=isign(10,itype(i))
4322 ichir21=isign(1,itype(i))
4323 ichir22=isign(1,itype(i))
4326 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4329 if (phii.ne.phii) phii=150.0
4339 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4342 if (phii1.ne.phii1) phii1=150.0
4354 C Calculate the "mean" value of theta from the part of the distribution
4355 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4356 C In following comments this theta will be referred to as t_c.
4357 thet_pred_mean=0.0d0
4359 athetk=athet(k,it,ichir1,ichir2)
4360 bthetk=bthet(k,it,ichir1,ichir2)
4362 athetk=athet(k,itype1,ichir11,ichir12)
4363 bthetk=bthet(k,itype2,ichir21,ichir22)
4365 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4367 dthett=thet_pred_mean*ssd
4368 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4369 C Derivatives of the "mean" values in gamma1 and gamma2.
4370 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4371 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4372 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4373 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4375 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4376 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4377 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4378 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4380 if (theta(i).gt.pi-delta) then
4381 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4383 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4384 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4385 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4387 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4389 else if (theta(i).lt.delta) then
4390 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4391 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4392 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4394 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4395 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4398 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4401 etheta=etheta+ethetai
4402 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4404 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4405 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4406 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4408 C Ufff.... We've done all this!!!
4411 C---------------------------------------------------------------------------
4412 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4414 implicit real*8 (a-h,o-z)
4415 include 'DIMENSIONS'
4416 include 'COMMON.LOCAL'
4417 include 'COMMON.IOUNITS'
4418 common /calcthet/ term1,term2,termm,diffak,ratak,
4419 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4420 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4421 C Calculate the contributions to both Gaussian lobes.
4422 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4423 C The "polynomial part" of the "standard deviation" of this part of
4427 sig=sig*thet_pred_mean+polthet(j,it)
4429 C Derivative of the "interior part" of the "standard deviation of the"
4430 C gamma-dependent Gaussian lobe in t_c.
4431 sigtc=3*polthet(3,it)
4433 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4436 C Set the parameters of both Gaussian lobes of the distribution.
4437 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4438 fac=sig*sig+sigc0(it)
4441 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4442 sigsqtc=-4.0D0*sigcsq*sigtc
4443 c print *,i,sig,sigtc,sigsqtc
4444 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4445 sigtc=-sigtc/(fac*fac)
4446 C Following variable is sigma(t_c)**(-2)
4447 sigcsq=sigcsq*sigcsq
4449 sig0inv=1.0D0/sig0i**2
4450 delthec=thetai-thet_pred_mean
4451 delthe0=thetai-theta0i
4452 term1=-0.5D0*sigcsq*delthec*delthec
4453 term2=-0.5D0*sig0inv*delthe0*delthe0
4454 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4455 C NaNs in taking the logarithm. We extract the largest exponent which is added
4456 C to the energy (this being the log of the distribution) at the end of energy
4457 C term evaluation for this virtual-bond angle.
4458 if (term1.gt.term2) then
4460 term2=dexp(term2-termm)
4464 term1=dexp(term1-termm)
4467 C The ratio between the gamma-independent and gamma-dependent lobes of
4468 C the distribution is a Gaussian function of thet_pred_mean too.
4469 diffak=gthet(2,it)-thet_pred_mean
4470 ratak=diffak/gthet(3,it)**2
4471 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4472 C Let's differentiate it in thet_pred_mean NOW.
4474 C Now put together the distribution terms to make complete distribution.
4475 termexp=term1+ak*term2
4476 termpre=sigc+ak*sig0i
4477 C Contribution of the bending energy from this theta is just the -log of
4478 C the sum of the contributions from the two lobes and the pre-exponential
4479 C factor. Simple enough, isn't it?
4480 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4481 C NOW the derivatives!!!
4482 C 6/6/97 Take into account the deformation.
4483 E_theta=(delthec*sigcsq*term1
4484 & +ak*delthe0*sig0inv*term2)/termexp
4485 E_tc=((sigtc+aktc*sig0i)/termpre
4486 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4487 & aktc*term2)/termexp)
4490 c-----------------------------------------------------------------------------
4491 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4492 implicit real*8 (a-h,o-z)
4493 include 'DIMENSIONS'
4494 include 'COMMON.LOCAL'
4495 include 'COMMON.IOUNITS'
4496 common /calcthet/ term1,term2,termm,diffak,ratak,
4497 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4498 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4499 delthec=thetai-thet_pred_mean
4500 delthe0=thetai-theta0i
4501 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4502 t3 = thetai-thet_pred_mean
4506 t14 = t12+t6*sigsqtc
4508 t21 = thetai-theta0i
4514 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4515 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4516 & *(-t12*t9-ak*sig0inv*t27)
4520 C--------------------------------------------------------------------------
4521 subroutine ebend(etheta)
4523 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4524 C angles gamma and its derivatives in consecutive thetas and gammas.
4525 C ab initio-derived potentials from
4526 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4528 implicit real*8 (a-h,o-z)
4529 include 'DIMENSIONS'
4530 include 'COMMON.LOCAL'
4531 include 'COMMON.GEO'
4532 include 'COMMON.INTERACT'
4533 include 'COMMON.DERIV'
4534 include 'COMMON.VAR'
4535 include 'COMMON.CHAIN'
4536 include 'COMMON.IOUNITS'
4537 include 'COMMON.NAMES'
4538 include 'COMMON.FFIELD'
4539 include 'COMMON.CONTROL'
4540 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4541 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4542 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4543 & sinph1ph2(maxdouble,maxdouble)
4544 logical lprn /.false./, lprn1 /.false./
4546 do i=ithet_start,ithet_end
4547 if (itype(i-1).eq.ntyp1) cycle
4551 theti2=0.5d0*theta(i)
4552 ityp2=ithetyp(iabs(itype(i-1)))
4554 coskt(k)=dcos(k*theti2)
4555 sinkt(k)=dsin(k*theti2)
4557 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4560 if (phii.ne.phii) phii=150.0
4564 ityp1=ithetyp(iabs(itype(i-2)))
4566 cosph1(k)=dcos(k*phii)
4567 sinph1(k)=dsin(k*phii)
4577 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4580 if (phii1.ne.phii1) phii1=150.0
4585 ityp3=ithetyp(iabs(itype(i)))
4587 cosph2(k)=dcos(k*phii1)
4588 sinph2(k)=dsin(k*phii1)
4598 ethetai=aa0thet(ityp1,ityp2,ityp3)
4601 ccl=cosph1(l)*cosph2(k-l)
4602 ssl=sinph1(l)*sinph2(k-l)
4603 scl=sinph1(l)*cosph2(k-l)
4604 csl=cosph1(l)*sinph2(k-l)
4605 cosph1ph2(l,k)=ccl-ssl
4606 cosph1ph2(k,l)=ccl+ssl
4607 sinph1ph2(l,k)=scl+csl
4608 sinph1ph2(k,l)=scl-csl
4612 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4613 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4614 write (iout,*) "coskt and sinkt"
4616 write (iout,*) k,coskt(k),sinkt(k)
4620 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4621 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4624 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4625 & " ethetai",ethetai
4628 write (iout,*) "cosph and sinph"
4630 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4632 write (iout,*) "cosph1ph2 and sinph2ph2"
4635 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4636 & sinph1ph2(l,k),sinph1ph2(k,l)
4639 write(iout,*) "ethetai",ethetai
4643 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4644 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4645 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4646 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4647 ethetai=ethetai+sinkt(m)*aux
4648 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4649 dephii=dephii+k*sinkt(m)*(
4650 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4651 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4652 dephii1=dephii1+k*sinkt(m)*(
4653 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4654 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4656 & write (iout,*) "m",m," k",k," bbthet",
4657 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4658 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4659 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4660 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4664 & write(iout,*) "ethetai",ethetai
4668 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4669 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4670 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4671 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4672 ethetai=ethetai+sinkt(m)*aux
4673 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4674 dephii=dephii+l*sinkt(m)*(
4675 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4676 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4677 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4678 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4679 dephii1=dephii1+(k-l)*sinkt(m)*(
4680 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4681 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4682 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4683 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4685 write (iout,*) "m",m," k",k," l",l," ffthet",
4686 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4687 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4688 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4689 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4690 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4691 & cosph1ph2(k,l)*sinkt(m),
4692 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4698 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4699 & i,theta(i)*rad2deg,phii*rad2deg,
4700 & phii1*rad2deg,ethetai
4701 etheta=etheta+ethetai
4702 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4703 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4704 gloc(nphi+i-2,icg)=wang*dethetai
4710 c-----------------------------------------------------------------------------
4711 subroutine esc(escloc)
4712 C Calculate the local energy of a side chain and its derivatives in the
4713 C corresponding virtual-bond valence angles THETA and the spherical angles
4715 implicit real*8 (a-h,o-z)
4716 include 'DIMENSIONS'
4717 include 'COMMON.GEO'
4718 include 'COMMON.LOCAL'
4719 include 'COMMON.VAR'
4720 include 'COMMON.INTERACT'
4721 include 'COMMON.DERIV'
4722 include 'COMMON.CHAIN'
4723 include 'COMMON.IOUNITS'
4724 include 'COMMON.NAMES'
4725 include 'COMMON.FFIELD'
4726 include 'COMMON.CONTROL'
4727 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4728 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4729 common /sccalc/ time11,time12,time112,theti,it,nlobit
4732 c write (iout,'(a)') 'ESC'
4733 do i=loc_start,loc_end
4735 if (it.eq.ntyp1) cycle
4736 if (it.eq.10) goto 1
4737 nlobit=nlob(iabs(it))
4738 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4739 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4740 theti=theta(i+1)-pipol
4745 if (x(2).gt.pi-delta) then
4749 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4751 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4752 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4754 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4755 & ddersc0(1),dersc(1))
4756 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4757 & ddersc0(3),dersc(3))
4759 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4761 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4762 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4763 & dersc0(2),esclocbi,dersc02)
4764 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4766 call splinthet(x(2),0.5d0*delta,ss,ssd)
4771 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4773 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4774 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4776 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4778 c write (iout,*) escloci
4779 else if (x(2).lt.delta) then
4783 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4785 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4786 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4788 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4789 & ddersc0(1),dersc(1))
4790 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4791 & ddersc0(3),dersc(3))
4793 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4795 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4796 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4797 & dersc0(2),esclocbi,dersc02)
4798 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4803 call splinthet(x(2),0.5d0*delta,ss,ssd)
4805 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4807 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4808 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4810 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4811 c write (iout,*) escloci
4813 call enesc(x,escloci,dersc,ddummy,.false.)
4816 escloc=escloc+escloci
4817 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4818 & 'escloc',i,escloci
4819 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4821 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4823 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4824 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4829 C---------------------------------------------------------------------------
4830 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4831 implicit real*8 (a-h,o-z)
4832 include 'DIMENSIONS'
4833 include 'COMMON.GEO'
4834 include 'COMMON.LOCAL'
4835 include 'COMMON.IOUNITS'
4836 common /sccalc/ time11,time12,time112,theti,it,nlobit
4837 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4838 double precision contr(maxlob,-1:1)
4840 c write (iout,*) 'it=',it,' nlobit=',nlobit
4844 if (mixed) ddersc(j)=0.0d0
4848 C Because of periodicity of the dependence of the SC energy in omega we have
4849 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4850 C To avoid underflows, first compute & store the exponents.
4858 z(k)=x(k)-censc(k,j,it)
4863 Axk=Axk+gaussc(l,k,j,it)*z(l)
4869 expfac=expfac+Ax(k,j,iii)*z(k)
4877 C As in the case of ebend, we want to avoid underflows in exponentiation and
4878 C subsequent NaNs and INFs in energy calculation.
4879 C Find the largest exponent
4883 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4887 cd print *,'it=',it,' emin=',emin
4889 C Compute the contribution to SC energy and derivatives
4894 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4895 if(adexp.ne.adexp) adexp=1.0
4898 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4900 cd print *,'j=',j,' expfac=',expfac
4901 escloc_i=escloc_i+expfac
4903 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4907 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4908 & +gaussc(k,2,j,it))*expfac
4915 dersc(1)=dersc(1)/cos(theti)**2
4916 ddersc(1)=ddersc(1)/cos(theti)**2
4919 escloci=-(dlog(escloc_i)-emin)
4921 dersc(j)=dersc(j)/escloc_i
4925 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4930 C------------------------------------------------------------------------------
4931 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4932 implicit real*8 (a-h,o-z)
4933 include 'DIMENSIONS'
4934 include 'COMMON.GEO'
4935 include 'COMMON.LOCAL'
4936 include 'COMMON.IOUNITS'
4937 common /sccalc/ time11,time12,time112,theti,it,nlobit
4938 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4939 double precision contr(maxlob)
4950 z(k)=x(k)-censc(k,j,it)
4956 Axk=Axk+gaussc(l,k,j,it)*z(l)
4962 expfac=expfac+Ax(k,j)*z(k)
4967 C As in the case of ebend, we want to avoid underflows in exponentiation and
4968 C subsequent NaNs and INFs in energy calculation.
4969 C Find the largest exponent
4972 if (emin.gt.contr(j)) emin=contr(j)
4976 C Compute the contribution to SC energy and derivatives
4980 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4981 escloc_i=escloc_i+expfac
4983 dersc(k)=dersc(k)+Ax(k,j)*expfac
4985 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4986 & +gaussc(1,2,j,it))*expfac
4990 dersc(1)=dersc(1)/cos(theti)**2
4991 dersc12=dersc12/cos(theti)**2
4992 escloci=-(dlog(escloc_i)-emin)
4994 dersc(j)=dersc(j)/escloc_i
4996 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5000 c----------------------------------------------------------------------------------
5001 subroutine esc(escloc)
5002 C Calculate the local energy of a side chain and its derivatives in the
5003 C corresponding virtual-bond valence angles THETA and the spherical angles
5004 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5005 C added by Urszula Kozlowska. 07/11/2007
5007 implicit real*8 (a-h,o-z)
5008 include 'DIMENSIONS'
5009 include 'COMMON.GEO'
5010 include 'COMMON.LOCAL'
5011 include 'COMMON.VAR'
5012 include 'COMMON.SCROT'
5013 include 'COMMON.INTERACT'
5014 include 'COMMON.DERIV'
5015 include 'COMMON.CHAIN'
5016 include 'COMMON.IOUNITS'
5017 include 'COMMON.NAMES'
5018 include 'COMMON.FFIELD'
5019 include 'COMMON.CONTROL'
5020 include 'COMMON.VECTORS'
5021 double precision x_prime(3),y_prime(3),z_prime(3)
5022 & , sumene,dsc_i,dp2_i,x(65),
5023 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5024 & de_dxx,de_dyy,de_dzz,de_dt
5025 double precision s1_t,s1_6_t,s2_t,s2_6_t
5027 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5028 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5029 & dt_dCi(3),dt_dCi1(3)
5030 common /sccalc/ time11,time12,time112,theti,it,nlobit
5033 do i=loc_start,loc_end
5034 if (itype(i).eq.ntyp1) cycle
5035 costtab(i+1) =dcos(theta(i+1))
5036 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5037 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5038 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5039 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5040 cosfac=dsqrt(cosfac2)
5041 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5042 sinfac=dsqrt(sinfac2)
5044 if (it.eq.10) goto 1
5046 C Compute the axes of tghe local cartesian coordinates system; store in
5047 c x_prime, y_prime and z_prime
5054 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5055 C & dc_norm(3,i+nres)
5057 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5058 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5061 z_prime(j) = -uz(j,i-1)
5064 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5065 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5066 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5067 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5068 c & " xy",scalar(x_prime(1),y_prime(1)),
5069 c & " xz",scalar(x_prime(1),z_prime(1)),
5070 c & " yy",scalar(y_prime(1),y_prime(1)),
5071 c & " yz",scalar(y_prime(1),z_prime(1)),
5072 c & " zz",scalar(z_prime(1),z_prime(1))
5074 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5075 C to local coordinate system. Store in xx, yy, zz.
5081 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5082 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5083 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
5090 C Compute the energy of the ith side cbain
5092 c write (2,*) "xx",xx," yy",yy," zz",zz
5095 x(j) = sc_parmin(j,it)
5098 Cc diagnostics - remove later
5100 yy1 = dsin(alph(2))*dcos(omeg(2))
5101 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5102 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5103 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5105 C," --- ", xx_w,yy_w,zz_w
5108 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5109 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5111 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5112 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5114 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5115 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5116 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5117 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5118 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5120 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5121 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5122 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5123 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5124 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5126 dsc_i = 0.743d0+x(61)
5128 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5129 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5130 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5131 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5132 s1=(1+x(63))/(0.1d0 + dscp1)
5133 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5134 s2=(1+x(65))/(0.1d0 + dscp2)
5135 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5136 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5137 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5138 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5140 c & dscp1,dscp2,sumene
5141 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5142 escloc = escloc + sumene
5143 c write (2,*) "i",i," escloc",sumene,escloc
5146 C This section to check the numerical derivatives of the energy of ith side
5147 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5148 C #define DEBUG in the code to turn it on.
5150 write (2,*) "sumene =",sumene
5154 write (2,*) xx,yy,zz
5155 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5156 de_dxx_num=(sumenep-sumene)/aincr
5158 write (2,*) "xx+ sumene from enesc=",sumenep
5161 write (2,*) xx,yy,zz
5162 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5163 de_dyy_num=(sumenep-sumene)/aincr
5165 write (2,*) "yy+ sumene from enesc=",sumenep
5168 write (2,*) xx,yy,zz
5169 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5170 de_dzz_num=(sumenep-sumene)/aincr
5172 write (2,*) "zz+ sumene from enesc=",sumenep
5173 costsave=cost2tab(i+1)
5174 sintsave=sint2tab(i+1)
5175 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5176 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5177 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5178 de_dt_num=(sumenep-sumene)/aincr
5179 write (2,*) " t+ sumene from enesc=",sumenep
5180 cost2tab(i+1)=costsave
5181 sint2tab(i+1)=sintsave
5182 C End of diagnostics section.
5185 C Compute the gradient of esc
5187 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5188 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5189 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5190 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5191 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5192 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5193 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5194 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5195 pom1=(sumene3*sint2tab(i+1)+sumene1)
5196 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5197 pom2=(sumene4*cost2tab(i+1)+sumene2)
5198 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5199 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5200 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5201 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5203 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5204 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5205 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5207 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5208 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5209 & +(pom1+pom2)*pom_dx
5211 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5214 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5215 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5216 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5218 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5219 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5220 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5221 & +x(59)*zz**2 +x(60)*xx*zz
5222 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5223 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5224 & +(pom1-pom2)*pom_dy
5226 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5229 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5230 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5231 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5232 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5233 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5234 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5235 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5236 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5238 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5241 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5242 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5243 & +pom1*pom_dt1+pom2*pom_dt2
5245 write(2,*), "de_dt = ", de_dt,de_dt_num
5249 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5250 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5251 cosfac2xx=cosfac2*xx
5252 sinfac2yy=sinfac2*yy
5254 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5256 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5258 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5259 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5260 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5261 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5262 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5263 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5264 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5265 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5266 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5267 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5271 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5272 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5275 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5276 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5277 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5279 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5280 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5284 dXX_Ctab(k,i)=dXX_Ci(k)
5285 dXX_C1tab(k,i)=dXX_Ci1(k)
5286 dYY_Ctab(k,i)=dYY_Ci(k)
5287 dYY_C1tab(k,i)=dYY_Ci1(k)
5288 dZZ_Ctab(k,i)=dZZ_Ci(k)
5289 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5290 dXX_XYZtab(k,i)=dXX_XYZ(k)
5291 dYY_XYZtab(k,i)=dYY_XYZ(k)
5292 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5296 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5297 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5298 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5299 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5300 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5302 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5303 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5304 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5305 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5306 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5307 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5308 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5309 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5311 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5312 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5314 C to check gradient call subroutine check_grad
5320 c------------------------------------------------------------------------------
5321 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5323 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5324 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5325 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5326 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5328 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5329 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5331 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5332 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5333 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5334 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5335 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5337 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5338 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5339 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5340 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5341 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5343 dsc_i = 0.743d0+x(61)
5345 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5346 & *(xx*cost2+yy*sint2))
5347 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5348 & *(xx*cost2-yy*sint2))
5349 s1=(1+x(63))/(0.1d0 + dscp1)
5350 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5351 s2=(1+x(65))/(0.1d0 + dscp2)
5352 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5353 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5354 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5359 c------------------------------------------------------------------------------
5360 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5362 C This procedure calculates two-body contact function g(rij) and its derivative:
5365 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5368 C where x=(rij-r0ij)/delta
5370 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5373 double precision rij,r0ij,eps0ij,fcont,fprimcont
5374 double precision x,x2,x4,delta
5378 if (x.lt.-1.0D0) then
5381 else if (x.le.1.0D0) then
5384 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5385 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5392 c------------------------------------------------------------------------------
5393 subroutine splinthet(theti,delta,ss,ssder)
5394 implicit real*8 (a-h,o-z)
5395 include 'DIMENSIONS'
5396 include 'COMMON.VAR'
5397 include 'COMMON.GEO'
5400 if (theti.gt.pipol) then
5401 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5403 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5408 c------------------------------------------------------------------------------
5409 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5411 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5412 double precision ksi,ksi2,ksi3,a1,a2,a3
5413 a1=fprim0*delta/(f1-f0)
5419 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5420 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5423 c------------------------------------------------------------------------------
5424 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5426 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5427 double precision ksi,ksi2,ksi3,a1,a2,a3
5432 a2=3*(f1x-f0x)-2*fprim0x*delta
5433 a3=fprim0x*delta-2*(f1x-f0x)
5434 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5437 C-----------------------------------------------------------------------------
5439 C-----------------------------------------------------------------------------
5440 subroutine etor(etors,edihcnstr)
5441 implicit real*8 (a-h,o-z)
5442 include 'DIMENSIONS'
5443 include 'COMMON.VAR'
5444 include 'COMMON.GEO'
5445 include 'COMMON.LOCAL'
5446 include 'COMMON.TORSION'
5447 include 'COMMON.INTERACT'
5448 include 'COMMON.DERIV'
5449 include 'COMMON.CHAIN'
5450 include 'COMMON.NAMES'
5451 include 'COMMON.IOUNITS'
5452 include 'COMMON.FFIELD'
5453 include 'COMMON.TORCNSTR'
5454 include 'COMMON.CONTROL'
5456 C Set lprn=.true. for debugging
5460 do i=iphi_start,iphi_end
5462 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5463 & .or. itype(i).eq.ntyp1) cycle
5464 itori=itortyp(itype(i-2))
5465 itori1=itortyp(itype(i-1))
5468 C Proline-Proline pair is a special case...
5469 if (itori.eq.3 .and. itori1.eq.3) then
5470 if (phii.gt.-dwapi3) then
5472 fac=1.0D0/(1.0D0-cosphi)
5473 etorsi=v1(1,3,3)*fac
5474 etorsi=etorsi+etorsi
5475 etors=etors+etorsi-v1(1,3,3)
5476 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5477 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5480 v1ij=v1(j+1,itori,itori1)
5481 v2ij=v2(j+1,itori,itori1)
5484 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5485 if (energy_dec) etors_ii=etors_ii+
5486 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5487 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5491 v1ij=v1(j,itori,itori1)
5492 v2ij=v2(j,itori,itori1)
5495 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5496 if (energy_dec) etors_ii=etors_ii+
5497 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5498 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5501 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5504 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5505 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5506 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5507 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5508 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5510 ! 6/20/98 - dihedral angle constraints
5513 itori=idih_constr(i)
5516 if (difi.gt.drange(i)) then
5518 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5519 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5520 else if (difi.lt.-drange(i)) then
5522 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5523 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5525 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5526 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5528 ! write (iout,*) 'edihcnstr',edihcnstr
5531 c------------------------------------------------------------------------------
5532 subroutine etor_d(etors_d)
5536 c----------------------------------------------------------------------------
5538 subroutine etor(etors,edihcnstr)
5539 implicit real*8 (a-h,o-z)
5540 include 'DIMENSIONS'
5541 include 'COMMON.VAR'
5542 include 'COMMON.GEO'
5543 include 'COMMON.LOCAL'
5544 include 'COMMON.TORSION'
5545 include 'COMMON.INTERACT'
5546 include 'COMMON.DERIV'
5547 include 'COMMON.CHAIN'
5548 include 'COMMON.NAMES'
5549 include 'COMMON.IOUNITS'
5550 include 'COMMON.FFIELD'
5551 include 'COMMON.TORCNSTR'
5552 include 'COMMON.CONTROL'
5554 C Set lprn=.true. for debugging
5558 do i=iphi_start,iphi_end
5559 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5560 & .or. itype(i).eq.ntyp1) cycle
5562 if (iabs(itype(i)).eq.20) then
5567 itori=itortyp(itype(i-2))
5568 itori1=itortyp(itype(i-1))
5571 C Regular cosine and sine terms
5572 do j=1,nterm(itori,itori1,iblock)
5573 v1ij=v1(j,itori,itori1,iblock)
5574 v2ij=v2(j,itori,itori1,iblock)
5577 etors=etors+v1ij*cosphi+v2ij*sinphi
5578 if (energy_dec) etors_ii=etors_ii+
5579 & v1ij*cosphi+v2ij*sinphi
5580 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5584 C E = SUM ----------------------------------- - v1
5585 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5587 cosphi=dcos(0.5d0*phii)
5588 sinphi=dsin(0.5d0*phii)
5589 do j=1,nlor(itori,itori1,iblock)
5590 vl1ij=vlor1(j,itori,itori1)
5591 vl2ij=vlor2(j,itori,itori1)
5592 vl3ij=vlor3(j,itori,itori1)
5593 pom=vl2ij*cosphi+vl3ij*sinphi
5594 pom1=1.0d0/(pom*pom+1.0d0)
5595 etors=etors+vl1ij*pom1
5596 if (energy_dec) etors_ii=etors_ii+
5599 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5601 C Subtract the constant term
5602 etors=etors-v0(itori,itori1,iblock)
5603 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5604 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5606 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5607 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5608 & (v1(j,itori,itori1,iblock),j=1,6),
5609 & (v2(j,itori,itori1,iblock),j=1,6)
5610 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5611 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5613 ! 6/20/98 - dihedral angle constraints
5615 c do i=1,ndih_constr
5616 do i=idihconstr_start,idihconstr_end
5617 itori=idih_constr(i)
5619 difi=pinorm(phii-phi0(i))
5620 if (difi.gt.drange(i)) then
5622 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5623 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5624 else if (difi.lt.-drange(i)) then
5626 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5627 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5631 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5632 cd & rad2deg*phi0(i), rad2deg*drange(i),
5633 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5635 cd write (iout,*) 'edihcnstr',edihcnstr
5638 c----------------------------------------------------------------------------
5639 subroutine etor_d(etors_d)
5640 C 6/23/01 Compute double torsional energy
5641 implicit real*8 (a-h,o-z)
5642 include 'DIMENSIONS'
5643 include 'COMMON.VAR'
5644 include 'COMMON.GEO'
5645 include 'COMMON.LOCAL'
5646 include 'COMMON.TORSION'
5647 include 'COMMON.INTERACT'
5648 include 'COMMON.DERIV'
5649 include 'COMMON.CHAIN'
5650 include 'COMMON.NAMES'
5651 include 'COMMON.IOUNITS'
5652 include 'COMMON.FFIELD'
5653 include 'COMMON.TORCNSTR'
5655 C Set lprn=.true. for debugging
5659 do i=iphid_start,iphid_end
5660 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5661 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5662 itori=itortyp(itype(i-2))
5663 itori1=itortyp(itype(i-1))
5664 itori2=itortyp(itype(i))
5670 if (iabs(itype(i+1)).eq.20) iblock=2
5672 C Regular cosine and sine terms
5673 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5674 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5675 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5676 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5677 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5678 cosphi1=dcos(j*phii)
5679 sinphi1=dsin(j*phii)
5680 cosphi2=dcos(j*phii1)
5681 sinphi2=dsin(j*phii1)
5682 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5683 & v2cij*cosphi2+v2sij*sinphi2
5684 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5685 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5687 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5689 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5690 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5691 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5692 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5693 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5694 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5695 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5696 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5697 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5698 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5699 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5700 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5701 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5702 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5705 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5706 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5711 c------------------------------------------------------------------------------
5712 subroutine eback_sc_corr(esccor)
5713 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5714 c conformational states; temporarily implemented as differences
5715 c between UNRES torsional potentials (dependent on three types of
5716 c residues) and the torsional potentials dependent on all 20 types
5717 c of residues computed from AM1 energy surfaces of terminally-blocked
5718 c amino-acid residues.
5719 implicit real*8 (a-h,o-z)
5720 include 'DIMENSIONS'
5721 include 'COMMON.VAR'
5722 include 'COMMON.GEO'
5723 include 'COMMON.LOCAL'
5724 include 'COMMON.TORSION'
5725 include 'COMMON.SCCOR'
5726 include 'COMMON.INTERACT'
5727 include 'COMMON.DERIV'
5728 include 'COMMON.CHAIN'
5729 include 'COMMON.NAMES'
5730 include 'COMMON.IOUNITS'
5731 include 'COMMON.FFIELD'
5732 include 'COMMON.CONTROL'
5734 C Set lprn=.true. for debugging
5737 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5739 do i=itau_start,itau_end
5741 isccori=isccortyp(itype(i-2))
5742 isccori1=isccortyp(itype(i-1))
5743 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5745 do intertyp=1,3 !intertyp
5746 cc Added 09 May 2012 (Adasko)
5747 cc Intertyp means interaction type of backbone mainchain correlation:
5748 c 1 = SC...Ca...Ca...Ca
5749 c 2 = Ca...Ca...Ca...SC
5750 c 3 = SC...Ca...Ca...SCi
5752 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5753 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5754 & (itype(i-1).eq.ntyp1)))
5755 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5756 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5757 & .or.(itype(i).eq.ntyp1)))
5758 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5759 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5760 & (itype(i-3).eq.ntyp1)))) cycle
5761 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5762 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5764 do j=1,nterm_sccor(isccori,isccori1)
5765 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5766 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5767 cosphi=dcos(j*tauangle(intertyp,i))
5768 sinphi=dsin(j*tauangle(intertyp,i))
5769 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5770 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5772 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5773 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5775 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5776 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5777 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5778 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5779 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5785 c----------------------------------------------------------------------------
5786 subroutine multibody(ecorr)
5787 C This subroutine calculates multi-body contributions to energy following
5788 C the idea of Skolnick et al. If side chains I and J make a contact and
5789 C at the same time side chains I+1 and J+1 make a contact, an extra
5790 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5791 implicit real*8 (a-h,o-z)
5792 include 'DIMENSIONS'
5793 include 'COMMON.IOUNITS'
5794 include 'COMMON.DERIV'
5795 include 'COMMON.INTERACT'
5796 include 'COMMON.CONTACTS'
5797 double precision gx(3),gx1(3)
5800 C Set lprn=.true. for debugging
5804 write (iout,'(a)') 'Contact function values:'
5806 write (iout,'(i2,20(1x,i2,f10.5))')
5807 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5822 num_conti=num_cont(i)
5823 num_conti1=num_cont(i1)
5828 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5829 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5830 cd & ' ishift=',ishift
5831 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5832 C The system gains extra energy.
5833 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5834 endif ! j1==j+-ishift
5843 c------------------------------------------------------------------------------
5844 double precision function esccorr(i,j,k,l,jj,kk)
5845 implicit real*8 (a-h,o-z)
5846 include 'DIMENSIONS'
5847 include 'COMMON.IOUNITS'
5848 include 'COMMON.DERIV'
5849 include 'COMMON.INTERACT'
5850 include 'COMMON.CONTACTS'
5851 double precision gx(3),gx1(3)
5856 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5857 C Calculate the multi-body contribution to energy.
5858 C Calculate multi-body contributions to the gradient.
5859 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5860 cd & k,l,(gacont(m,kk,k),m=1,3)
5862 gx(m) =ekl*gacont(m,jj,i)
5863 gx1(m)=eij*gacont(m,kk,k)
5864 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5865 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5866 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5867 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5871 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5876 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5882 c------------------------------------------------------------------------------
5883 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5884 C This subroutine calculates multi-body contributions to hydrogen-bonding
5885 implicit real*8 (a-h,o-z)
5886 include 'DIMENSIONS'
5887 include 'COMMON.IOUNITS'
5890 parameter (max_cont=maxconts)
5891 parameter (max_dim=26)
5892 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5893 double precision zapas(max_dim,maxconts,max_fg_procs),
5894 & zapas_recv(max_dim,maxconts,max_fg_procs)
5895 common /przechowalnia/ zapas
5896 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5897 & status_array(MPI_STATUS_SIZE,maxconts*2)
5899 include 'COMMON.SETUP'
5900 include 'COMMON.FFIELD'
5901 include 'COMMON.DERIV'
5902 include 'COMMON.INTERACT'
5903 include 'COMMON.CONTACTS'
5904 include 'COMMON.CONTROL'
5905 include 'COMMON.LOCAL'
5906 double precision gx(3),gx1(3),time00
5909 C Set lprn=.true. for debugging
5914 if (nfgtasks.le.1) goto 30
5916 write (iout,'(a)') 'Contact function values before RECEIVE:'
5918 write (iout,'(2i3,50(1x,i2,f5.2))')
5919 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5920 & j=1,num_cont_hb(i))
5924 do i=1,ntask_cont_from
5927 do i=1,ntask_cont_to
5930 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5932 C Make the list of contacts to send to send to other procesors
5933 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5935 do i=iturn3_start,iturn3_end
5936 c write (iout,*) "make contact list turn3",i," num_cont",
5938 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5940 do i=iturn4_start,iturn4_end
5941 c write (iout,*) "make contact list turn4",i," num_cont",
5943 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5947 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5949 do j=1,num_cont_hb(i)
5952 iproc=iint_sent_local(k,jjc,ii)
5953 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5954 if (iproc.gt.0) then
5955 ncont_sent(iproc)=ncont_sent(iproc)+1
5956 nn=ncont_sent(iproc)
5958 zapas(2,nn,iproc)=jjc
5959 zapas(3,nn,iproc)=facont_hb(j,i)
5960 zapas(4,nn,iproc)=ees0p(j,i)
5961 zapas(5,nn,iproc)=ees0m(j,i)
5962 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5963 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5964 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5965 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5966 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5967 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5968 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5969 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5970 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5971 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5972 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5973 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5974 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5975 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5976 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5977 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5978 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5979 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5980 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5981 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5982 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5989 & "Numbers of contacts to be sent to other processors",
5990 & (ncont_sent(i),i=1,ntask_cont_to)
5991 write (iout,*) "Contacts sent"
5992 do ii=1,ntask_cont_to
5994 iproc=itask_cont_to(ii)
5995 write (iout,*) nn," contacts to processor",iproc,
5996 & " of CONT_TO_COMM group"
5998 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6006 CorrelID1=nfgtasks+fg_rank+1
6008 C Receive the numbers of needed contacts from other processors
6009 do ii=1,ntask_cont_from
6010 iproc=itask_cont_from(ii)
6012 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6013 & FG_COMM,req(ireq),IERR)
6015 c write (iout,*) "IRECV ended"
6017 C Send the number of contacts needed by other processors
6018 do ii=1,ntask_cont_to
6019 iproc=itask_cont_to(ii)
6021 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6022 & FG_COMM,req(ireq),IERR)
6024 c write (iout,*) "ISEND ended"
6025 c write (iout,*) "number of requests (nn)",ireq
6028 & call MPI_Waitall(ireq,req,status_array,ierr)
6030 c & "Numbers of contacts to be received from other processors",
6031 c & (ncont_recv(i),i=1,ntask_cont_from)
6035 do ii=1,ntask_cont_from
6036 iproc=itask_cont_from(ii)
6038 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6039 c & " of CONT_TO_COMM group"
6043 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6044 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6045 c write (iout,*) "ireq,req",ireq,req(ireq)
6048 C Send the contacts to processors that need them
6049 do ii=1,ntask_cont_to
6050 iproc=itask_cont_to(ii)
6052 c write (iout,*) nn," contacts to processor",iproc,
6053 c & " of CONT_TO_COMM group"
6056 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6057 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6058 c write (iout,*) "ireq,req",ireq,req(ireq)
6060 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6064 c write (iout,*) "number of requests (contacts)",ireq
6065 c write (iout,*) "req",(req(i),i=1,4)
6068 & call MPI_Waitall(ireq,req,status_array,ierr)
6069 do iii=1,ntask_cont_from
6070 iproc=itask_cont_from(iii)
6073 write (iout,*) "Received",nn," contacts from processor",iproc,
6074 & " of CONT_FROM_COMM group"
6077 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6082 ii=zapas_recv(1,i,iii)
6083 c Flag the received contacts to prevent double-counting
6084 jj=-zapas_recv(2,i,iii)
6085 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6087 nnn=num_cont_hb(ii)+1
6090 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6091 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6092 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6093 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6094 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6095 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6096 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6097 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6098 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6099 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6100 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6101 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6102 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6103 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6104 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6105 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6106 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6107 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6108 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6109 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6110 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6111 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6112 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6113 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6118 write (iout,'(a)') 'Contact function values after receive:'
6120 write (iout,'(2i3,50(1x,i3,f5.2))')
6121 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6122 & j=1,num_cont_hb(i))
6129 write (iout,'(a)') 'Contact function values:'
6131 write (iout,'(2i3,50(1x,i3,f5.2))')
6132 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6133 & j=1,num_cont_hb(i))
6137 C Remove the loop below after debugging !!!
6144 C Calculate the local-electrostatic correlation terms
6145 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6147 num_conti=num_cont_hb(i)
6148 num_conti1=num_cont_hb(i+1)
6155 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6156 c & ' jj=',jj,' kk=',kk
6157 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6158 & .or. j.lt.0 .and. j1.gt.0) .and.
6159 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6160 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6161 C The system gains extra energy.
6162 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6163 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6164 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6166 else if (j1.eq.j) then
6167 C Contacts I-J and I-(J+1) occur simultaneously.
6168 C The system loses extra energy.
6169 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6174 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6175 c & ' jj=',jj,' kk=',kk
6177 C Contacts I-J and (I+1)-J occur simultaneously.
6178 C The system loses extra energy.
6179 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6186 c------------------------------------------------------------------------------
6187 subroutine add_hb_contact(ii,jj,itask)
6188 implicit real*8 (a-h,o-z)
6189 include "DIMENSIONS"
6190 include "COMMON.IOUNITS"
6193 parameter (max_cont=maxconts)
6194 parameter (max_dim=26)
6195 include "COMMON.CONTACTS"
6196 double precision zapas(max_dim,maxconts,max_fg_procs),
6197 & zapas_recv(max_dim,maxconts,max_fg_procs)
6198 common /przechowalnia/ zapas
6199 integer i,j,ii,jj,iproc,itask(4),nn
6200 c write (iout,*) "itask",itask
6203 if (iproc.gt.0) then
6204 do j=1,num_cont_hb(ii)
6206 c write (iout,*) "i",ii," j",jj," jjc",jjc
6208 ncont_sent(iproc)=ncont_sent(iproc)+1
6209 nn=ncont_sent(iproc)
6210 zapas(1,nn,iproc)=ii
6211 zapas(2,nn,iproc)=jjc
6212 zapas(3,nn,iproc)=facont_hb(j,ii)
6213 zapas(4,nn,iproc)=ees0p(j,ii)
6214 zapas(5,nn,iproc)=ees0m(j,ii)
6215 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6216 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6217 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6218 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6219 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6220 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6221 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6222 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6223 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6224 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6225 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6226 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6227 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6228 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6229 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6230 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6231 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6232 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6233 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6234 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6235 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6243 c------------------------------------------------------------------------------
6244 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6246 C This subroutine calculates multi-body contributions to hydrogen-bonding
6247 implicit real*8 (a-h,o-z)
6248 include 'DIMENSIONS'
6249 include 'COMMON.IOUNITS'
6252 parameter (max_cont=maxconts)
6253 parameter (max_dim=70)
6254 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6255 double precision zapas(max_dim,maxconts,max_fg_procs),
6256 & zapas_recv(max_dim,maxconts,max_fg_procs)
6257 common /przechowalnia/ zapas
6258 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6259 & status_array(MPI_STATUS_SIZE,maxconts*2)
6261 include 'COMMON.SETUP'
6262 include 'COMMON.FFIELD'
6263 include 'COMMON.DERIV'
6264 include 'COMMON.LOCAL'
6265 include 'COMMON.INTERACT'
6266 include 'COMMON.CONTACTS'
6267 include 'COMMON.CHAIN'
6268 include 'COMMON.CONTROL'
6269 double precision gx(3),gx1(3)
6270 integer num_cont_hb_old(maxres)
6272 double precision eello4,eello5,eelo6,eello_turn6
6273 external eello4,eello5,eello6,eello_turn6
6274 C Set lprn=.true. for debugging
6279 num_cont_hb_old(i)=num_cont_hb(i)
6283 if (nfgtasks.le.1) goto 30
6285 write (iout,'(a)') 'Contact function values before RECEIVE:'
6287 write (iout,'(2i3,50(1x,i2,f5.2))')
6288 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6289 & j=1,num_cont_hb(i))
6293 do i=1,ntask_cont_from
6296 do i=1,ntask_cont_to
6299 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6301 C Make the list of contacts to send to send to other procesors
6302 do i=iturn3_start,iturn3_end
6303 c write (iout,*) "make contact list turn3",i," num_cont",
6305 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6307 do i=iturn4_start,iturn4_end
6308 c write (iout,*) "make contact list turn4",i," num_cont",
6310 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6314 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6316 do j=1,num_cont_hb(i)
6319 iproc=iint_sent_local(k,jjc,ii)
6320 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6321 if (iproc.ne.0) then
6322 ncont_sent(iproc)=ncont_sent(iproc)+1
6323 nn=ncont_sent(iproc)
6325 zapas(2,nn,iproc)=jjc
6326 zapas(3,nn,iproc)=d_cont(j,i)
6330 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6335 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6343 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6354 & "Numbers of contacts to be sent to other processors",
6355 & (ncont_sent(i),i=1,ntask_cont_to)
6356 write (iout,*) "Contacts sent"
6357 do ii=1,ntask_cont_to
6359 iproc=itask_cont_to(ii)
6360 write (iout,*) nn," contacts to processor",iproc,
6361 & " of CONT_TO_COMM group"
6363 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6371 CorrelID1=nfgtasks+fg_rank+1
6373 C Receive the numbers of needed contacts from other processors
6374 do ii=1,ntask_cont_from
6375 iproc=itask_cont_from(ii)
6377 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6378 & FG_COMM,req(ireq),IERR)
6380 c write (iout,*) "IRECV ended"
6382 C Send the number of contacts needed by other processors
6383 do ii=1,ntask_cont_to
6384 iproc=itask_cont_to(ii)
6386 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6387 & FG_COMM,req(ireq),IERR)
6389 c write (iout,*) "ISEND ended"
6390 c write (iout,*) "number of requests (nn)",ireq
6393 & call MPI_Waitall(ireq,req,status_array,ierr)
6395 c & "Numbers of contacts to be received from other processors",
6396 c & (ncont_recv(i),i=1,ntask_cont_from)
6400 do ii=1,ntask_cont_from
6401 iproc=itask_cont_from(ii)
6403 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6404 c & " of CONT_TO_COMM group"
6408 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6409 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6410 c write (iout,*) "ireq,req",ireq,req(ireq)
6413 C Send the contacts to processors that need them
6414 do ii=1,ntask_cont_to
6415 iproc=itask_cont_to(ii)
6417 c write (iout,*) nn," contacts to processor",iproc,
6418 c & " of CONT_TO_COMM group"
6421 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6422 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6423 c write (iout,*) "ireq,req",ireq,req(ireq)
6425 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6429 c write (iout,*) "number of requests (contacts)",ireq
6430 c write (iout,*) "req",(req(i),i=1,4)
6433 & call MPI_Waitall(ireq,req,status_array,ierr)
6434 do iii=1,ntask_cont_from
6435 iproc=itask_cont_from(iii)
6438 write (iout,*) "Received",nn," contacts from processor",iproc,
6439 & " of CONT_FROM_COMM group"
6442 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6447 ii=zapas_recv(1,i,iii)
6448 c Flag the received contacts to prevent double-counting
6449 jj=-zapas_recv(2,i,iii)
6450 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6452 nnn=num_cont_hb(ii)+1
6455 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6459 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6464 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6472 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6481 write (iout,'(a)') 'Contact function values after receive:'
6483 write (iout,'(2i3,50(1x,i3,5f6.3))')
6484 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6485 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6492 write (iout,'(a)') 'Contact function values:'
6494 write (iout,'(2i3,50(1x,i2,5f6.3))')
6495 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6496 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6502 C Remove the loop below after debugging !!!
6509 C Calculate the dipole-dipole interaction energies
6510 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6511 do i=iatel_s,iatel_e+1
6512 num_conti=num_cont_hb(i)
6521 C Calculate the local-electrostatic correlation terms
6522 c write (iout,*) "gradcorr5 in eello5 before loop"
6524 c write (iout,'(i5,3f10.5)')
6525 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6527 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6528 c write (iout,*) "corr loop i",i
6530 num_conti=num_cont_hb(i)
6531 num_conti1=num_cont_hb(i+1)
6538 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6539 c & ' jj=',jj,' kk=',kk
6540 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6541 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6542 & .or. j.lt.0 .and. j1.gt.0) .and.
6543 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6544 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6545 C The system gains extra energy.
6547 sqd1=dsqrt(d_cont(jj,i))
6548 sqd2=dsqrt(d_cont(kk,i1))
6549 sred_geom = sqd1*sqd2
6550 IF (sred_geom.lt.cutoff_corr) THEN
6551 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6553 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6554 cd & ' jj=',jj,' kk=',kk
6555 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6556 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6558 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6559 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6562 cd write (iout,*) 'sred_geom=',sred_geom,
6563 cd & ' ekont=',ekont,' fprim=',fprimcont,
6564 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6565 cd write (iout,*) "g_contij",g_contij
6566 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6567 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6568 call calc_eello(i,jp,i+1,jp1,jj,kk)
6569 if (wcorr4.gt.0.0d0)
6570 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6571 if (energy_dec.and.wcorr4.gt.0.0d0)
6572 1 write (iout,'(a6,4i5,0pf7.3)')
6573 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6574 c write (iout,*) "gradcorr5 before eello5"
6576 c write (iout,'(i5,3f10.5)')
6577 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6579 if (wcorr5.gt.0.0d0)
6580 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6581 c write (iout,*) "gradcorr5 after eello5"
6583 c write (iout,'(i5,3f10.5)')
6584 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6586 if (energy_dec.and.wcorr5.gt.0.0d0)
6587 1 write (iout,'(a6,4i5,0pf7.3)')
6588 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6589 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6590 cd write(2,*)'ijkl',i,jp,i+1,jp1
6591 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6592 & .or. wturn6.eq.0.0d0))then
6593 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6594 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6595 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6596 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6597 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6598 cd & 'ecorr6=',ecorr6
6599 cd write (iout,'(4e15.5)') sred_geom,
6600 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6601 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6602 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6603 else if (wturn6.gt.0.0d0
6604 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6605 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6606 eturn6=eturn6+eello_turn6(i,jj,kk)
6607 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6608 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6609 cd write (2,*) 'multibody_eello:eturn6',eturn6
6618 num_cont_hb(i)=num_cont_hb_old(i)
6620 c write (iout,*) "gradcorr5 in eello5"
6622 c write (iout,'(i5,3f10.5)')
6623 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6627 c------------------------------------------------------------------------------
6628 subroutine add_hb_contact_eello(ii,jj,itask)
6629 implicit real*8 (a-h,o-z)
6630 include "DIMENSIONS"
6631 include "COMMON.IOUNITS"
6634 parameter (max_cont=maxconts)
6635 parameter (max_dim=70)
6636 include "COMMON.CONTACTS"
6637 double precision zapas(max_dim,maxconts,max_fg_procs),
6638 & zapas_recv(max_dim,maxconts,max_fg_procs)
6639 common /przechowalnia/ zapas
6640 integer i,j,ii,jj,iproc,itask(4),nn
6641 c write (iout,*) "itask",itask
6644 if (iproc.gt.0) then
6645 do j=1,num_cont_hb(ii)
6647 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6649 ncont_sent(iproc)=ncont_sent(iproc)+1
6650 nn=ncont_sent(iproc)
6651 zapas(1,nn,iproc)=ii
6652 zapas(2,nn,iproc)=jjc
6653 zapas(3,nn,iproc)=d_cont(j,ii)
6657 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6662 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6670 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6682 c------------------------------------------------------------------------------
6683 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6684 implicit real*8 (a-h,o-z)
6685 include 'DIMENSIONS'
6686 include 'COMMON.IOUNITS'
6687 include 'COMMON.DERIV'
6688 include 'COMMON.INTERACT'
6689 include 'COMMON.CONTACTS'
6690 double precision gx(3),gx1(3)
6700 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6701 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6702 C Following 4 lines for diagnostics.
6707 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6708 c & 'Contacts ',i,j,
6709 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6710 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6712 C Calculate the multi-body contribution to energy.
6713 c ecorr=ecorr+ekont*ees
6714 C Calculate multi-body contributions to the gradient.
6715 coeffpees0pij=coeffp*ees0pij
6716 coeffmees0mij=coeffm*ees0mij
6717 coeffpees0pkl=coeffp*ees0pkl
6718 coeffmees0mkl=coeffm*ees0mkl
6720 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6721 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6722 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6723 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6724 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6725 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6726 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6727 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6728 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6729 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6730 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6731 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6732 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6733 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6734 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6735 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6736 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6737 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6738 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6739 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6740 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6741 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6742 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6743 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6744 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6749 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6750 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6751 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6752 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6757 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6758 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6759 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6760 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6763 c write (iout,*) "ehbcorr",ekont*ees
6768 C---------------------------------------------------------------------------
6769 subroutine dipole(i,j,jj)
6770 implicit real*8 (a-h,o-z)
6771 include 'DIMENSIONS'
6772 include 'COMMON.IOUNITS'
6773 include 'COMMON.CHAIN'
6774 include 'COMMON.FFIELD'
6775 include 'COMMON.DERIV'
6776 include 'COMMON.INTERACT'
6777 include 'COMMON.CONTACTS'
6778 include 'COMMON.TORSION'
6779 include 'COMMON.VAR'
6780 include 'COMMON.GEO'
6781 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6783 iti1 = itortyp(itype(i+1))
6784 if (j.lt.nres-1) then
6785 itj1 = itortyp(itype(j+1))
6790 dipi(iii,1)=Ub2(iii,i)
6791 dipderi(iii)=Ub2der(iii,i)
6792 dipi(iii,2)=b1(iii,iti1)
6793 dipj(iii,1)=Ub2(iii,j)
6794 dipderj(iii)=Ub2der(iii,j)
6795 dipj(iii,2)=b1(iii,itj1)
6799 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6802 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6809 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6813 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6818 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6819 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6821 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6823 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6825 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6830 C---------------------------------------------------------------------------
6831 subroutine calc_eello(i,j,k,l,jj,kk)
6833 C This subroutine computes matrices and vectors needed to calculate
6834 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6836 implicit real*8 (a-h,o-z)
6837 include 'DIMENSIONS'
6838 include 'COMMON.IOUNITS'
6839 include 'COMMON.CHAIN'
6840 include 'COMMON.DERIV'
6841 include 'COMMON.INTERACT'
6842 include 'COMMON.CONTACTS'
6843 include 'COMMON.TORSION'
6844 include 'COMMON.VAR'
6845 include 'COMMON.GEO'
6846 include 'COMMON.FFIELD'
6847 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6848 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6851 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6852 cd & ' jj=',jj,' kk=',kk
6853 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6854 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6855 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6858 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6859 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6862 call transpose2(aa1(1,1),aa1t(1,1))
6863 call transpose2(aa2(1,1),aa2t(1,1))
6866 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6867 & aa1tder(1,1,lll,kkk))
6868 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6869 & aa2tder(1,1,lll,kkk))
6873 C parallel orientation of the two CA-CA-CA frames.
6875 iti=itortyp(itype(i))
6879 itk1=itortyp(itype(k+1))
6880 itj=itortyp(itype(j))
6881 if (l.lt.nres-1) then
6882 itl1=itortyp(itype(l+1))
6886 C A1 kernel(j+1) A2T
6888 cd write (iout,'(3f10.5,5x,3f10.5)')
6889 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
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.,EUg(1,1,l),EUgder(1,1,l),
6893 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6894 C Following matrices are needed only for 6-th order cumulants
6895 IF (wcorr6.gt.0.0d0) THEN
6896 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6897 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6898 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(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.,Ug2DtEUg(1,1,l),
6901 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6902 & ADtEAderx(1,1,1,1,1,1))
6904 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6905 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6906 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6907 & ADtEA1derx(1,1,1,1,1,1))
6909 C End 6-th order cumulants
6912 cd write (2,*) 'In calc_eello6'
6914 cd write (2,*) 'iii=',iii
6916 cd write (2,*) 'kkk=',kkk
6918 cd write (2,'(3(2f10.5),5x)')
6919 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6924 call transpose2(EUgder(1,1,k),auxmat(1,1))
6925 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6926 call transpose2(EUg(1,1,k),auxmat(1,1))
6927 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6928 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6932 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6933 & EAEAderx(1,1,lll,kkk,iii,1))
6937 C A1T kernel(i+1) A2
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.,EUg(1,1,k),EUgder(1,1,k),
6940 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6941 C Following matrices are needed only for 6-th order cumulants
6942 IF (wcorr6.gt.0.0d0) THEN
6943 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6944 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6945 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6946 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6947 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6948 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6949 & ADtEAderx(1,1,1,1,1,2))
6950 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6951 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6952 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6953 & ADtEA1derx(1,1,1,1,1,2))
6955 C End 6-th order cumulants
6956 call transpose2(EUgder(1,1,l),auxmat(1,1))
6957 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6958 call transpose2(EUg(1,1,l),auxmat(1,1))
6959 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6960 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6964 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6965 & EAEAderx(1,1,lll,kkk,iii,2))
6970 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6971 C They are needed only when the fifth- or the sixth-order cumulants are
6973 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6974 call transpose2(AEA(1,1,1),auxmat(1,1))
6975 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6976 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6977 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6978 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6979 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6980 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6981 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6982 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6983 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6984 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6985 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6986 call transpose2(AEA(1,1,2),auxmat(1,1))
6987 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6988 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6989 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6990 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6991 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6992 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6993 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6994 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6995 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6996 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6997 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6998 C Calculate the Cartesian derivatives of the vectors.
7002 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7003 call matvec2(auxmat(1,1),b1(1,iti),
7004 & AEAb1derx(1,lll,kkk,iii,1,1))
7005 call matvec2(auxmat(1,1),Ub2(1,i),
7006 & AEAb2derx(1,lll,kkk,iii,1,1))
7007 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7008 & AEAb1derx(1,lll,kkk,iii,2,1))
7009 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7010 & AEAb2derx(1,lll,kkk,iii,2,1))
7011 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7012 call matvec2(auxmat(1,1),b1(1,itj),
7013 & AEAb1derx(1,lll,kkk,iii,1,2))
7014 call matvec2(auxmat(1,1),Ub2(1,j),
7015 & AEAb2derx(1,lll,kkk,iii,1,2))
7016 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7017 & AEAb1derx(1,lll,kkk,iii,2,2))
7018 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7019 & AEAb2derx(1,lll,kkk,iii,2,2))
7026 C Antiparallel orientation of the two CA-CA-CA frames.
7028 iti=itortyp(itype(i))
7032 itk1=itortyp(itype(k+1))
7033 itl=itortyp(itype(l))
7034 itj=itortyp(itype(j))
7035 if (j.lt.nres-1) then
7036 itj1=itortyp(itype(j+1))
7040 C A2 kernel(j-1)T A1T
7041 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7042 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7043 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7044 C Following matrices are needed only for 6-th order cumulants
7045 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7046 & j.eq.i+4 .and. l.eq.i+3)) THEN
7047 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7048 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7049 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7050 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7051 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7052 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7053 & ADtEAderx(1,1,1,1,1,1))
7054 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7055 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7056 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7057 & ADtEA1derx(1,1,1,1,1,1))
7059 C End 6-th order cumulants
7060 call transpose2(EUgder(1,1,k),auxmat(1,1))
7061 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7062 call transpose2(EUg(1,1,k),auxmat(1,1))
7063 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7064 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7068 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7069 & EAEAderx(1,1,lll,kkk,iii,1))
7073 C A2T kernel(i+1)T A1
7074 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7075 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7076 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7077 C Following matrices are needed only for 6-th order cumulants
7078 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7079 & j.eq.i+4 .and. l.eq.i+3)) THEN
7080 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7081 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7082 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7083 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7084 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7085 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7086 & ADtEAderx(1,1,1,1,1,2))
7087 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7088 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7089 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7090 & ADtEA1derx(1,1,1,1,1,2))
7092 C End 6-th order cumulants
7093 call transpose2(EUgder(1,1,j),auxmat(1,1))
7094 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7095 call transpose2(EUg(1,1,j),auxmat(1,1))
7096 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7097 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7101 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7102 & EAEAderx(1,1,lll,kkk,iii,2))
7107 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7108 C They are needed only when the fifth- or the sixth-order cumulants are
7110 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7111 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7112 call transpose2(AEA(1,1,1),auxmat(1,1))
7113 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7114 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7115 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7116 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7117 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7118 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7119 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7120 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7121 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7122 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7123 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7124 call transpose2(AEA(1,1,2),auxmat(1,1))
7125 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7126 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7127 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7128 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7130 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7131 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7132 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7133 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7134 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7135 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7136 C Calculate the Cartesian derivatives of the vectors.
7140 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,iti),
7142 & AEAb1derx(1,lll,kkk,iii,1,1))
7143 call matvec2(auxmat(1,1),Ub2(1,i),
7144 & AEAb2derx(1,lll,kkk,iii,1,1))
7145 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7146 & AEAb1derx(1,lll,kkk,iii,2,1))
7147 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7148 & AEAb2derx(1,lll,kkk,iii,2,1))
7149 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7150 call matvec2(auxmat(1,1),b1(1,itl),
7151 & AEAb1derx(1,lll,kkk,iii,1,2))
7152 call matvec2(auxmat(1,1),Ub2(1,l),
7153 & AEAb2derx(1,lll,kkk,iii,1,2))
7154 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7155 & AEAb1derx(1,lll,kkk,iii,2,2))
7156 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7157 & AEAb2derx(1,lll,kkk,iii,2,2))
7166 C---------------------------------------------------------------------------
7167 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7168 & KK,KKderg,AKA,AKAderg,AKAderx)
7172 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7173 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7174 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7179 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7181 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7184 cd if (lprn) write (2,*) 'In kernel'
7186 cd if (lprn) write (2,*) 'kkk=',kkk
7188 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7189 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7191 cd write (2,*) 'lll=',lll
7192 cd write (2,*) 'iii=1'
7194 cd write (2,'(3(2f10.5),5x)')
7195 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7198 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7199 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7201 cd write (2,*) 'lll=',lll
7202 cd write (2,*) 'iii=2'
7204 cd write (2,'(3(2f10.5),5x)')
7205 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7212 C---------------------------------------------------------------------------
7213 double precision function eello4(i,j,k,l,jj,kk)
7214 implicit real*8 (a-h,o-z)
7215 include 'DIMENSIONS'
7216 include 'COMMON.IOUNITS'
7217 include 'COMMON.CHAIN'
7218 include 'COMMON.DERIV'
7219 include 'COMMON.INTERACT'
7220 include 'COMMON.CONTACTS'
7221 include 'COMMON.TORSION'
7222 include 'COMMON.VAR'
7223 include 'COMMON.GEO'
7224 double precision pizda(2,2),ggg1(3),ggg2(3)
7225 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7229 cd print *,'eello4:',i,j,k,l,jj,kk
7230 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7231 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7232 cold eij=facont_hb(jj,i)
7233 cold ekl=facont_hb(kk,k)
7235 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7236 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7237 gcorr_loc(k-1)=gcorr_loc(k-1)
7238 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7240 gcorr_loc(l-1)=gcorr_loc(l-1)
7241 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7243 gcorr_loc(j-1)=gcorr_loc(j-1)
7244 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7249 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7250 & -EAEAderx(2,2,lll,kkk,iii,1)
7251 cd derx(lll,kkk,iii)=0.0d0
7255 cd gcorr_loc(l-1)=0.0d0
7256 cd gcorr_loc(j-1)=0.0d0
7257 cd gcorr_loc(k-1)=0.0d0
7259 cd write (iout,*)'Contacts have occurred for peptide groups',
7260 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7261 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7262 if (j.lt.nres-1) then
7269 if (l.lt.nres-1) then
7277 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7278 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7279 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7280 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7281 cgrad ghalf=0.5d0*ggg1(ll)
7282 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7283 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7284 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7285 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7286 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7287 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7288 cgrad ghalf=0.5d0*ggg2(ll)
7289 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7290 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7291 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7292 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7293 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7294 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7298 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7303 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7308 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7313 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7317 cd write (2,*) iii,gcorr_loc(iii)
7320 cd write (2,*) 'ekont',ekont
7321 cd write (iout,*) 'eello4',ekont*eel4
7324 C---------------------------------------------------------------------------
7325 double precision function eello5(i,j,k,l,jj,kk)
7326 implicit real*8 (a-h,o-z)
7327 include 'DIMENSIONS'
7328 include 'COMMON.IOUNITS'
7329 include 'COMMON.CHAIN'
7330 include 'COMMON.DERIV'
7331 include 'COMMON.INTERACT'
7332 include 'COMMON.CONTACTS'
7333 include 'COMMON.TORSION'
7334 include 'COMMON.VAR'
7335 include 'COMMON.GEO'
7336 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7337 double precision ggg1(3),ggg2(3)
7338 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7343 C /l\ / \ \ / \ / \ / C
7344 C / \ / \ \ / \ / \ / C
7345 C j| o |l1 | o | o| o | | o |o C
7346 C \ |/k\| |/ \| / |/ \| |/ \| C
7347 C \i/ \ / \ / / \ / \ C
7349 C (I) (II) (III) (IV) C
7351 C eello5_1 eello5_2 eello5_3 eello5_4 C
7353 C Antiparallel chains C
7356 C /j\ / \ \ / \ / \ / C
7357 C / \ / \ \ / \ / \ / C
7358 C j1| o |l | o | o| o | | o |o C
7359 C \ |/k\| |/ \| / |/ \| |/ \| C
7360 C \i/ \ / \ / / \ / \ C
7362 C (I) (II) (III) (IV) C
7364 C eello5_1 eello5_2 eello5_3 eello5_4 C
7366 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7368 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7369 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7374 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7376 itk=itortyp(itype(k))
7377 itl=itortyp(itype(l))
7378 itj=itortyp(itype(j))
7383 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7384 cd & eel5_3_num,eel5_4_num)
7388 derx(lll,kkk,iii)=0.0d0
7392 cd eij=facont_hb(jj,i)
7393 cd ekl=facont_hb(kk,k)
7395 cd write (iout,*)'Contacts have occurred for peptide groups',
7396 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7398 C Contribution from the graph I.
7399 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7400 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7401 call transpose2(EUg(1,1,k),auxmat(1,1))
7402 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7403 vv(1)=pizda(1,1)-pizda(2,2)
7404 vv(2)=pizda(1,2)+pizda(2,1)
7405 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7406 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7407 C Explicit gradient in virtual-dihedral angles.
7408 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7409 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7410 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7411 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7412 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7413 vv(1)=pizda(1,1)-pizda(2,2)
7414 vv(2)=pizda(1,2)+pizda(2,1)
7415 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7416 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7417 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7418 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7419 vv(1)=pizda(1,1)-pizda(2,2)
7420 vv(2)=pizda(1,2)+pizda(2,1)
7422 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7423 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7424 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7426 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7427 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7428 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7430 C Cartesian gradient
7434 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7436 vv(1)=pizda(1,1)-pizda(2,2)
7437 vv(2)=pizda(1,2)+pizda(2,1)
7438 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7439 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7440 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7446 C Contribution from graph II
7447 call transpose2(EE(1,1,itk),auxmat(1,1))
7448 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7449 vv(1)=pizda(1,1)+pizda(2,2)
7450 vv(2)=pizda(2,1)-pizda(1,2)
7451 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7452 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7453 C Explicit gradient in virtual-dihedral angles.
7454 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7455 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7456 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7457 vv(1)=pizda(1,1)+pizda(2,2)
7458 vv(2)=pizda(2,1)-pizda(1,2)
7460 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7461 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7462 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7464 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7465 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7466 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7468 C Cartesian gradient
7472 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7474 vv(1)=pizda(1,1)+pizda(2,2)
7475 vv(2)=pizda(2,1)-pizda(1,2)
7476 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7477 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7478 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7486 C Parallel orientation
7487 C Contribution from graph III
7488 call transpose2(EUg(1,1,l),auxmat(1,1))
7489 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7490 vv(1)=pizda(1,1)-pizda(2,2)
7491 vv(2)=pizda(1,2)+pizda(2,1)
7492 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7493 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7494 C Explicit gradient in virtual-dihedral angles.
7495 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7496 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7497 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7498 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7499 vv(1)=pizda(1,1)-pizda(2,2)
7500 vv(2)=pizda(1,2)+pizda(2,1)
7501 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7502 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7503 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7504 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7505 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7506 vv(1)=pizda(1,1)-pizda(2,2)
7507 vv(2)=pizda(1,2)+pizda(2,1)
7508 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7509 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7510 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7511 C Cartesian gradient
7515 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7517 vv(1)=pizda(1,1)-pizda(2,2)
7518 vv(2)=pizda(1,2)+pizda(2,1)
7519 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7520 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7521 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7526 C Contribution from graph IV
7528 call transpose2(EE(1,1,itl),auxmat(1,1))
7529 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7530 vv(1)=pizda(1,1)+pizda(2,2)
7531 vv(2)=pizda(2,1)-pizda(1,2)
7532 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7533 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7534 C Explicit gradient in virtual-dihedral angles.
7535 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7536 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7537 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7538 vv(1)=pizda(1,1)+pizda(2,2)
7539 vv(2)=pizda(2,1)-pizda(1,2)
7540 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7541 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7542 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7543 C Cartesian gradient
7547 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7549 vv(1)=pizda(1,1)+pizda(2,2)
7550 vv(2)=pizda(2,1)-pizda(1,2)
7551 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7552 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7553 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7558 C Antiparallel orientation
7559 C Contribution from graph III
7561 call transpose2(EUg(1,1,j),auxmat(1,1))
7562 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7563 vv(1)=pizda(1,1)-pizda(2,2)
7564 vv(2)=pizda(1,2)+pizda(2,1)
7565 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7566 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7567 C Explicit gradient in virtual-dihedral angles.
7568 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7569 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7570 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7571 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7572 vv(1)=pizda(1,1)-pizda(2,2)
7573 vv(2)=pizda(1,2)+pizda(2,1)
7574 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7575 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7576 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7577 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7578 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7582 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7583 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7584 C Cartesian gradient
7588 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7590 vv(1)=pizda(1,1)-pizda(2,2)
7591 vv(2)=pizda(1,2)+pizda(2,1)
7592 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7593 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7594 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7599 C Contribution from graph IV
7601 call transpose2(EE(1,1,itj),auxmat(1,1))
7602 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7603 vv(1)=pizda(1,1)+pizda(2,2)
7604 vv(2)=pizda(2,1)-pizda(1,2)
7605 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7606 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7607 C Explicit gradient in virtual-dihedral angles.
7608 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7609 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7610 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7611 vv(1)=pizda(1,1)+pizda(2,2)
7612 vv(2)=pizda(2,1)-pizda(1,2)
7613 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7614 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7615 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7616 C Cartesian gradient
7620 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7622 vv(1)=pizda(1,1)+pizda(2,2)
7623 vv(2)=pizda(2,1)-pizda(1,2)
7624 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7625 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7626 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7632 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7633 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7634 cd write (2,*) 'ijkl',i,j,k,l
7635 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7636 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7638 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7639 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7640 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7641 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7642 if (j.lt.nres-1) then
7649 if (l.lt.nres-1) then
7659 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7660 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7661 C summed up outside the subrouine as for the other subroutines
7662 C handling long-range interactions. The old code is commented out
7663 C with "cgrad" to keep track of changes.
7665 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7666 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7667 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7668 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7669 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7670 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7671 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7672 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7673 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7674 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7676 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7677 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7678 cgrad ghalf=0.5d0*ggg1(ll)
7680 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7681 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7682 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7683 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7684 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7685 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7686 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7687 cgrad ghalf=0.5d0*ggg2(ll)
7689 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7690 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7691 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7692 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7693 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7694 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7699 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7700 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7705 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7706 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7712 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7717 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7721 cd write (2,*) iii,g_corr5_loc(iii)
7724 cd write (2,*) 'ekont',ekont
7725 cd write (iout,*) 'eello5',ekont*eel5
7728 c--------------------------------------------------------------------------
7729 double precision function eello6(i,j,k,l,jj,kk)
7730 implicit real*8 (a-h,o-z)
7731 include 'DIMENSIONS'
7732 include 'COMMON.IOUNITS'
7733 include 'COMMON.CHAIN'
7734 include 'COMMON.DERIV'
7735 include 'COMMON.INTERACT'
7736 include 'COMMON.CONTACTS'
7737 include 'COMMON.TORSION'
7738 include 'COMMON.VAR'
7739 include 'COMMON.GEO'
7740 include 'COMMON.FFIELD'
7741 double precision ggg1(3),ggg2(3)
7742 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7747 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7755 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7756 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7760 derx(lll,kkk,iii)=0.0d0
7764 cd eij=facont_hb(jj,i)
7765 cd ekl=facont_hb(kk,k)
7771 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7772 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7773 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7774 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7775 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7776 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7778 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7779 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7780 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7781 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7782 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7783 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7787 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7789 C If turn contributions are considered, they will be handled separately.
7790 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7791 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7792 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7793 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7794 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7795 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7796 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7798 if (j.lt.nres-1) then
7805 if (l.lt.nres-1) then
7813 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7814 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7815 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7816 cgrad ghalf=0.5d0*ggg1(ll)
7818 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7819 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7820 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7821 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7822 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7823 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7824 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7825 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7826 cgrad ghalf=0.5d0*ggg2(ll)
7827 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7829 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7830 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7831 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7832 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7833 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7834 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7839 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7840 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7845 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7846 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7852 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7857 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7861 cd write (2,*) iii,g_corr6_loc(iii)
7864 cd write (2,*) 'ekont',ekont
7865 cd write (iout,*) 'eello6',ekont*eel6
7868 c--------------------------------------------------------------------------
7869 double precision function eello6_graph1(i,j,k,l,imat,swap)
7870 implicit real*8 (a-h,o-z)
7871 include 'DIMENSIONS'
7872 include 'COMMON.IOUNITS'
7873 include 'COMMON.CHAIN'
7874 include 'COMMON.DERIV'
7875 include 'COMMON.INTERACT'
7876 include 'COMMON.CONTACTS'
7877 include 'COMMON.TORSION'
7878 include 'COMMON.VAR'
7879 include 'COMMON.GEO'
7880 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7884 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7886 C Parallel Antiparallel C
7892 C \ j|/k\| / \ |/k\|l / C
7897 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7898 itk=itortyp(itype(k))
7899 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7900 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7901 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7902 call transpose2(EUgC(1,1,k),auxmat(1,1))
7903 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7904 vv1(1)=pizda1(1,1)-pizda1(2,2)
7905 vv1(2)=pizda1(1,2)+pizda1(2,1)
7906 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7907 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7908 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7909 s5=scalar2(vv(1),Dtobr2(1,i))
7910 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7911 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7912 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7913 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7914 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7915 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7916 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7917 & +scalar2(vv(1),Dtobr2der(1,i)))
7918 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7919 vv1(1)=pizda1(1,1)-pizda1(2,2)
7920 vv1(2)=pizda1(1,2)+pizda1(2,1)
7921 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7922 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7924 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7925 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7926 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7927 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7928 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7930 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7931 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7932 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7933 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7934 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7936 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7937 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7938 vv1(1)=pizda1(1,1)-pizda1(2,2)
7939 vv1(2)=pizda1(1,2)+pizda1(2,1)
7940 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7941 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7942 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7943 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7952 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7953 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7954 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7955 call transpose2(EUgC(1,1,k),auxmat(1,1))
7956 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7958 vv1(1)=pizda1(1,1)-pizda1(2,2)
7959 vv1(2)=pizda1(1,2)+pizda1(2,1)
7960 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7961 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7962 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7963 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7964 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7965 s5=scalar2(vv(1),Dtobr2(1,i))
7966 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7972 c----------------------------------------------------------------------------
7973 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7974 implicit real*8 (a-h,o-z)
7975 include 'DIMENSIONS'
7976 include 'COMMON.IOUNITS'
7977 include 'COMMON.CHAIN'
7978 include 'COMMON.DERIV'
7979 include 'COMMON.INTERACT'
7980 include 'COMMON.CONTACTS'
7981 include 'COMMON.TORSION'
7982 include 'COMMON.VAR'
7983 include 'COMMON.GEO'
7985 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7986 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7991 C Parallel Antiparallel C
7997 C \ j|/k\| \ |/k\|l C
8002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8003 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8004 C AL 7/4/01 s1 would occur in the sixth-order moment,
8005 C but not in a cluster cumulant
8007 s1=dip(1,jj,i)*dip(1,kk,k)
8009 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8010 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8011 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8012 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8013 call transpose2(EUg(1,1,k),auxmat(1,1))
8014 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8015 vv(1)=pizda(1,1)-pizda(2,2)
8016 vv(2)=pizda(1,2)+pizda(2,1)
8017 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8018 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8020 eello6_graph2=-(s1+s2+s3+s4)
8022 eello6_graph2=-(s2+s3+s4)
8025 C Derivatives in gamma(i-1)
8028 s1=dipderg(1,jj,i)*dip(1,kk,k)
8030 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8031 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8032 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8033 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8035 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8037 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8039 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8041 C Derivatives in gamma(k-1)
8043 s1=dip(1,jj,i)*dipderg(1,kk,k)
8045 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8046 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8047 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8048 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8049 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8050 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8051 vv(1)=pizda(1,1)-pizda(2,2)
8052 vv(2)=pizda(1,2)+pizda(2,1)
8053 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8055 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8057 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8059 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8060 C Derivatives in gamma(j-1) or gamma(l-1)
8063 s1=dipderg(3,jj,i)*dip(1,kk,k)
8065 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8066 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8067 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8068 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8069 vv(1)=pizda(1,1)-pizda(2,2)
8070 vv(2)=pizda(1,2)+pizda(2,1)
8071 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8074 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8076 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8079 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8080 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8082 C Derivatives in gamma(l-1) or gamma(j-1)
8085 s1=dip(1,jj,i)*dipderg(3,kk,k)
8087 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8088 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8089 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8090 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8091 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8092 vv(1)=pizda(1,1)-pizda(2,2)
8093 vv(2)=pizda(1,2)+pizda(2,1)
8094 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8097 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8099 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8102 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8103 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8105 C Cartesian derivatives.
8107 write (2,*) 'In eello6_graph2'
8109 write (2,*) 'iii=',iii
8111 write (2,*) 'kkk=',kkk
8113 write (2,'(3(2f10.5),5x)')
8114 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8124 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8126 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8129 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8131 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8132 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8134 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8135 call transpose2(EUg(1,1,k),auxmat(1,1))
8136 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8138 vv(1)=pizda(1,1)-pizda(2,2)
8139 vv(2)=pizda(1,2)+pizda(2,1)
8140 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8141 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8143 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8145 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8148 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8150 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8157 c----------------------------------------------------------------------------
8158 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8159 implicit real*8 (a-h,o-z)
8160 include 'DIMENSIONS'
8161 include 'COMMON.IOUNITS'
8162 include 'COMMON.CHAIN'
8163 include 'COMMON.DERIV'
8164 include 'COMMON.INTERACT'
8165 include 'COMMON.CONTACTS'
8166 include 'COMMON.TORSION'
8167 include 'COMMON.VAR'
8168 include 'COMMON.GEO'
8169 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8171 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8173 C Parallel Antiparallel C
8179 C j|/k\| / |/k\|l / C
8184 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8186 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8187 C energy moment and not to the cluster cumulant.
8188 iti=itortyp(itype(i))
8189 if (j.lt.nres-1) then
8190 itj1=itortyp(itype(j+1))
8194 itk=itortyp(itype(k))
8195 itk1=itortyp(itype(k+1))
8196 if (l.lt.nres-1) then
8197 itl1=itortyp(itype(l+1))
8202 s1=dip(4,jj,i)*dip(4,kk,k)
8204 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8205 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8206 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8207 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8208 call transpose2(EE(1,1,itk),auxmat(1,1))
8209 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8210 vv(1)=pizda(1,1)+pizda(2,2)
8211 vv(2)=pizda(2,1)-pizda(1,2)
8212 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8213 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8214 cd & "sum",-(s2+s3+s4)
8216 eello6_graph3=-(s1+s2+s3+s4)
8218 eello6_graph3=-(s2+s3+s4)
8221 C Derivatives in gamma(k-1)
8222 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8223 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8224 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8225 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8226 C Derivatives in gamma(l-1)
8227 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8228 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8229 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8230 vv(1)=pizda(1,1)+pizda(2,2)
8231 vv(2)=pizda(2,1)-pizda(1,2)
8232 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8233 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8234 C Cartesian derivatives.
8240 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8242 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8245 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8247 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8248 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8250 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8251 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8253 vv(1)=pizda(1,1)+pizda(2,2)
8254 vv(2)=pizda(2,1)-pizda(1,2)
8255 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8257 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8259 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8262 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8264 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8266 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8272 c----------------------------------------------------------------------------
8273 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8274 implicit real*8 (a-h,o-z)
8275 include 'DIMENSIONS'
8276 include 'COMMON.IOUNITS'
8277 include 'COMMON.CHAIN'
8278 include 'COMMON.DERIV'
8279 include 'COMMON.INTERACT'
8280 include 'COMMON.CONTACTS'
8281 include 'COMMON.TORSION'
8282 include 'COMMON.VAR'
8283 include 'COMMON.GEO'
8284 include 'COMMON.FFIELD'
8285 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8286 & auxvec1(2),auxmat1(2,2)
8288 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8290 C Parallel Antiparallel C
8296 C \ j|/k\| \ |/k\|l C
8301 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8303 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8304 C energy moment and not to the cluster cumulant.
8305 cd write (2,*) 'eello_graph4: wturn6',wturn6
8306 iti=itortyp(itype(i))
8307 itj=itortyp(itype(j))
8308 if (j.lt.nres-1) then
8309 itj1=itortyp(itype(j+1))
8313 itk=itortyp(itype(k))
8314 if (k.lt.nres-1) then
8315 itk1=itortyp(itype(k+1))
8319 itl=itortyp(itype(l))
8320 if (l.lt.nres-1) then
8321 itl1=itortyp(itype(l+1))
8325 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8326 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8327 cd & ' itl',itl,' itl1',itl1
8330 s1=dip(3,jj,i)*dip(3,kk,k)
8332 s1=dip(2,jj,j)*dip(2,kk,l)
8335 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8336 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8338 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8339 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8341 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8342 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8344 call transpose2(EUg(1,1,k),auxmat(1,1))
8345 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8346 vv(1)=pizda(1,1)-pizda(2,2)
8347 vv(2)=pizda(2,1)+pizda(1,2)
8348 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8349 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8351 eello6_graph4=-(s1+s2+s3+s4)
8353 eello6_graph4=-(s2+s3+s4)
8355 C Derivatives in gamma(i-1)
8359 s1=dipderg(2,jj,i)*dip(3,kk,k)
8361 s1=dipderg(4,jj,j)*dip(2,kk,l)
8364 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8366 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8367 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8369 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8370 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8372 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8373 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8374 cd write (2,*) 'turn6 derivatives'
8376 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8378 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8382 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8384 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8388 C Derivatives in gamma(k-1)
8391 s1=dip(3,jj,i)*dipderg(2,kk,k)
8393 s1=dip(2,jj,j)*dipderg(4,kk,l)
8396 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8397 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8399 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8400 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8402 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8403 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8405 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8406 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8407 vv(1)=pizda(1,1)-pizda(2,2)
8408 vv(2)=pizda(2,1)+pizda(1,2)
8409 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8410 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8412 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8414 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8418 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8420 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8423 C Derivatives in gamma(j-1) or gamma(l-1)
8424 if (l.eq.j+1 .and. l.gt.1) then
8425 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8426 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8427 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8428 vv(1)=pizda(1,1)-pizda(2,2)
8429 vv(2)=pizda(2,1)+pizda(1,2)
8430 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8431 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8432 else if (j.gt.1) then
8433 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8434 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8435 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8436 vv(1)=pizda(1,1)-pizda(2,2)
8437 vv(2)=pizda(2,1)+pizda(1,2)
8438 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8439 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8440 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8442 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8445 C Cartesian derivatives.
8452 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8454 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8458 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8460 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8464 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8466 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8468 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8469 & b1(1,itj1),auxvec(1))
8470 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8472 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8473 & b1(1,itl1),auxvec(1))
8474 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8476 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8478 vv(1)=pizda(1,1)-pizda(2,2)
8479 vv(2)=pizda(2,1)+pizda(1,2)
8480 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8482 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8484 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8487 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8490 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8493 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8495 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8497 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8501 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8503 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8506 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8508 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8516 c----------------------------------------------------------------------------
8517 double precision function eello_turn6(i,jj,kk)
8518 implicit real*8 (a-h,o-z)
8519 include 'DIMENSIONS'
8520 include 'COMMON.IOUNITS'
8521 include 'COMMON.CHAIN'
8522 include 'COMMON.DERIV'
8523 include 'COMMON.INTERACT'
8524 include 'COMMON.CONTACTS'
8525 include 'COMMON.TORSION'
8526 include 'COMMON.VAR'
8527 include 'COMMON.GEO'
8528 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8529 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8531 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8532 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8533 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8534 C the respective energy moment and not to the cluster cumulant.
8543 iti=itortyp(itype(i))
8544 itk=itortyp(itype(k))
8545 itk1=itortyp(itype(k+1))
8546 itl=itortyp(itype(l))
8547 itj=itortyp(itype(j))
8548 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8549 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8550 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8555 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8557 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8561 derx_turn(lll,kkk,iii)=0.0d0
8568 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8570 cd write (2,*) 'eello6_5',eello6_5
8572 call transpose2(AEA(1,1,1),auxmat(1,1))
8573 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8574 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8575 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8577 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8578 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8579 s2 = scalar2(b1(1,itk),vtemp1(1))
8581 call transpose2(AEA(1,1,2),atemp(1,1))
8582 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8583 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8584 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8586 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8587 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8588 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8590 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8591 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8592 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8593 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8594 ss13 = scalar2(b1(1,itk),vtemp4(1))
8595 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8597 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8603 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8604 C Derivatives in gamma(i+2)
8608 call transpose2(AEA(1,1,1),auxmatd(1,1))
8609 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8610 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8611 call transpose2(AEAderg(1,1,2),atempd(1,1))
8612 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8613 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8615 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8616 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8617 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8623 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8624 C Derivatives in gamma(i+3)
8626 call transpose2(AEA(1,1,1),auxmatd(1,1))
8627 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8628 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8629 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8631 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8632 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8633 s2d = scalar2(b1(1,itk),vtemp1d(1))
8635 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8636 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8638 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8640 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8641 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8642 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8650 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8651 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8653 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8654 & -0.5d0*ekont*(s2d+s12d)
8656 C Derivatives in gamma(i+4)
8657 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8658 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8659 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8661 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8662 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8663 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8671 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8673 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8675 C Derivatives in gamma(i+5)
8677 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8678 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8679 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8681 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8682 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8683 s2d = scalar2(b1(1,itk),vtemp1d(1))
8685 call transpose2(AEA(1,1,2),atempd(1,1))
8686 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8687 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8689 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8690 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8692 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8693 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8694 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8702 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8703 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8705 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8706 & -0.5d0*ekont*(s2d+s12d)
8708 C Cartesian derivatives
8713 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8714 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8715 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8717 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8718 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8720 s2d = scalar2(b1(1,itk),vtemp1d(1))
8722 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8723 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8724 s8d = -(atempd(1,1)+atempd(2,2))*
8725 & scalar2(cc(1,1,itl),vtemp2(1))
8727 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8729 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8730 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8737 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8740 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8744 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8745 & - 0.5d0*(s8d+s12d)
8747 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8756 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8758 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8759 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8760 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8761 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8762 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8764 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8765 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8766 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8770 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8771 cd & 16*eel_turn6_num
8773 if (j.lt.nres-1) then
8780 if (l.lt.nres-1) then
8788 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8789 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8790 cgrad ghalf=0.5d0*ggg1(ll)
8792 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8793 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8794 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8795 & +ekont*derx_turn(ll,2,1)
8796 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8797 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8798 & +ekont*derx_turn(ll,4,1)
8799 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8800 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8801 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8802 cgrad ghalf=0.5d0*ggg2(ll)
8804 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8805 & +ekont*derx_turn(ll,2,2)
8806 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8807 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8808 & +ekont*derx_turn(ll,4,2)
8809 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8810 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8811 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8816 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8821 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8827 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8832 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8836 cd write (2,*) iii,g_corr6_loc(iii)
8838 eello_turn6=ekont*eel_turn6
8839 cd write (2,*) 'ekont',ekont
8840 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8844 C-----------------------------------------------------------------------------
8845 double precision function scalar(u,v)
8846 !DIR$ INLINEALWAYS scalar
8848 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8851 double precision u(3),v(3)
8852 cd double precision sc
8860 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8863 crc-------------------------------------------------
8864 SUBROUTINE MATVEC2(A1,V1,V2)
8865 !DIR$ INLINEALWAYS MATVEC2
8867 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8869 implicit real*8 (a-h,o-z)
8870 include 'DIMENSIONS'
8871 DIMENSION A1(2,2),V1(2),V2(2)
8875 c 3 VI=VI+A1(I,K)*V1(K)
8879 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8880 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8885 C---------------------------------------
8886 SUBROUTINE MATMAT2(A1,A2,A3)
8888 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8890 implicit real*8 (a-h,o-z)
8891 include 'DIMENSIONS'
8892 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8893 c DIMENSION AI3(2,2)
8897 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8903 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8904 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8905 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8906 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8914 c-------------------------------------------------------------------------
8915 double precision function scalar2(u,v)
8916 !DIR$ INLINEALWAYS scalar2
8918 double precision u(2),v(2)
8921 scalar2=u(1)*v(1)+u(2)*v(2)
8925 C-----------------------------------------------------------------------------
8927 subroutine transpose2(a,at)
8928 !DIR$ INLINEALWAYS transpose2
8930 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8933 double precision a(2,2),at(2,2)
8940 c--------------------------------------------------------------------------
8941 subroutine transpose(n,a,at)
8944 double precision a(n,n),at(n,n)
8952 C---------------------------------------------------------------------------
8953 subroutine prodmat3(a1,a2,kk,transp,prod)
8954 !DIR$ INLINEALWAYS prodmat3
8956 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8960 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8962 crc double precision auxmat(2,2),prod_(2,2)
8965 crc call transpose2(kk(1,1),auxmat(1,1))
8966 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8967 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8969 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8970 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8971 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8972 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8973 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8974 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8975 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8976 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8979 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8980 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8982 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8983 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8984 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8985 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8986 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8987 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8988 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8989 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8992 c call transpose2(a2(1,1),a2t(1,1))
8995 crc print *,((prod_(i,j),i=1,2),j=1,2)
8996 crc print *,((prod(i,j),i=1,2),j=1,2)