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,2i5,2e11.3)')
2943 &,iteli,itelj,aaa,evdw1
2944 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2948 C Calculate contributions to the Cartesian gradient.
2951 facvdw=-6*rrmij*(ev1+evdwij)
2952 facel=-3*rrmij*(el1+eesij)
2958 * Radial derivatives. First process both termini of the fragment (i,j)
2964 c ghalf=0.5D0*ggg(k)
2965 c gelc(k,i)=gelc(k,i)+ghalf
2966 c gelc(k,j)=gelc(k,j)+ghalf
2968 c 9/28/08 AL Gradient compotents will be summed only at the end
2970 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2971 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2974 * Loop over residues i+1 thru j-1.
2978 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2985 c ghalf=0.5D0*ggg(k)
2986 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2987 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2989 c 9/28/08 AL Gradient compotents will be summed only at the end
2991 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2992 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2995 * Loop over residues i+1 thru j-1.
2999 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3006 fac=-3*rrmij*(facvdw+facvdw+facel)
3011 * Radial derivatives. First process both termini of the fragment (i,j)
3017 c ghalf=0.5D0*ggg(k)
3018 c gelc(k,i)=gelc(k,i)+ghalf
3019 c gelc(k,j)=gelc(k,j)+ghalf
3021 c 9/28/08 AL Gradient compotents will be summed only at the end
3023 gelc_long(k,j)=gelc(k,j)+ggg(k)
3024 gelc_long(k,i)=gelc(k,i)-ggg(k)
3027 * Loop over residues i+1 thru j-1.
3031 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3034 c 9/28/08 AL Gradient compotents will be summed only at the end
3039 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3040 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3046 ecosa=2.0D0*fac3*fac1+fac4
3049 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3050 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3052 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3053 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3055 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3056 cd & (dcosg(k),k=1,3)
3058 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3061 c ghalf=0.5D0*ggg(k)
3062 c gelc(k,i)=gelc(k,i)+ghalf
3063 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3064 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3065 c gelc(k,j)=gelc(k,j)+ghalf
3066 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3067 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3071 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3076 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3077 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3079 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3080 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3081 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3082 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3084 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3085 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3086 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3088 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3089 C energy of a peptide unit is assumed in the form of a second-order
3090 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3091 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3092 C are computed for EVERY pair of non-contiguous peptide groups.
3094 if (j.lt.nres-1) then
3105 muij(kkk)=mu(k,i)*mu(l,j)
3108 cd write (iout,*) 'EELEC: i',i,' j',j
3109 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3110 cd write(iout,*) 'muij',muij
3111 ury=scalar(uy(1,i),erij)
3112 urz=scalar(uz(1,i),erij)
3113 vry=scalar(uy(1,j),erij)
3114 vrz=scalar(uz(1,j),erij)
3115 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3116 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3117 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3118 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3119 fac=dsqrt(-ael6i)*r3ij
3124 cd write (iout,'(4i5,4f10.5)')
3125 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3126 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3127 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3128 cd & uy(:,j),uz(:,j)
3129 cd write (iout,'(4f10.5)')
3130 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3131 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3132 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3133 cd write (iout,'(9f10.5/)')
3134 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3135 C Derivatives of the elements of A in virtual-bond vectors
3136 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3138 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3139 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3140 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3141 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3142 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3143 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3144 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3145 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3146 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3147 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3148 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3149 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3151 C Compute radial contributions to the gradient
3169 C Add the contributions coming from er
3172 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3173 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3174 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3175 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3178 C Derivatives in DC(i)
3179 cgrad ghalf1=0.5d0*agg(k,1)
3180 cgrad ghalf2=0.5d0*agg(k,2)
3181 cgrad ghalf3=0.5d0*agg(k,3)
3182 cgrad ghalf4=0.5d0*agg(k,4)
3183 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3184 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3185 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3186 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3187 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3188 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3189 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3190 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3191 C Derivatives in DC(i+1)
3192 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3193 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3194 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3195 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3196 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3197 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3198 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3199 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3200 C Derivatives in DC(j)
3201 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3202 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3203 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3204 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3205 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3206 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3207 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3208 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3209 C Derivatives in DC(j+1) or DC(nres-1)
3210 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3211 & -3.0d0*vryg(k,3)*ury)
3212 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3213 & -3.0d0*vrzg(k,3)*ury)
3214 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3215 & -3.0d0*vryg(k,3)*urz)
3216 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3217 & -3.0d0*vrzg(k,3)*urz)
3218 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3220 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3233 aggi(k,l)=-aggi(k,l)
3234 aggi1(k,l)=-aggi1(k,l)
3235 aggj(k,l)=-aggj(k,l)
3236 aggj1(k,l)=-aggj1(k,l)
3239 if (j.lt.nres-1) then
3245 aggi(k,l)=-aggi(k,l)
3246 aggi1(k,l)=-aggi1(k,l)
3247 aggj(k,l)=-aggj(k,l)
3248 aggj1(k,l)=-aggj1(k,l)
3259 aggi(k,l)=-aggi(k,l)
3260 aggi1(k,l)=-aggi1(k,l)
3261 aggj(k,l)=-aggj(k,l)
3262 aggj1(k,l)=-aggj1(k,l)
3267 IF (wel_loc.gt.0.0d0) THEN
3268 C Contribution to the local-electrostatic energy coming from the i-j pair
3269 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3271 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3273 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3274 & 'eelloc',i,j,eel_loc_ij
3276 eel_loc=eel_loc+eel_loc_ij
3277 C Partial derivatives in virtual-bond dihedral angles gamma
3279 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3280 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3281 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3282 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3283 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3284 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3285 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3287 ggg(l)=agg(l,1)*muij(1)+
3288 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3289 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3290 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3291 cgrad ghalf=0.5d0*ggg(l)
3292 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3293 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3297 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3300 C Remaining derivatives of eello
3302 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3303 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3304 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3305 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3306 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3307 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3308 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3309 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3312 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3313 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3314 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3315 & .and. num_conti.le.maxconts) then
3316 c write (iout,*) i,j," entered corr"
3318 C Calculate the contact function. The ith column of the array JCONT will
3319 C contain the numbers of atoms that make contacts with the atom I (of numbers
3320 C greater than I). The arrays FACONT and GACONT will contain the values of
3321 C the contact function and its derivative.
3322 c r0ij=1.02D0*rpp(iteli,itelj)
3323 c r0ij=1.11D0*rpp(iteli,itelj)
3324 r0ij=2.20D0*rpp(iteli,itelj)
3325 c r0ij=1.55D0*rpp(iteli,itelj)
3326 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3327 if (fcont.gt.0.0D0) then
3328 num_conti=num_conti+1
3329 if (num_conti.gt.maxconts) then
3330 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3331 & ' will skip next contacts for this conf.'
3333 jcont_hb(num_conti,i)=j
3334 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3335 cd & " jcont_hb",jcont_hb(num_conti,i)
3336 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3337 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3338 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3340 d_cont(num_conti,i)=rij
3341 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3342 C --- Electrostatic-interaction matrix ---
3343 a_chuj(1,1,num_conti,i)=a22
3344 a_chuj(1,2,num_conti,i)=a23
3345 a_chuj(2,1,num_conti,i)=a32
3346 a_chuj(2,2,num_conti,i)=a33
3347 C --- Gradient of rij
3349 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3356 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3357 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3358 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3359 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3360 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3365 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3366 C Calculate contact energies
3368 wij=cosa-3.0D0*cosb*cosg
3371 c fac3=dsqrt(-ael6i)/r0ij**3
3372 fac3=dsqrt(-ael6i)*r3ij
3373 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3374 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3375 if (ees0tmp.gt.0) then
3376 ees0pij=dsqrt(ees0tmp)
3380 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3381 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3382 if (ees0tmp.gt.0) then
3383 ees0mij=dsqrt(ees0tmp)
3388 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3389 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3390 C Diagnostics. Comment out or remove after debugging!
3391 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3392 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3393 c ees0m(num_conti,i)=0.0D0
3395 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3396 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3397 C Angular derivatives of the contact function
3398 ees0pij1=fac3/ees0pij
3399 ees0mij1=fac3/ees0mij
3400 fac3p=-3.0D0*fac3*rrmij
3401 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3402 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3404 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3405 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3406 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3407 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3408 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3409 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3410 ecosap=ecosa1+ecosa2
3411 ecosbp=ecosb1+ecosb2
3412 ecosgp=ecosg1+ecosg2
3413 ecosam=ecosa1-ecosa2
3414 ecosbm=ecosb1-ecosb2
3415 ecosgm=ecosg1-ecosg2
3424 facont_hb(num_conti,i)=fcont
3425 fprimcont=fprimcont/rij
3426 cd facont_hb(num_conti,i)=1.0D0
3427 C Following line is for diagnostics.
3430 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3431 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3434 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3435 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3437 gggp(1)=gggp(1)+ees0pijp*xj
3438 gggp(2)=gggp(2)+ees0pijp*yj
3439 gggp(3)=gggp(3)+ees0pijp*zj
3440 gggm(1)=gggm(1)+ees0mijp*xj
3441 gggm(2)=gggm(2)+ees0mijp*yj
3442 gggm(3)=gggm(3)+ees0mijp*zj
3443 C Derivatives due to the contact function
3444 gacont_hbr(1,num_conti,i)=fprimcont*xj
3445 gacont_hbr(2,num_conti,i)=fprimcont*yj
3446 gacont_hbr(3,num_conti,i)=fprimcont*zj
3449 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3450 c following the change of gradient-summation algorithm.
3452 cgrad ghalfp=0.5D0*gggp(k)
3453 cgrad ghalfm=0.5D0*gggm(k)
3454 gacontp_hb1(k,num_conti,i)=!ghalfp
3455 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3456 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3457 gacontp_hb2(k,num_conti,i)=!ghalfp
3458 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3459 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3460 gacontp_hb3(k,num_conti,i)=gggp(k)
3461 gacontm_hb1(k,num_conti,i)=!ghalfm
3462 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3463 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3464 gacontm_hb2(k,num_conti,i)=!ghalfm
3465 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3466 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3467 gacontm_hb3(k,num_conti,i)=gggm(k)
3469 C Diagnostics. Comment out or remove after debugging!
3471 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3472 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3473 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3474 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3475 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3476 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3479 endif ! num_conti.le.maxconts
3482 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3485 ghalf=0.5d0*agg(l,k)
3486 aggi(l,k)=aggi(l,k)+ghalf
3487 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3488 aggj(l,k)=aggj(l,k)+ghalf
3491 if (j.eq.nres-1 .and. i.lt.j-2) then
3494 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3499 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3502 C-----------------------------------------------------------------------------
3503 subroutine eturn3(i,eello_turn3)
3504 C Third- and fourth-order contributions from turns
3505 implicit real*8 (a-h,o-z)
3506 include 'DIMENSIONS'
3507 include 'COMMON.IOUNITS'
3508 include 'COMMON.GEO'
3509 include 'COMMON.VAR'
3510 include 'COMMON.LOCAL'
3511 include 'COMMON.CHAIN'
3512 include 'COMMON.DERIV'
3513 include 'COMMON.INTERACT'
3514 include 'COMMON.CONTACTS'
3515 include 'COMMON.TORSION'
3516 include 'COMMON.VECTORS'
3517 include 'COMMON.FFIELD'
3518 include 'COMMON.CONTROL'
3520 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3521 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3522 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3523 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3524 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3525 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3526 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3529 c write (iout,*) "eturn3",i,j,j1,j2
3534 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3536 C Third-order contributions
3543 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3544 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3545 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3546 call transpose2(auxmat(1,1),auxmat1(1,1))
3547 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3548 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3549 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3550 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3551 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3552 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3553 cd & ' eello_turn3_num',4*eello_turn3_num
3554 C Derivatives in gamma(i)
3555 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3556 call transpose2(auxmat2(1,1),auxmat3(1,1))
3557 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3558 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3559 C Derivatives in gamma(i+1)
3560 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3561 call transpose2(auxmat2(1,1),auxmat3(1,1))
3562 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3563 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3564 & +0.5d0*(pizda(1,1)+pizda(2,2))
3565 C Cartesian derivatives
3567 c ghalf1=0.5d0*agg(l,1)
3568 c ghalf2=0.5d0*agg(l,2)
3569 c ghalf3=0.5d0*agg(l,3)
3570 c ghalf4=0.5d0*agg(l,4)
3571 a_temp(1,1)=aggi(l,1)!+ghalf1
3572 a_temp(1,2)=aggi(l,2)!+ghalf2
3573 a_temp(2,1)=aggi(l,3)!+ghalf3
3574 a_temp(2,2)=aggi(l,4)!+ghalf4
3575 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3576 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3577 & +0.5d0*(pizda(1,1)+pizda(2,2))
3578 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3579 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3580 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3581 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3582 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3583 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3584 & +0.5d0*(pizda(1,1)+pizda(2,2))
3585 a_temp(1,1)=aggj(l,1)!+ghalf1
3586 a_temp(1,2)=aggj(l,2)!+ghalf2
3587 a_temp(2,1)=aggj(l,3)!+ghalf3
3588 a_temp(2,2)=aggj(l,4)!+ghalf4
3589 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3590 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3591 & +0.5d0*(pizda(1,1)+pizda(2,2))
3592 a_temp(1,1)=aggj1(l,1)
3593 a_temp(1,2)=aggj1(l,2)
3594 a_temp(2,1)=aggj1(l,3)
3595 a_temp(2,2)=aggj1(l,4)
3596 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3597 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3598 & +0.5d0*(pizda(1,1)+pizda(2,2))
3602 C-------------------------------------------------------------------------------
3603 subroutine eturn4(i,eello_turn4)
3604 C Third- and fourth-order contributions from turns
3605 implicit real*8 (a-h,o-z)
3606 include 'DIMENSIONS'
3607 include 'COMMON.IOUNITS'
3608 include 'COMMON.GEO'
3609 include 'COMMON.VAR'
3610 include 'COMMON.LOCAL'
3611 include 'COMMON.CHAIN'
3612 include 'COMMON.DERIV'
3613 include 'COMMON.INTERACT'
3614 include 'COMMON.CONTACTS'
3615 include 'COMMON.TORSION'
3616 include 'COMMON.VECTORS'
3617 include 'COMMON.FFIELD'
3618 include 'COMMON.CONTROL'
3620 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3621 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3622 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3623 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3624 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3625 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3626 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3629 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3631 C Fourth-order contributions
3639 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3640 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3641 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3646 iti1=itortyp(itype(i+1))
3647 iti2=itortyp(itype(i+2))
3648 iti3=itortyp(itype(i+3))
3649 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3650 call transpose2(EUg(1,1,i+1),e1t(1,1))
3651 call transpose2(Eug(1,1,i+2),e2t(1,1))
3652 call transpose2(Eug(1,1,i+3),e3t(1,1))
3653 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3654 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3655 s1=scalar2(b1(1,iti2),auxvec(1))
3656 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3657 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3658 s2=scalar2(b1(1,iti1),auxvec(1))
3659 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3660 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3661 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3662 eello_turn4=eello_turn4-(s1+s2+s3)
3663 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3664 & 'eturn4',i,j,-(s1+s2+s3)
3665 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3666 cd & ' eello_turn4_num',8*eello_turn4_num
3667 C Derivatives in gamma(i)
3668 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3669 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3670 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3671 s1=scalar2(b1(1,iti2),auxvec(1))
3672 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3673 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3674 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3675 C Derivatives in gamma(i+1)
3676 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3677 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3678 s2=scalar2(b1(1,iti1),auxvec(1))
3679 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3680 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3682 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3683 C Derivatives in gamma(i+2)
3684 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3685 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3686 s1=scalar2(b1(1,iti2),auxvec(1))
3687 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3688 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3689 s2=scalar2(b1(1,iti1),auxvec(1))
3690 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3691 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3692 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3693 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3694 C Cartesian derivatives
3695 C Derivatives of this turn contributions in DC(i+2)
3696 if (j.lt.nres-1) then
3698 a_temp(1,1)=agg(l,1)
3699 a_temp(1,2)=agg(l,2)
3700 a_temp(2,1)=agg(l,3)
3701 a_temp(2,2)=agg(l,4)
3702 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3703 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3704 s1=scalar2(b1(1,iti2),auxvec(1))
3705 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3706 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3707 s2=scalar2(b1(1,iti1),auxvec(1))
3708 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3709 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3710 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3712 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3715 C Remaining derivatives of this turn contribution
3717 a_temp(1,1)=aggi(l,1)
3718 a_temp(1,2)=aggi(l,2)
3719 a_temp(2,1)=aggi(l,3)
3720 a_temp(2,2)=aggi(l,4)
3721 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3722 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3723 s1=scalar2(b1(1,iti2),auxvec(1))
3724 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3725 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3726 s2=scalar2(b1(1,iti1),auxvec(1))
3727 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3728 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3729 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3730 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3731 a_temp(1,1)=aggi1(l,1)
3732 a_temp(1,2)=aggi1(l,2)
3733 a_temp(2,1)=aggi1(l,3)
3734 a_temp(2,2)=aggi1(l,4)
3735 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3736 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3737 s1=scalar2(b1(1,iti2),auxvec(1))
3738 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3739 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3740 s2=scalar2(b1(1,iti1),auxvec(1))
3741 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3742 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3743 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3744 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3745 a_temp(1,1)=aggj(l,1)
3746 a_temp(1,2)=aggj(l,2)
3747 a_temp(2,1)=aggj(l,3)
3748 a_temp(2,2)=aggj(l,4)
3749 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3750 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3751 s1=scalar2(b1(1,iti2),auxvec(1))
3752 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3753 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3754 s2=scalar2(b1(1,iti1),auxvec(1))
3755 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3756 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3757 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3758 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3759 a_temp(1,1)=aggj1(l,1)
3760 a_temp(1,2)=aggj1(l,2)
3761 a_temp(2,1)=aggj1(l,3)
3762 a_temp(2,2)=aggj1(l,4)
3763 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3764 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3765 s1=scalar2(b1(1,iti2),auxvec(1))
3766 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3767 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3768 s2=scalar2(b1(1,iti1),auxvec(1))
3769 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3770 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3771 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3772 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3773 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3777 C-----------------------------------------------------------------------------
3778 subroutine vecpr(u,v,w)
3779 implicit real*8(a-h,o-z)
3780 dimension u(3),v(3),w(3)
3781 w(1)=u(2)*v(3)-u(3)*v(2)
3782 w(2)=-u(1)*v(3)+u(3)*v(1)
3783 w(3)=u(1)*v(2)-u(2)*v(1)
3786 C-----------------------------------------------------------------------------
3787 subroutine unormderiv(u,ugrad,unorm,ungrad)
3788 C This subroutine computes the derivatives of a normalized vector u, given
3789 C the derivatives computed without normalization conditions, ugrad. Returns
3792 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3793 double precision vec(3)
3794 double precision scalar
3796 c write (2,*) 'ugrad',ugrad
3799 vec(i)=scalar(ugrad(1,i),u(1))
3801 c write (2,*) 'vec',vec
3804 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3807 c write (2,*) 'ungrad',ungrad
3810 C-----------------------------------------------------------------------------
3811 subroutine escp_soft_sphere(evdw2,evdw2_14)
3813 C This subroutine calculates the excluded-volume interaction energy between
3814 C peptide-group centers and side chains and its gradient in virtual-bond and
3815 C side-chain vectors.
3817 implicit real*8 (a-h,o-z)
3818 include 'DIMENSIONS'
3819 include 'COMMON.GEO'
3820 include 'COMMON.VAR'
3821 include 'COMMON.LOCAL'
3822 include 'COMMON.CHAIN'
3823 include 'COMMON.DERIV'
3824 include 'COMMON.INTERACT'
3825 include 'COMMON.FFIELD'
3826 include 'COMMON.IOUNITS'
3827 include 'COMMON.CONTROL'
3832 cd print '(a)','Enter ESCP'
3833 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3834 do i=iatscp_s,iatscp_e
3835 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3837 xi=0.5D0*(c(1,i)+c(1,i+1))
3838 yi=0.5D0*(c(2,i)+c(2,i+1))
3839 zi=0.5D0*(c(3,i)+c(3,i+1))
3841 do iint=1,nscp_gr(i)
3843 do j=iscpstart(i,iint),iscpend(i,iint)
3844 if (itype(j).eq.ntyp1) cycle
3845 itypj=iabs(itype(j))
3846 C Uncomment following three lines for SC-p interactions
3850 C Uncomment following three lines for Ca-p interactions
3854 rij=xj*xj+yj*yj+zj*zj
3857 if (rij.lt.r0ijsq) then
3858 evdwij=0.25d0*(rij-r0ijsq)**2
3866 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3871 cgrad if (j.lt.i) then
3872 cd write (iout,*) 'j<i'
3873 C Uncomment following three lines for SC-p interactions
3875 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3878 cd write (iout,*) 'j>i'
3880 cgrad ggg(k)=-ggg(k)
3881 C Uncomment following line for SC-p interactions
3882 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3886 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3888 cgrad kstart=min0(i+1,j)
3889 cgrad kend=max0(i-1,j-1)
3890 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3891 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3892 cgrad do k=kstart,kend
3894 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3898 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3899 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3907 C-----------------------------------------------------------------------------
3908 subroutine escp(evdw2,evdw2_14)
3910 C This subroutine calculates the excluded-volume interaction energy between
3911 C peptide-group centers and side chains and its gradient in virtual-bond and
3912 C side-chain vectors.
3914 implicit real*8 (a-h,o-z)
3915 include 'DIMENSIONS'
3916 include 'COMMON.GEO'
3917 include 'COMMON.VAR'
3918 include 'COMMON.LOCAL'
3919 include 'COMMON.CHAIN'
3920 include 'COMMON.DERIV'
3921 include 'COMMON.INTERACT'
3922 include 'COMMON.FFIELD'
3923 include 'COMMON.IOUNITS'
3924 include 'COMMON.CONTROL'
3928 cd print '(a)','Enter ESCP'
3929 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3930 do i=iatscp_s,iatscp_e
3931 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3933 xi=0.5D0*(c(1,i)+c(1,i+1))
3934 yi=0.5D0*(c(2,i)+c(2,i+1))
3935 zi=0.5D0*(c(3,i)+c(3,i+1))
3937 do iint=1,nscp_gr(i)
3939 do j=iscpstart(i,iint),iscpend(i,iint)
3940 itypj=iabs(itype(j))
3941 if (itypj.eq.ntyp1) cycle
3942 C Uncomment following three lines for SC-p interactions
3946 C Uncomment following three lines for Ca-p interactions
3950 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3952 e1=fac*fac*aad(itypj,iteli)
3953 e2=fac*bad(itypj,iteli)
3954 if (iabs(j-i) .le. 2) then
3957 evdw2_14=evdw2_14+e1+e2
3961 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3962 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3965 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3967 fac=-(evdwij+e1)*rrij
3971 cgrad if (j.lt.i) then
3972 cd write (iout,*) 'j<i'
3973 C Uncomment following three lines for SC-p interactions
3975 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3978 cd write (iout,*) 'j>i'
3980 cgrad ggg(k)=-ggg(k)
3981 C Uncomment following line for SC-p interactions
3982 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3983 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3987 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3989 cgrad kstart=min0(i+1,j)
3990 cgrad kend=max0(i-1,j-1)
3991 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3992 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3993 cgrad do k=kstart,kend
3995 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3999 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4000 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4008 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4009 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4010 gradx_scp(j,i)=expon*gradx_scp(j,i)
4013 C******************************************************************************
4017 C To save time the factor EXPON has been extracted from ALL components
4018 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4021 C******************************************************************************
4024 C--------------------------------------------------------------------------
4025 subroutine edis(ehpb)
4027 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4029 implicit real*8 (a-h,o-z)
4030 include 'DIMENSIONS'
4031 include 'COMMON.SBRIDGE'
4032 include 'COMMON.CHAIN'
4033 include 'COMMON.DERIV'
4034 include 'COMMON.VAR'
4035 include 'COMMON.INTERACT'
4036 include 'COMMON.IOUNITS'
4039 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4040 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4041 if (link_end.eq.0) return
4042 do i=link_start,link_end
4043 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4044 C CA-CA distance used in regularization of structure.
4047 C iii and jjj point to the residues for which the distance is assigned.
4048 if (ii.gt.nres) then
4055 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4056 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4057 C distance and angle dependent SS bond potential.
4058 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4059 & iabs(itype(jjj)).eq.1) then
4060 call ssbond_ene(iii,jjj,eij)
4062 cd write (iout,*) "eij",eij
4064 C Calculate the distance between the two points and its difference from the
4068 C Get the force constant corresponding to this distance.
4070 C Calculate the contribution to energy.
4071 ehpb=ehpb+waga*rdis*rdis
4073 C Evaluate gradient.
4076 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4077 cd & ' waga=',waga,' fac=',fac
4079 ggg(j)=fac*(c(j,jj)-c(j,ii))
4081 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4082 C If this is a SC-SC distance, we need to calculate the contributions to the
4083 C Cartesian gradient in the SC vectors (ghpbx).
4086 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4087 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4090 cgrad do j=iii,jjj-1
4092 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4096 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4097 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4104 C--------------------------------------------------------------------------
4105 subroutine ssbond_ene(i,j,eij)
4107 C Calculate the distance and angle dependent SS-bond potential energy
4108 C using a free-energy function derived based on RHF/6-31G** ab initio
4109 C calculations of diethyl disulfide.
4111 C A. Liwo and U. Kozlowska, 11/24/03
4113 implicit real*8 (a-h,o-z)
4114 include 'DIMENSIONS'
4115 include 'COMMON.SBRIDGE'
4116 include 'COMMON.CHAIN'
4117 include 'COMMON.DERIV'
4118 include 'COMMON.LOCAL'
4119 include 'COMMON.INTERACT'
4120 include 'COMMON.VAR'
4121 include 'COMMON.IOUNITS'
4122 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4123 itypi=iabs(itype(i))
4127 dxi=dc_norm(1,nres+i)
4128 dyi=dc_norm(2,nres+i)
4129 dzi=dc_norm(3,nres+i)
4130 c dsci_inv=dsc_inv(itypi)
4131 dsci_inv=vbld_inv(nres+i)
4132 itypj=iabs(itype(j))
4133 c dscj_inv=dsc_inv(itypj)
4134 dscj_inv=vbld_inv(nres+j)
4138 dxj=dc_norm(1,nres+j)
4139 dyj=dc_norm(2,nres+j)
4140 dzj=dc_norm(3,nres+j)
4141 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4146 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4147 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4148 om12=dxi*dxj+dyi*dyj+dzi*dzj
4150 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4151 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4157 deltat12=om2-om1+2.0d0
4159 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4160 & +akct*deltad*deltat12
4161 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4162 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4163 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4164 c & " deltat12",deltat12," eij",eij
4165 ed=2*akcm*deltad+akct*deltat12
4167 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4168 eom1=-2*akth*deltat1-pom1-om2*pom2
4169 eom2= 2*akth*deltat2+pom1-om1*pom2
4172 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4173 ghpbx(k,i)=ghpbx(k,i)-ggk
4174 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4175 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4176 ghpbx(k,j)=ghpbx(k,j)+ggk
4177 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4178 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4179 ghpbc(k,i)=ghpbc(k,i)-ggk
4180 ghpbc(k,j)=ghpbc(k,j)+ggk
4183 C Calculate the components of the gradient in DC and X
4187 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4192 C--------------------------------------------------------------------------
4193 subroutine ebond(estr)
4195 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4197 implicit real*8 (a-h,o-z)
4198 include 'DIMENSIONS'
4199 include 'COMMON.LOCAL'
4200 include 'COMMON.GEO'
4201 include 'COMMON.INTERACT'
4202 include 'COMMON.DERIV'
4203 include 'COMMON.VAR'
4204 include 'COMMON.CHAIN'
4205 include 'COMMON.IOUNITS'
4206 include 'COMMON.NAMES'
4207 include 'COMMON.FFIELD'
4208 include 'COMMON.CONTROL'
4209 include 'COMMON.SETUP'
4210 double precision u(3),ud(3)
4213 do i=ibondp_start,ibondp_end
4214 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4215 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4217 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4218 & *dc(j,i-1)/vbld(i)
4220 if (energy_dec) write(iout,*)
4221 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4223 diff = vbld(i)-vbldp0
4224 if (energy_dec) write (iout,*)
4225 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4228 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4230 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4233 estr=0.5d0*AKP*estr+estr1
4235 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4237 do i=ibond_start,ibond_end
4239 if (iti.ne.10 .and. iti.ne.ntyp1) then
4242 diff=vbld(i+nres)-vbldsc0(1,iti)
4243 if (energy_dec) write (iout,*)
4244 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4245 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4246 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4248 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4252 diff=vbld(i+nres)-vbldsc0(j,iti)
4253 ud(j)=aksc(j,iti)*diff
4254 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4268 uprod2=uprod2*u(k)*u(k)
4272 usumsqder=usumsqder+ud(j)*uprod2
4274 estr=estr+uprod/usum
4276 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4284 C--------------------------------------------------------------------------
4285 subroutine ebend(etheta)
4287 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4288 C angles gamma and its derivatives in consecutive thetas and gammas.
4290 implicit real*8 (a-h,o-z)
4291 include 'DIMENSIONS'
4292 include 'COMMON.LOCAL'
4293 include 'COMMON.GEO'
4294 include 'COMMON.INTERACT'
4295 include 'COMMON.DERIV'
4296 include 'COMMON.VAR'
4297 include 'COMMON.CHAIN'
4298 include 'COMMON.IOUNITS'
4299 include 'COMMON.NAMES'
4300 include 'COMMON.FFIELD'
4301 include 'COMMON.CONTROL'
4302 common /calcthet/ term1,term2,termm,diffak,ratak,
4303 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4304 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4305 double precision y(2),z(2)
4307 c time11=dexp(-2*time)
4310 c write (*,'(a,i2)') 'EBEND ICG=',icg
4311 do i=ithet_start,ithet_end
4312 if (itype(i-1).eq.ntyp1) cycle
4313 C Zero the energy function and its derivative at 0 or pi.
4314 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4316 ichir1=isign(1,itype(i-2))
4317 ichir2=isign(1,itype(i))
4318 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4319 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4320 if (itype(i-1).eq.10) then
4321 itype1=isign(10,itype(i-2))
4322 ichir11=isign(1,itype(i-2))
4323 ichir12=isign(1,itype(i-2))
4324 itype2=isign(10,itype(i))
4325 ichir21=isign(1,itype(i))
4326 ichir22=isign(1,itype(i))
4329 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4332 if (phii.ne.phii) phii=150.0
4342 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4345 if (phii1.ne.phii1) phii1=150.0
4357 C Calculate the "mean" value of theta from the part of the distribution
4358 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4359 C In following comments this theta will be referred to as t_c.
4360 thet_pred_mean=0.0d0
4362 athetk=athet(k,it,ichir1,ichir2)
4363 bthetk=bthet(k,it,ichir1,ichir2)
4365 athetk=athet(k,itype1,ichir11,ichir12)
4366 bthetk=bthet(k,itype2,ichir21,ichir22)
4368 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4370 dthett=thet_pred_mean*ssd
4371 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4372 C Derivatives of the "mean" values in gamma1 and gamma2.
4373 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4374 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4375 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4376 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4378 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4379 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4380 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4381 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4383 if (theta(i).gt.pi-delta) then
4384 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4386 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4387 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4388 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4390 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4392 else if (theta(i).lt.delta) then
4393 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4394 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4395 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4397 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4398 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4401 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4404 etheta=etheta+ethetai
4405 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4407 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4408 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4409 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4411 C Ufff.... We've done all this!!!
4414 C---------------------------------------------------------------------------
4415 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4417 implicit real*8 (a-h,o-z)
4418 include 'DIMENSIONS'
4419 include 'COMMON.LOCAL'
4420 include 'COMMON.IOUNITS'
4421 common /calcthet/ term1,term2,termm,diffak,ratak,
4422 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4423 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4424 C Calculate the contributions to both Gaussian lobes.
4425 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4426 C The "polynomial part" of the "standard deviation" of this part of
4430 sig=sig*thet_pred_mean+polthet(j,it)
4432 C Derivative of the "interior part" of the "standard deviation of the"
4433 C gamma-dependent Gaussian lobe in t_c.
4434 sigtc=3*polthet(3,it)
4436 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4439 C Set the parameters of both Gaussian lobes of the distribution.
4440 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4441 fac=sig*sig+sigc0(it)
4444 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4445 sigsqtc=-4.0D0*sigcsq*sigtc
4446 c print *,i,sig,sigtc,sigsqtc
4447 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4448 sigtc=-sigtc/(fac*fac)
4449 C Following variable is sigma(t_c)**(-2)
4450 sigcsq=sigcsq*sigcsq
4452 sig0inv=1.0D0/sig0i**2
4453 delthec=thetai-thet_pred_mean
4454 delthe0=thetai-theta0i
4455 term1=-0.5D0*sigcsq*delthec*delthec
4456 term2=-0.5D0*sig0inv*delthe0*delthe0
4457 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4458 C NaNs in taking the logarithm. We extract the largest exponent which is added
4459 C to the energy (this being the log of the distribution) at the end of energy
4460 C term evaluation for this virtual-bond angle.
4461 if (term1.gt.term2) then
4463 term2=dexp(term2-termm)
4467 term1=dexp(term1-termm)
4470 C The ratio between the gamma-independent and gamma-dependent lobes of
4471 C the distribution is a Gaussian function of thet_pred_mean too.
4472 diffak=gthet(2,it)-thet_pred_mean
4473 ratak=diffak/gthet(3,it)**2
4474 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4475 C Let's differentiate it in thet_pred_mean NOW.
4477 C Now put together the distribution terms to make complete distribution.
4478 termexp=term1+ak*term2
4479 termpre=sigc+ak*sig0i
4480 C Contribution of the bending energy from this theta is just the -log of
4481 C the sum of the contributions from the two lobes and the pre-exponential
4482 C factor. Simple enough, isn't it?
4483 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4484 C NOW the derivatives!!!
4485 C 6/6/97 Take into account the deformation.
4486 E_theta=(delthec*sigcsq*term1
4487 & +ak*delthe0*sig0inv*term2)/termexp
4488 E_tc=((sigtc+aktc*sig0i)/termpre
4489 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4490 & aktc*term2)/termexp)
4493 c-----------------------------------------------------------------------------
4494 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4495 implicit real*8 (a-h,o-z)
4496 include 'DIMENSIONS'
4497 include 'COMMON.LOCAL'
4498 include 'COMMON.IOUNITS'
4499 common /calcthet/ term1,term2,termm,diffak,ratak,
4500 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4501 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4502 delthec=thetai-thet_pred_mean
4503 delthe0=thetai-theta0i
4504 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4505 t3 = thetai-thet_pred_mean
4509 t14 = t12+t6*sigsqtc
4511 t21 = thetai-theta0i
4517 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4518 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4519 & *(-t12*t9-ak*sig0inv*t27)
4523 C--------------------------------------------------------------------------
4524 subroutine ebend(etheta)
4526 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4527 C angles gamma and its derivatives in consecutive thetas and gammas.
4528 C ab initio-derived potentials from
4529 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4531 implicit real*8 (a-h,o-z)
4532 include 'DIMENSIONS'
4533 include 'COMMON.LOCAL'
4534 include 'COMMON.GEO'
4535 include 'COMMON.INTERACT'
4536 include 'COMMON.DERIV'
4537 include 'COMMON.VAR'
4538 include 'COMMON.CHAIN'
4539 include 'COMMON.IOUNITS'
4540 include 'COMMON.NAMES'
4541 include 'COMMON.FFIELD'
4542 include 'COMMON.CONTROL'
4543 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4544 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4545 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4546 & sinph1ph2(maxdouble,maxdouble)
4547 logical lprn /.false./, lprn1 /.false./
4549 do i=ithet_start,ithet_end
4550 if (itype(i-1).eq.ntyp1) cycle
4551 if (iabs(itype(i+1)).eq.20) iblock=2
4552 if (iabs(itype(i+1)).ne.20) iblock=1
4556 theti2=0.5d0*theta(i)
4557 ityp2=ithetyp((itype(i-1)))
4559 coskt(k)=dcos(k*theti2)
4560 sinkt(k)=dsin(k*theti2)
4562 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4565 if (phii.ne.phii) phii=150.0
4569 ityp1=ithetyp((itype(i-2)))
4570 C propagation of chirality for glycine type
4572 cosph1(k)=dcos(k*phii)
4573 sinph1(k)=dsin(k*phii)
4583 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4586 if (phii1.ne.phii1) phii1=150.0
4591 ityp3=ithetyp((itype(i)))
4593 cosph2(k)=dcos(k*phii1)
4594 sinph2(k)=dsin(k*phii1)
4604 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4607 ccl=cosph1(l)*cosph2(k-l)
4608 ssl=sinph1(l)*sinph2(k-l)
4609 scl=sinph1(l)*cosph2(k-l)
4610 csl=cosph1(l)*sinph2(k-l)
4611 cosph1ph2(l,k)=ccl-ssl
4612 cosph1ph2(k,l)=ccl+ssl
4613 sinph1ph2(l,k)=scl+csl
4614 sinph1ph2(k,l)=scl-csl
4618 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4619 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4620 write (iout,*) "coskt and sinkt"
4622 write (iout,*) k,coskt(k),sinkt(k)
4626 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4627 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4630 & write (iout,*) "k",k,"
4631 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4632 & " ethetai",ethetai
4635 write (iout,*) "cosph and sinph"
4637 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4639 write (iout,*) "cosph1ph2 and sinph2ph2"
4642 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4643 & sinph1ph2(l,k),sinph1ph2(k,l)
4646 write(iout,*) "ethetai",ethetai
4650 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4651 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4652 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4653 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4654 ethetai=ethetai+sinkt(m)*aux
4655 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4656 dephii=dephii+k*sinkt(m)*(
4657 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4658 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4659 dephii1=dephii1+k*sinkt(m)*(
4660 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4661 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4663 & write (iout,*) "m",m," k",k," bbthet",
4664 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4665 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4666 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4667 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4671 & write(iout,*) "ethetai",ethetai
4675 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4676 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4677 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4678 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4679 ethetai=ethetai+sinkt(m)*aux
4680 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4681 dephii=dephii+l*sinkt(m)*(
4682 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4683 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4684 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4685 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4686 dephii1=dephii1+(k-l)*sinkt(m)*(
4687 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4688 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4689 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4690 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4692 write (iout,*) "m",m," k",k," l",l," ffthet",
4693 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4694 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4695 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4696 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4697 & " ethetai",ethetai
4698 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4699 & cosph1ph2(k,l)*sinkt(m),
4700 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4708 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4709 & i,theta(i)*rad2deg,phii*rad2deg,
4710 & phii1*rad2deg,ethetai
4712 etheta=etheta+ethetai
4713 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4714 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4715 gloc(nphi+i-2,icg)=wang*dethetai
4721 c-----------------------------------------------------------------------------
4722 subroutine esc(escloc)
4723 C Calculate the local energy of a side chain and its derivatives in the
4724 C corresponding virtual-bond valence angles THETA and the spherical angles
4726 implicit real*8 (a-h,o-z)
4727 include 'DIMENSIONS'
4728 include 'COMMON.GEO'
4729 include 'COMMON.LOCAL'
4730 include 'COMMON.VAR'
4731 include 'COMMON.INTERACT'
4732 include 'COMMON.DERIV'
4733 include 'COMMON.CHAIN'
4734 include 'COMMON.IOUNITS'
4735 include 'COMMON.NAMES'
4736 include 'COMMON.FFIELD'
4737 include 'COMMON.CONTROL'
4738 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4739 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4740 common /sccalc/ time11,time12,time112,theti,it,nlobit
4743 c write (iout,'(a)') 'ESC'
4744 do i=loc_start,loc_end
4746 if (it.eq.ntyp1) cycle
4747 if (it.eq.10) goto 1
4748 nlobit=nlob(iabs(it))
4749 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4750 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4751 theti=theta(i+1)-pipol
4756 if (x(2).gt.pi-delta) then
4760 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4762 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4763 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4765 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4766 & ddersc0(1),dersc(1))
4767 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4768 & ddersc0(3),dersc(3))
4770 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4772 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4773 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4774 & dersc0(2),esclocbi,dersc02)
4775 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4777 call splinthet(x(2),0.5d0*delta,ss,ssd)
4782 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4784 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4785 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4787 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4789 c write (iout,*) escloci
4790 else if (x(2).lt.delta) then
4794 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4796 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4797 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4799 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4800 & ddersc0(1),dersc(1))
4801 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4802 & ddersc0(3),dersc(3))
4804 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4806 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4807 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4808 & dersc0(2),esclocbi,dersc02)
4809 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4814 call splinthet(x(2),0.5d0*delta,ss,ssd)
4816 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4818 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4819 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4821 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4822 c write (iout,*) escloci
4824 call enesc(x,escloci,dersc,ddummy,.false.)
4827 escloc=escloc+escloci
4828 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4829 & 'escloc',i,escloci
4830 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4832 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4834 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4835 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4840 C---------------------------------------------------------------------------
4841 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4842 implicit real*8 (a-h,o-z)
4843 include 'DIMENSIONS'
4844 include 'COMMON.GEO'
4845 include 'COMMON.LOCAL'
4846 include 'COMMON.IOUNITS'
4847 common /sccalc/ time11,time12,time112,theti,it,nlobit
4848 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4849 double precision contr(maxlob,-1:1)
4851 c write (iout,*) 'it=',it,' nlobit=',nlobit
4855 if (mixed) ddersc(j)=0.0d0
4859 C Because of periodicity of the dependence of the SC energy in omega we have
4860 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4861 C To avoid underflows, first compute & store the exponents.
4869 z(k)=x(k)-censc(k,j,it)
4874 Axk=Axk+gaussc(l,k,j,it)*z(l)
4880 expfac=expfac+Ax(k,j,iii)*z(k)
4888 C As in the case of ebend, we want to avoid underflows in exponentiation and
4889 C subsequent NaNs and INFs in energy calculation.
4890 C Find the largest exponent
4894 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4898 cd print *,'it=',it,' emin=',emin
4900 C Compute the contribution to SC energy and derivatives
4905 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4906 if(adexp.ne.adexp) adexp=1.0
4909 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4911 cd print *,'j=',j,' expfac=',expfac
4912 escloc_i=escloc_i+expfac
4914 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4918 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4919 & +gaussc(k,2,j,it))*expfac
4926 dersc(1)=dersc(1)/cos(theti)**2
4927 ddersc(1)=ddersc(1)/cos(theti)**2
4930 escloci=-(dlog(escloc_i)-emin)
4932 dersc(j)=dersc(j)/escloc_i
4936 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4941 C------------------------------------------------------------------------------
4942 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4943 implicit real*8 (a-h,o-z)
4944 include 'DIMENSIONS'
4945 include 'COMMON.GEO'
4946 include 'COMMON.LOCAL'
4947 include 'COMMON.IOUNITS'
4948 common /sccalc/ time11,time12,time112,theti,it,nlobit
4949 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4950 double precision contr(maxlob)
4961 z(k)=x(k)-censc(k,j,it)
4967 Axk=Axk+gaussc(l,k,j,it)*z(l)
4973 expfac=expfac+Ax(k,j)*z(k)
4978 C As in the case of ebend, we want to avoid underflows in exponentiation and
4979 C subsequent NaNs and INFs in energy calculation.
4980 C Find the largest exponent
4983 if (emin.gt.contr(j)) emin=contr(j)
4987 C Compute the contribution to SC energy and derivatives
4991 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4992 escloc_i=escloc_i+expfac
4994 dersc(k)=dersc(k)+Ax(k,j)*expfac
4996 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4997 & +gaussc(1,2,j,it))*expfac
5001 dersc(1)=dersc(1)/cos(theti)**2
5002 dersc12=dersc12/cos(theti)**2
5003 escloci=-(dlog(escloc_i)-emin)
5005 dersc(j)=dersc(j)/escloc_i
5007 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5011 c----------------------------------------------------------------------------------
5012 subroutine esc(escloc)
5013 C Calculate the local energy of a side chain and its derivatives in the
5014 C corresponding virtual-bond valence angles THETA and the spherical angles
5015 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5016 C added by Urszula Kozlowska. 07/11/2007
5018 implicit real*8 (a-h,o-z)
5019 include 'DIMENSIONS'
5020 include 'COMMON.GEO'
5021 include 'COMMON.LOCAL'
5022 include 'COMMON.VAR'
5023 include 'COMMON.SCROT'
5024 include 'COMMON.INTERACT'
5025 include 'COMMON.DERIV'
5026 include 'COMMON.CHAIN'
5027 include 'COMMON.IOUNITS'
5028 include 'COMMON.NAMES'
5029 include 'COMMON.FFIELD'
5030 include 'COMMON.CONTROL'
5031 include 'COMMON.VECTORS'
5032 double precision x_prime(3),y_prime(3),z_prime(3)
5033 & , sumene,dsc_i,dp2_i,x(65),
5034 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5035 & de_dxx,de_dyy,de_dzz,de_dt
5036 double precision s1_t,s1_6_t,s2_t,s2_6_t
5038 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5039 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5040 & dt_dCi(3),dt_dCi1(3)
5041 common /sccalc/ time11,time12,time112,theti,it,nlobit
5044 do i=loc_start,loc_end
5045 if (itype(i).eq.ntyp1) cycle
5046 costtab(i+1) =dcos(theta(i+1))
5047 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5048 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5049 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5050 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5051 cosfac=dsqrt(cosfac2)
5052 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5053 sinfac=dsqrt(sinfac2)
5055 if (it.eq.10) goto 1
5057 C Compute the axes of tghe local cartesian coordinates system; store in
5058 c x_prime, y_prime and z_prime
5065 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5066 C & dc_norm(3,i+nres)
5068 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5069 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5072 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5075 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5076 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5077 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5078 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5079 c & " xy",scalar(x_prime(1),y_prime(1)),
5080 c & " xz",scalar(x_prime(1),z_prime(1)),
5081 c & " yy",scalar(y_prime(1),y_prime(1)),
5082 c & " yz",scalar(y_prime(1),z_prime(1)),
5083 c & " zz",scalar(z_prime(1),z_prime(1))
5085 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5086 C to local coordinate system. Store in xx, yy, zz.
5092 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5093 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5094 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5101 C Compute the energy of the ith side cbain
5103 c write (2,*) "xx",xx," yy",yy," zz",zz
5106 x(j) = sc_parmin(j,it)
5109 Cc diagnostics - remove later
5111 yy1 = dsin(alph(2))*dcos(omeg(2))
5112 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5113 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5114 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5116 C," --- ", xx_w,yy_w,zz_w
5119 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5120 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5122 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5123 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5125 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5126 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5127 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5128 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5129 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5131 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5132 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5133 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5134 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5135 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5137 dsc_i = 0.743d0+x(61)
5139 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5140 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5141 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5142 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5143 s1=(1+x(63))/(0.1d0 + dscp1)
5144 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5145 s2=(1+x(65))/(0.1d0 + dscp2)
5146 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5147 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5148 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5149 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5151 c & dscp1,dscp2,sumene
5152 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5153 escloc = escloc + sumene
5154 c write (2,*) "i",i," escloc",sumene,escloc
5158 C This section to check the numerical derivatives of the energy of ith side
5159 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5160 C #define DEBUG in the code to turn it on.
5162 write (2,*) "sumene =",sumene
5166 write (2,*) xx,yy,zz
5167 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5168 de_dxx_num=(sumenep-sumene)/aincr
5170 write (2,*) "xx+ sumene from enesc=",sumenep
5173 write (2,*) xx,yy,zz
5174 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5175 de_dyy_num=(sumenep-sumene)/aincr
5177 write (2,*) "yy+ sumene from enesc=",sumenep
5180 write (2,*) xx,yy,zz
5181 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5182 de_dzz_num=(sumenep-sumene)/aincr
5184 write (2,*) "zz+ sumene from enesc=",sumenep
5185 costsave=cost2tab(i+1)
5186 sintsave=sint2tab(i+1)
5187 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5188 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5189 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5190 de_dt_num=(sumenep-sumene)/aincr
5191 write (2,*) " t+ sumene from enesc=",sumenep
5192 cost2tab(i+1)=costsave
5193 sint2tab(i+1)=sintsave
5194 C End of diagnostics section.
5197 C Compute the gradient of esc
5199 c zz=zz*dsign(1.0,dfloat(itype(i)))
5200 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5201 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5202 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5203 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5204 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5205 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5206 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5207 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5208 pom1=(sumene3*sint2tab(i+1)+sumene1)
5209 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5210 pom2=(sumene4*cost2tab(i+1)+sumene2)
5211 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5212 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5213 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5214 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5216 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5217 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5218 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5220 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5221 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5222 & +(pom1+pom2)*pom_dx
5224 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5227 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5228 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5229 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5231 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5232 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5233 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5234 & +x(59)*zz**2 +x(60)*xx*zz
5235 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5236 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5237 & +(pom1-pom2)*pom_dy
5239 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5242 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5243 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5244 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5245 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5246 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5247 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5248 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5249 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5251 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5254 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5255 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5256 & +pom1*pom_dt1+pom2*pom_dt2
5258 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5263 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5264 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5265 cosfac2xx=cosfac2*xx
5266 sinfac2yy=sinfac2*yy
5268 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5270 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5272 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5273 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5274 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5275 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5276 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5277 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5278 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5279 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5280 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5281 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5285 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5286 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5287 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5288 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5291 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5292 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5293 dZZ_XYZ(k)=vbld_inv(i+nres)*
5294 & (z_prime(k)-zz*dC_norm(k,i+nres))
5296 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5297 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5301 dXX_Ctab(k,i)=dXX_Ci(k)
5302 dXX_C1tab(k,i)=dXX_Ci1(k)
5303 dYY_Ctab(k,i)=dYY_Ci(k)
5304 dYY_C1tab(k,i)=dYY_Ci1(k)
5305 dZZ_Ctab(k,i)=dZZ_Ci(k)
5306 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5307 dXX_XYZtab(k,i)=dXX_XYZ(k)
5308 dYY_XYZtab(k,i)=dYY_XYZ(k)
5309 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5313 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5314 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5315 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5316 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5317 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5319 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5320 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5321 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5322 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5323 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5324 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5325 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5326 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5328 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5329 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5331 C to check gradient call subroutine check_grad
5337 c------------------------------------------------------------------------------
5338 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5340 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5341 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5342 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5343 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5345 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5346 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5348 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5349 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5350 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5351 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5352 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5354 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5355 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5356 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5357 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5358 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5360 dsc_i = 0.743d0+x(61)
5362 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5363 & *(xx*cost2+yy*sint2))
5364 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5365 & *(xx*cost2-yy*sint2))
5366 s1=(1+x(63))/(0.1d0 + dscp1)
5367 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5368 s2=(1+x(65))/(0.1d0 + dscp2)
5369 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5370 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5371 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5376 c------------------------------------------------------------------------------
5377 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5379 C This procedure calculates two-body contact function g(rij) and its derivative:
5382 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5385 C where x=(rij-r0ij)/delta
5387 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5390 double precision rij,r0ij,eps0ij,fcont,fprimcont
5391 double precision x,x2,x4,delta
5395 if (x.lt.-1.0D0) then
5398 else if (x.le.1.0D0) then
5401 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5402 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5409 c------------------------------------------------------------------------------
5410 subroutine splinthet(theti,delta,ss,ssder)
5411 implicit real*8 (a-h,o-z)
5412 include 'DIMENSIONS'
5413 include 'COMMON.VAR'
5414 include 'COMMON.GEO'
5417 if (theti.gt.pipol) then
5418 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5420 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5425 c------------------------------------------------------------------------------
5426 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5428 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5429 double precision ksi,ksi2,ksi3,a1,a2,a3
5430 a1=fprim0*delta/(f1-f0)
5436 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5437 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5440 c------------------------------------------------------------------------------
5441 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5443 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5444 double precision ksi,ksi2,ksi3,a1,a2,a3
5449 a2=3*(f1x-f0x)-2*fprim0x*delta
5450 a3=fprim0x*delta-2*(f1x-f0x)
5451 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5454 C-----------------------------------------------------------------------------
5456 C-----------------------------------------------------------------------------
5457 subroutine etor(etors,edihcnstr)
5458 implicit real*8 (a-h,o-z)
5459 include 'DIMENSIONS'
5460 include 'COMMON.VAR'
5461 include 'COMMON.GEO'
5462 include 'COMMON.LOCAL'
5463 include 'COMMON.TORSION'
5464 include 'COMMON.INTERACT'
5465 include 'COMMON.DERIV'
5466 include 'COMMON.CHAIN'
5467 include 'COMMON.NAMES'
5468 include 'COMMON.IOUNITS'
5469 include 'COMMON.FFIELD'
5470 include 'COMMON.TORCNSTR'
5471 include 'COMMON.CONTROL'
5473 C Set lprn=.true. for debugging
5477 do i=iphi_start,iphi_end
5479 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5480 & .or. itype(i).eq.ntyp1) cycle
5481 itori=itortyp(itype(i-2))
5482 itori1=itortyp(itype(i-1))
5485 C Proline-Proline pair is a special case...
5486 if (itori.eq.3 .and. itori1.eq.3) then
5487 if (phii.gt.-dwapi3) then
5489 fac=1.0D0/(1.0D0-cosphi)
5490 etorsi=v1(1,3,3)*fac
5491 etorsi=etorsi+etorsi
5492 etors=etors+etorsi-v1(1,3,3)
5493 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5494 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5497 v1ij=v1(j+1,itori,itori1)
5498 v2ij=v2(j+1,itori,itori1)
5501 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5502 if (energy_dec) etors_ii=etors_ii+
5503 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5504 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5508 v1ij=v1(j,itori,itori1)
5509 v2ij=v2(j,itori,itori1)
5512 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5513 if (energy_dec) etors_ii=etors_ii+
5514 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5515 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5518 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5521 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5522 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5523 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5524 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5525 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5527 ! 6/20/98 - dihedral angle constraints
5530 itori=idih_constr(i)
5533 if (difi.gt.drange(i)) then
5535 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5536 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5537 else if (difi.lt.-drange(i)) then
5539 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5540 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5542 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5543 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5545 ! write (iout,*) 'edihcnstr',edihcnstr
5548 c------------------------------------------------------------------------------
5549 subroutine etor_d(etors_d)
5553 c----------------------------------------------------------------------------
5555 subroutine etor(etors,edihcnstr)
5556 implicit real*8 (a-h,o-z)
5557 include 'DIMENSIONS'
5558 include 'COMMON.VAR'
5559 include 'COMMON.GEO'
5560 include 'COMMON.LOCAL'
5561 include 'COMMON.TORSION'
5562 include 'COMMON.INTERACT'
5563 include 'COMMON.DERIV'
5564 include 'COMMON.CHAIN'
5565 include 'COMMON.NAMES'
5566 include 'COMMON.IOUNITS'
5567 include 'COMMON.FFIELD'
5568 include 'COMMON.TORCNSTR'
5569 include 'COMMON.CONTROL'
5571 C Set lprn=.true. for debugging
5575 do i=iphi_start,iphi_end
5576 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5577 & .or. itype(i).eq.ntyp1) cycle
5579 if (iabs(itype(i)).eq.20) then
5584 itori=itortyp(itype(i-2))
5585 itori1=itortyp(itype(i-1))
5588 C Regular cosine and sine terms
5589 do j=1,nterm(itori,itori1,iblock)
5590 v1ij=v1(j,itori,itori1,iblock)
5591 v2ij=v2(j,itori,itori1,iblock)
5594 etors=etors+v1ij*cosphi+v2ij*sinphi
5595 if (energy_dec) etors_ii=etors_ii+
5596 & v1ij*cosphi+v2ij*sinphi
5597 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5601 C E = SUM ----------------------------------- - v1
5602 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5604 cosphi=dcos(0.5d0*phii)
5605 sinphi=dsin(0.5d0*phii)
5606 do j=1,nlor(itori,itori1,iblock)
5607 vl1ij=vlor1(j,itori,itori1)
5608 vl2ij=vlor2(j,itori,itori1)
5609 vl3ij=vlor3(j,itori,itori1)
5610 pom=vl2ij*cosphi+vl3ij*sinphi
5611 pom1=1.0d0/(pom*pom+1.0d0)
5612 etors=etors+vl1ij*pom1
5613 if (energy_dec) etors_ii=etors_ii+
5616 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5618 C Subtract the constant term
5619 etors=etors-v0(itori,itori1,iblock)
5620 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5621 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5623 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5624 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5625 & (v1(j,itori,itori1,iblock),j=1,6),
5626 & (v2(j,itori,itori1,iblock),j=1,6)
5627 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5628 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5630 ! 6/20/98 - dihedral angle constraints
5632 c do i=1,ndih_constr
5633 do i=idihconstr_start,idihconstr_end
5634 itori=idih_constr(i)
5636 difi=pinorm(phii-phi0(i))
5637 if (difi.gt.drange(i)) then
5639 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5640 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5641 else if (difi.lt.-drange(i)) then
5643 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5644 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5648 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5649 cd & rad2deg*phi0(i), rad2deg*drange(i),
5650 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5652 cd write (iout,*) 'edihcnstr',edihcnstr
5655 c----------------------------------------------------------------------------
5656 subroutine etor_d(etors_d)
5657 C 6/23/01 Compute double torsional energy
5658 implicit real*8 (a-h,o-z)
5659 include 'DIMENSIONS'
5660 include 'COMMON.VAR'
5661 include 'COMMON.GEO'
5662 include 'COMMON.LOCAL'
5663 include 'COMMON.TORSION'
5664 include 'COMMON.INTERACT'
5665 include 'COMMON.DERIV'
5666 include 'COMMON.CHAIN'
5667 include 'COMMON.NAMES'
5668 include 'COMMON.IOUNITS'
5669 include 'COMMON.FFIELD'
5670 include 'COMMON.TORCNSTR'
5672 C Set lprn=.true. for debugging
5676 c write(iout,*) "a tu??"
5677 do i=iphid_start,iphid_end
5678 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5679 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5680 itori=itortyp(itype(i-2))
5681 itori1=itortyp(itype(i-1))
5682 itori2=itortyp(itype(i))
5688 if (iabs(itype(i+1)).eq.20) iblock=2
5690 C Regular cosine and sine terms
5691 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5692 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5693 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5694 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5695 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5696 cosphi1=dcos(j*phii)
5697 sinphi1=dsin(j*phii)
5698 cosphi2=dcos(j*phii1)
5699 sinphi2=dsin(j*phii1)
5700 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5701 & v2cij*cosphi2+v2sij*sinphi2
5702 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5703 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5705 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5707 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5708 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5709 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5710 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5711 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5712 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5713 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5714 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5715 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5716 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5717 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5718 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5719 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5720 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5723 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5724 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5729 c------------------------------------------------------------------------------
5730 subroutine eback_sc_corr(esccor)
5731 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5732 c conformational states; temporarily implemented as differences
5733 c between UNRES torsional potentials (dependent on three types of
5734 c residues) and the torsional potentials dependent on all 20 types
5735 c of residues computed from AM1 energy surfaces of terminally-blocked
5736 c amino-acid residues.
5737 implicit real*8 (a-h,o-z)
5738 include 'DIMENSIONS'
5739 include 'COMMON.VAR'
5740 include 'COMMON.GEO'
5741 include 'COMMON.LOCAL'
5742 include 'COMMON.TORSION'
5743 include 'COMMON.SCCOR'
5744 include 'COMMON.INTERACT'
5745 include 'COMMON.DERIV'
5746 include 'COMMON.CHAIN'
5747 include 'COMMON.NAMES'
5748 include 'COMMON.IOUNITS'
5749 include 'COMMON.FFIELD'
5750 include 'COMMON.CONTROL'
5752 C Set lprn=.true. for debugging
5755 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5757 do i=itau_start,itau_end
5758 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5760 isccori=isccortyp(itype(i-2))
5761 isccori1=isccortyp(itype(i-1))
5762 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5764 do intertyp=1,3 !intertyp
5765 cc Added 09 May 2012 (Adasko)
5766 cc Intertyp means interaction type of backbone mainchain correlation:
5767 c 1 = SC...Ca...Ca...Ca
5768 c 2 = Ca...Ca...Ca...SC
5769 c 3 = SC...Ca...Ca...SCi
5771 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5772 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5773 & (itype(i-1).eq.ntyp1)))
5774 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5775 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5776 & .or.(itype(i).eq.ntyp1)))
5777 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5778 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5779 & (itype(i-3).eq.ntyp1)))) cycle
5780 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5781 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5783 do j=1,nterm_sccor(isccori,isccori1)
5784 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5785 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5786 cosphi=dcos(j*tauangle(intertyp,i))
5787 sinphi=dsin(j*tauangle(intertyp,i))
5788 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5789 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5791 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5792 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5794 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5795 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5796 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5797 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5798 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5804 c----------------------------------------------------------------------------
5805 subroutine multibody(ecorr)
5806 C This subroutine calculates multi-body contributions to energy following
5807 C the idea of Skolnick et al. If side chains I and J make a contact and
5808 C at the same time side chains I+1 and J+1 make a contact, an extra
5809 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5810 implicit real*8 (a-h,o-z)
5811 include 'DIMENSIONS'
5812 include 'COMMON.IOUNITS'
5813 include 'COMMON.DERIV'
5814 include 'COMMON.INTERACT'
5815 include 'COMMON.CONTACTS'
5816 double precision gx(3),gx1(3)
5819 C Set lprn=.true. for debugging
5823 write (iout,'(a)') 'Contact function values:'
5825 write (iout,'(i2,20(1x,i2,f10.5))')
5826 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5841 num_conti=num_cont(i)
5842 num_conti1=num_cont(i1)
5847 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5848 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5849 cd & ' ishift=',ishift
5850 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5851 C The system gains extra energy.
5852 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5853 endif ! j1==j+-ishift
5862 c------------------------------------------------------------------------------
5863 double precision function esccorr(i,j,k,l,jj,kk)
5864 implicit real*8 (a-h,o-z)
5865 include 'DIMENSIONS'
5866 include 'COMMON.IOUNITS'
5867 include 'COMMON.DERIV'
5868 include 'COMMON.INTERACT'
5869 include 'COMMON.CONTACTS'
5870 double precision gx(3),gx1(3)
5875 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5876 C Calculate the multi-body contribution to energy.
5877 C Calculate multi-body contributions to the gradient.
5878 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5879 cd & k,l,(gacont(m,kk,k),m=1,3)
5881 gx(m) =ekl*gacont(m,jj,i)
5882 gx1(m)=eij*gacont(m,kk,k)
5883 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5884 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5885 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5886 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5890 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5895 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5901 c------------------------------------------------------------------------------
5902 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5903 C This subroutine calculates multi-body contributions to hydrogen-bonding
5904 implicit real*8 (a-h,o-z)
5905 include 'DIMENSIONS'
5906 include 'COMMON.IOUNITS'
5909 parameter (max_cont=maxconts)
5910 parameter (max_dim=26)
5911 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5912 double precision zapas(max_dim,maxconts,max_fg_procs),
5913 & zapas_recv(max_dim,maxconts,max_fg_procs)
5914 common /przechowalnia/ zapas
5915 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5916 & status_array(MPI_STATUS_SIZE,maxconts*2)
5918 include 'COMMON.SETUP'
5919 include 'COMMON.FFIELD'
5920 include 'COMMON.DERIV'
5921 include 'COMMON.INTERACT'
5922 include 'COMMON.CONTACTS'
5923 include 'COMMON.CONTROL'
5924 include 'COMMON.LOCAL'
5925 double precision gx(3),gx1(3),time00
5928 C Set lprn=.true. for debugging
5933 if (nfgtasks.le.1) goto 30
5935 write (iout,'(a)') 'Contact function values before RECEIVE:'
5937 write (iout,'(2i3,50(1x,i2,f5.2))')
5938 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5939 & j=1,num_cont_hb(i))
5943 do i=1,ntask_cont_from
5946 do i=1,ntask_cont_to
5949 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5951 C Make the list of contacts to send to send to other procesors
5952 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5954 do i=iturn3_start,iturn3_end
5955 c write (iout,*) "make contact list turn3",i," num_cont",
5957 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5959 do i=iturn4_start,iturn4_end
5960 c write (iout,*) "make contact list turn4",i," num_cont",
5962 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5966 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5968 do j=1,num_cont_hb(i)
5971 iproc=iint_sent_local(k,jjc,ii)
5972 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5973 if (iproc.gt.0) then
5974 ncont_sent(iproc)=ncont_sent(iproc)+1
5975 nn=ncont_sent(iproc)
5977 zapas(2,nn,iproc)=jjc
5978 zapas(3,nn,iproc)=facont_hb(j,i)
5979 zapas(4,nn,iproc)=ees0p(j,i)
5980 zapas(5,nn,iproc)=ees0m(j,i)
5981 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5982 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5983 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5984 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5985 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5986 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5987 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5988 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5989 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5990 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5991 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5992 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5993 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5994 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5995 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5996 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5997 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5998 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5999 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6000 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6001 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6008 & "Numbers of contacts to be sent to other processors",
6009 & (ncont_sent(i),i=1,ntask_cont_to)
6010 write (iout,*) "Contacts sent"
6011 do ii=1,ntask_cont_to
6013 iproc=itask_cont_to(ii)
6014 write (iout,*) nn," contacts to processor",iproc,
6015 & " of CONT_TO_COMM group"
6017 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6025 CorrelID1=nfgtasks+fg_rank+1
6027 C Receive the numbers of needed contacts from other processors
6028 do ii=1,ntask_cont_from
6029 iproc=itask_cont_from(ii)
6031 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6032 & FG_COMM,req(ireq),IERR)
6034 c write (iout,*) "IRECV ended"
6036 C Send the number of contacts needed by other processors
6037 do ii=1,ntask_cont_to
6038 iproc=itask_cont_to(ii)
6040 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6041 & FG_COMM,req(ireq),IERR)
6043 c write (iout,*) "ISEND ended"
6044 c write (iout,*) "number of requests (nn)",ireq
6047 & call MPI_Waitall(ireq,req,status_array,ierr)
6049 c & "Numbers of contacts to be received from other processors",
6050 c & (ncont_recv(i),i=1,ntask_cont_from)
6054 do ii=1,ntask_cont_from
6055 iproc=itask_cont_from(ii)
6057 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6058 c & " of CONT_TO_COMM group"
6062 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6063 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6064 c write (iout,*) "ireq,req",ireq,req(ireq)
6067 C Send the contacts to processors that need them
6068 do ii=1,ntask_cont_to
6069 iproc=itask_cont_to(ii)
6071 c write (iout,*) nn," contacts to processor",iproc,
6072 c & " of CONT_TO_COMM group"
6075 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6076 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6077 c write (iout,*) "ireq,req",ireq,req(ireq)
6079 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6083 c write (iout,*) "number of requests (contacts)",ireq
6084 c write (iout,*) "req",(req(i),i=1,4)
6087 & call MPI_Waitall(ireq,req,status_array,ierr)
6088 do iii=1,ntask_cont_from
6089 iproc=itask_cont_from(iii)
6092 write (iout,*) "Received",nn," contacts from processor",iproc,
6093 & " of CONT_FROM_COMM group"
6096 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6101 ii=zapas_recv(1,i,iii)
6102 c Flag the received contacts to prevent double-counting
6103 jj=-zapas_recv(2,i,iii)
6104 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6106 nnn=num_cont_hb(ii)+1
6109 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6110 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6111 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6112 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6113 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6114 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6115 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6116 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6117 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6118 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6119 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6120 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6121 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6122 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6123 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6124 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6125 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6126 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6127 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6128 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6129 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6130 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6131 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6132 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6137 write (iout,'(a)') 'Contact function values after receive:'
6139 write (iout,'(2i3,50(1x,i3,f5.2))')
6140 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6141 & j=1,num_cont_hb(i))
6148 write (iout,'(a)') 'Contact function values:'
6150 write (iout,'(2i3,50(1x,i3,f5.2))')
6151 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6152 & j=1,num_cont_hb(i))
6156 C Remove the loop below after debugging !!!
6163 C Calculate the local-electrostatic correlation terms
6164 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6166 num_conti=num_cont_hb(i)
6167 num_conti1=num_cont_hb(i+1)
6174 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6175 c & ' jj=',jj,' kk=',kk
6176 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6177 & .or. j.lt.0 .and. j1.gt.0) .and.
6178 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6179 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6180 C The system gains extra energy.
6181 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6182 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6183 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6185 else if (j1.eq.j) then
6186 C Contacts I-J and I-(J+1) occur simultaneously.
6187 C The system loses extra energy.
6188 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6193 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6194 c & ' jj=',jj,' kk=',kk
6196 C Contacts I-J and (I+1)-J occur simultaneously.
6197 C The system loses extra energy.
6198 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6205 c------------------------------------------------------------------------------
6206 subroutine add_hb_contact(ii,jj,itask)
6207 implicit real*8 (a-h,o-z)
6208 include "DIMENSIONS"
6209 include "COMMON.IOUNITS"
6212 parameter (max_cont=maxconts)
6213 parameter (max_dim=26)
6214 include "COMMON.CONTACTS"
6215 double precision zapas(max_dim,maxconts,max_fg_procs),
6216 & zapas_recv(max_dim,maxconts,max_fg_procs)
6217 common /przechowalnia/ zapas
6218 integer i,j,ii,jj,iproc,itask(4),nn
6219 c write (iout,*) "itask",itask
6222 if (iproc.gt.0) then
6223 do j=1,num_cont_hb(ii)
6225 c write (iout,*) "i",ii," j",jj," jjc",jjc
6227 ncont_sent(iproc)=ncont_sent(iproc)+1
6228 nn=ncont_sent(iproc)
6229 zapas(1,nn,iproc)=ii
6230 zapas(2,nn,iproc)=jjc
6231 zapas(3,nn,iproc)=facont_hb(j,ii)
6232 zapas(4,nn,iproc)=ees0p(j,ii)
6233 zapas(5,nn,iproc)=ees0m(j,ii)
6234 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6235 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6236 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6237 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6238 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6239 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6240 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6241 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6242 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6243 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6244 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6245 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6246 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6247 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6248 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6249 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6250 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6251 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6252 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6253 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6254 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6262 c------------------------------------------------------------------------------
6263 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6265 C This subroutine calculates multi-body contributions to hydrogen-bonding
6266 implicit real*8 (a-h,o-z)
6267 include 'DIMENSIONS'
6268 include 'COMMON.IOUNITS'
6271 parameter (max_cont=maxconts)
6272 parameter (max_dim=70)
6273 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6274 double precision zapas(max_dim,maxconts,max_fg_procs),
6275 & zapas_recv(max_dim,maxconts,max_fg_procs)
6276 common /przechowalnia/ zapas
6277 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6278 & status_array(MPI_STATUS_SIZE,maxconts*2)
6280 include 'COMMON.SETUP'
6281 include 'COMMON.FFIELD'
6282 include 'COMMON.DERIV'
6283 include 'COMMON.LOCAL'
6284 include 'COMMON.INTERACT'
6285 include 'COMMON.CONTACTS'
6286 include 'COMMON.CHAIN'
6287 include 'COMMON.CONTROL'
6288 double precision gx(3),gx1(3)
6289 integer num_cont_hb_old(maxres)
6291 double precision eello4,eello5,eelo6,eello_turn6
6292 external eello4,eello5,eello6,eello_turn6
6293 C Set lprn=.true. for debugging
6298 num_cont_hb_old(i)=num_cont_hb(i)
6302 if (nfgtasks.le.1) goto 30
6304 write (iout,'(a)') 'Contact function values before RECEIVE:'
6306 write (iout,'(2i3,50(1x,i2,f5.2))')
6307 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6308 & j=1,num_cont_hb(i))
6312 do i=1,ntask_cont_from
6315 do i=1,ntask_cont_to
6318 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6320 C Make the list of contacts to send to send to other procesors
6321 do i=iturn3_start,iturn3_end
6322 c write (iout,*) "make contact list turn3",i," num_cont",
6324 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6326 do i=iturn4_start,iturn4_end
6327 c write (iout,*) "make contact list turn4",i," num_cont",
6329 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6333 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6335 do j=1,num_cont_hb(i)
6338 iproc=iint_sent_local(k,jjc,ii)
6339 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6340 if (iproc.ne.0) then
6341 ncont_sent(iproc)=ncont_sent(iproc)+1
6342 nn=ncont_sent(iproc)
6344 zapas(2,nn,iproc)=jjc
6345 zapas(3,nn,iproc)=d_cont(j,i)
6349 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6354 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6362 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6373 & "Numbers of contacts to be sent to other processors",
6374 & (ncont_sent(i),i=1,ntask_cont_to)
6375 write (iout,*) "Contacts sent"
6376 do ii=1,ntask_cont_to
6378 iproc=itask_cont_to(ii)
6379 write (iout,*) nn," contacts to processor",iproc,
6380 & " of CONT_TO_COMM group"
6382 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6390 CorrelID1=nfgtasks+fg_rank+1
6392 C Receive the numbers of needed contacts from other processors
6393 do ii=1,ntask_cont_from
6394 iproc=itask_cont_from(ii)
6396 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6397 & FG_COMM,req(ireq),IERR)
6399 c write (iout,*) "IRECV ended"
6401 C Send the number of contacts needed by other processors
6402 do ii=1,ntask_cont_to
6403 iproc=itask_cont_to(ii)
6405 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6406 & FG_COMM,req(ireq),IERR)
6408 c write (iout,*) "ISEND ended"
6409 c write (iout,*) "number of requests (nn)",ireq
6412 & call MPI_Waitall(ireq,req,status_array,ierr)
6414 c & "Numbers of contacts to be received from other processors",
6415 c & (ncont_recv(i),i=1,ntask_cont_from)
6419 do ii=1,ntask_cont_from
6420 iproc=itask_cont_from(ii)
6422 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6423 c & " of CONT_TO_COMM group"
6427 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6428 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6429 c write (iout,*) "ireq,req",ireq,req(ireq)
6432 C Send the contacts to processors that need them
6433 do ii=1,ntask_cont_to
6434 iproc=itask_cont_to(ii)
6436 c write (iout,*) nn," contacts to processor",iproc,
6437 c & " of CONT_TO_COMM group"
6440 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6441 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6442 c write (iout,*) "ireq,req",ireq,req(ireq)
6444 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6448 c write (iout,*) "number of requests (contacts)",ireq
6449 c write (iout,*) "req",(req(i),i=1,4)
6452 & call MPI_Waitall(ireq,req,status_array,ierr)
6453 do iii=1,ntask_cont_from
6454 iproc=itask_cont_from(iii)
6457 write (iout,*) "Received",nn," contacts from processor",iproc,
6458 & " of CONT_FROM_COMM group"
6461 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6466 ii=zapas_recv(1,i,iii)
6467 c Flag the received contacts to prevent double-counting
6468 jj=-zapas_recv(2,i,iii)
6469 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6471 nnn=num_cont_hb(ii)+1
6474 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6478 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6483 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6491 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6500 write (iout,'(a)') 'Contact function values after receive:'
6502 write (iout,'(2i3,50(1x,i3,5f6.3))')
6503 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6504 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6511 write (iout,'(a)') 'Contact function values:'
6513 write (iout,'(2i3,50(1x,i2,5f6.3))')
6514 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6515 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6521 C Remove the loop below after debugging !!!
6528 C Calculate the dipole-dipole interaction energies
6529 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6530 do i=iatel_s,iatel_e+1
6531 num_conti=num_cont_hb(i)
6540 C Calculate the local-electrostatic correlation terms
6541 c write (iout,*) "gradcorr5 in eello5 before loop"
6543 c write (iout,'(i5,3f10.5)')
6544 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6546 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6547 c write (iout,*) "corr loop i",i
6549 num_conti=num_cont_hb(i)
6550 num_conti1=num_cont_hb(i+1)
6557 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6558 c & ' jj=',jj,' kk=',kk
6559 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6560 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6561 & .or. j.lt.0 .and. j1.gt.0) .and.
6562 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6563 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6564 C The system gains extra energy.
6566 sqd1=dsqrt(d_cont(jj,i))
6567 sqd2=dsqrt(d_cont(kk,i1))
6568 sred_geom = sqd1*sqd2
6569 IF (sred_geom.lt.cutoff_corr) THEN
6570 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6572 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6573 cd & ' jj=',jj,' kk=',kk
6574 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6575 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6577 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6578 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6581 cd write (iout,*) 'sred_geom=',sred_geom,
6582 cd & ' ekont=',ekont,' fprim=',fprimcont,
6583 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6584 cd write (iout,*) "g_contij",g_contij
6585 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6586 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6587 call calc_eello(i,jp,i+1,jp1,jj,kk)
6588 if (wcorr4.gt.0.0d0)
6589 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6590 if (energy_dec.and.wcorr4.gt.0.0d0)
6591 1 write (iout,'(a6,4i5,0pf7.3)')
6592 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6593 c write (iout,*) "gradcorr5 before eello5"
6595 c write (iout,'(i5,3f10.5)')
6596 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6598 if (wcorr5.gt.0.0d0)
6599 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6600 c write (iout,*) "gradcorr5 after eello5"
6602 c write (iout,'(i5,3f10.5)')
6603 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6605 if (energy_dec.and.wcorr5.gt.0.0d0)
6606 1 write (iout,'(a6,4i5,0pf7.3)')
6607 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6608 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6609 cd write(2,*)'ijkl',i,jp,i+1,jp1
6610 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6611 & .or. wturn6.eq.0.0d0))then
6612 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6613 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6614 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6615 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6616 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6617 cd & 'ecorr6=',ecorr6
6618 cd write (iout,'(4e15.5)') sred_geom,
6619 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6620 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6621 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6622 else if (wturn6.gt.0.0d0
6623 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6624 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6625 eturn6=eturn6+eello_turn6(i,jj,kk)
6626 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6627 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6628 cd write (2,*) 'multibody_eello:eturn6',eturn6
6637 num_cont_hb(i)=num_cont_hb_old(i)
6639 c write (iout,*) "gradcorr5 in eello5"
6641 c write (iout,'(i5,3f10.5)')
6642 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6646 c------------------------------------------------------------------------------
6647 subroutine add_hb_contact_eello(ii,jj,itask)
6648 implicit real*8 (a-h,o-z)
6649 include "DIMENSIONS"
6650 include "COMMON.IOUNITS"
6653 parameter (max_cont=maxconts)
6654 parameter (max_dim=70)
6655 include "COMMON.CONTACTS"
6656 double precision zapas(max_dim,maxconts,max_fg_procs),
6657 & zapas_recv(max_dim,maxconts,max_fg_procs)
6658 common /przechowalnia/ zapas
6659 integer i,j,ii,jj,iproc,itask(4),nn
6660 c write (iout,*) "itask",itask
6663 if (iproc.gt.0) then
6664 do j=1,num_cont_hb(ii)
6666 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6668 ncont_sent(iproc)=ncont_sent(iproc)+1
6669 nn=ncont_sent(iproc)
6670 zapas(1,nn,iproc)=ii
6671 zapas(2,nn,iproc)=jjc
6672 zapas(3,nn,iproc)=d_cont(j,ii)
6676 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6681 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6689 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6701 c------------------------------------------------------------------------------
6702 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6703 implicit real*8 (a-h,o-z)
6704 include 'DIMENSIONS'
6705 include 'COMMON.IOUNITS'
6706 include 'COMMON.DERIV'
6707 include 'COMMON.INTERACT'
6708 include 'COMMON.CONTACTS'
6709 double precision gx(3),gx1(3)
6719 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6720 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6721 C Following 4 lines for diagnostics.
6726 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6727 c & 'Contacts ',i,j,
6728 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6729 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6731 C Calculate the multi-body contribution to energy.
6732 c ecorr=ecorr+ekont*ees
6733 C Calculate multi-body contributions to the gradient.
6734 coeffpees0pij=coeffp*ees0pij
6735 coeffmees0mij=coeffm*ees0mij
6736 coeffpees0pkl=coeffp*ees0pkl
6737 coeffmees0mkl=coeffm*ees0mkl
6739 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6740 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6741 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6742 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6743 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6744 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6745 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6746 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6747 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6748 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6749 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6750 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6751 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6752 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6753 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6754 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6755 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6756 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6757 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6758 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6759 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6760 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6761 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6762 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6763 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6768 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6769 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6770 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6771 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6776 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6777 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6778 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6779 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6782 c write (iout,*) "ehbcorr",ekont*ees
6787 C---------------------------------------------------------------------------
6788 subroutine dipole(i,j,jj)
6789 implicit real*8 (a-h,o-z)
6790 include 'DIMENSIONS'
6791 include 'COMMON.IOUNITS'
6792 include 'COMMON.CHAIN'
6793 include 'COMMON.FFIELD'
6794 include 'COMMON.DERIV'
6795 include 'COMMON.INTERACT'
6796 include 'COMMON.CONTACTS'
6797 include 'COMMON.TORSION'
6798 include 'COMMON.VAR'
6799 include 'COMMON.GEO'
6800 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6802 iti1 = itortyp(itype(i+1))
6803 if (j.lt.nres-1) then
6804 itj1 = itortyp(itype(j+1))
6809 dipi(iii,1)=Ub2(iii,i)
6810 dipderi(iii)=Ub2der(iii,i)
6811 dipi(iii,2)=b1(iii,iti1)
6812 dipj(iii,1)=Ub2(iii,j)
6813 dipderj(iii)=Ub2der(iii,j)
6814 dipj(iii,2)=b1(iii,itj1)
6818 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6821 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6828 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6832 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6837 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6838 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6840 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6842 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6844 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6849 C---------------------------------------------------------------------------
6850 subroutine calc_eello(i,j,k,l,jj,kk)
6852 C This subroutine computes matrices and vectors needed to calculate
6853 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6855 implicit real*8 (a-h,o-z)
6856 include 'DIMENSIONS'
6857 include 'COMMON.IOUNITS'
6858 include 'COMMON.CHAIN'
6859 include 'COMMON.DERIV'
6860 include 'COMMON.INTERACT'
6861 include 'COMMON.CONTACTS'
6862 include 'COMMON.TORSION'
6863 include 'COMMON.VAR'
6864 include 'COMMON.GEO'
6865 include 'COMMON.FFIELD'
6866 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6867 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6870 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6871 cd & ' jj=',jj,' kk=',kk
6872 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6873 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6874 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6877 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6878 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6881 call transpose2(aa1(1,1),aa1t(1,1))
6882 call transpose2(aa2(1,1),aa2t(1,1))
6885 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6886 & aa1tder(1,1,lll,kkk))
6887 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6888 & aa2tder(1,1,lll,kkk))
6892 C parallel orientation of the two CA-CA-CA frames.
6894 iti=itortyp(itype(i))
6898 itk1=itortyp(itype(k+1))
6899 itj=itortyp(itype(j))
6900 if (l.lt.nres-1) then
6901 itl1=itortyp(itype(l+1))
6905 C A1 kernel(j+1) A2T
6907 cd write (iout,'(3f10.5,5x,3f10.5)')
6908 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6910 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6911 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6912 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6913 C Following matrices are needed only for 6-th order cumulants
6914 IF (wcorr6.gt.0.0d0) THEN
6915 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6916 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6917 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6918 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6919 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6920 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6921 & ADtEAderx(1,1,1,1,1,1))
6923 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6924 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6925 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6926 & ADtEA1derx(1,1,1,1,1,1))
6928 C End 6-th order cumulants
6931 cd write (2,*) 'In calc_eello6'
6933 cd write (2,*) 'iii=',iii
6935 cd write (2,*) 'kkk=',kkk
6937 cd write (2,'(3(2f10.5),5x)')
6938 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6943 call transpose2(EUgder(1,1,k),auxmat(1,1))
6944 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6945 call transpose2(EUg(1,1,k),auxmat(1,1))
6946 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6947 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6951 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6952 & EAEAderx(1,1,lll,kkk,iii,1))
6956 C A1T kernel(i+1) A2
6957 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6958 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6959 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6960 C Following matrices are needed only for 6-th order cumulants
6961 IF (wcorr6.gt.0.0d0) THEN
6962 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6963 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6964 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6965 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6966 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6967 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6968 & ADtEAderx(1,1,1,1,1,2))
6969 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6970 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6971 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6972 & ADtEA1derx(1,1,1,1,1,2))
6974 C End 6-th order cumulants
6975 call transpose2(EUgder(1,1,l),auxmat(1,1))
6976 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6977 call transpose2(EUg(1,1,l),auxmat(1,1))
6978 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6979 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6983 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6984 & EAEAderx(1,1,lll,kkk,iii,2))
6989 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6990 C They are needed only when the fifth- or the sixth-order cumulants are
6992 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6993 call transpose2(AEA(1,1,1),auxmat(1,1))
6994 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6995 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6996 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6997 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6998 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6999 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7000 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7001 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7002 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7003 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7004 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7005 call transpose2(AEA(1,1,2),auxmat(1,1))
7006 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7007 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7008 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7009 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7010 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7011 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7012 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7013 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7014 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7015 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7016 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7017 C Calculate the Cartesian derivatives of the vectors.
7021 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7022 call matvec2(auxmat(1,1),b1(1,iti),
7023 & AEAb1derx(1,lll,kkk,iii,1,1))
7024 call matvec2(auxmat(1,1),Ub2(1,i),
7025 & AEAb2derx(1,lll,kkk,iii,1,1))
7026 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7027 & AEAb1derx(1,lll,kkk,iii,2,1))
7028 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7029 & AEAb2derx(1,lll,kkk,iii,2,1))
7030 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7031 call matvec2(auxmat(1,1),b1(1,itj),
7032 & AEAb1derx(1,lll,kkk,iii,1,2))
7033 call matvec2(auxmat(1,1),Ub2(1,j),
7034 & AEAb2derx(1,lll,kkk,iii,1,2))
7035 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7036 & AEAb1derx(1,lll,kkk,iii,2,2))
7037 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7038 & AEAb2derx(1,lll,kkk,iii,2,2))
7045 C Antiparallel orientation of the two CA-CA-CA frames.
7047 iti=itortyp(itype(i))
7051 itk1=itortyp(itype(k+1))
7052 itl=itortyp(itype(l))
7053 itj=itortyp(itype(j))
7054 if (j.lt.nres-1) then
7055 itj1=itortyp(itype(j+1))
7059 C A2 kernel(j-1)T A1T
7060 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7061 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7062 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7063 C Following matrices are needed only for 6-th order cumulants
7064 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7065 & j.eq.i+4 .and. l.eq.i+3)) THEN
7066 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7067 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7068 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7069 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7070 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7071 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7072 & ADtEAderx(1,1,1,1,1,1))
7073 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7074 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7075 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7076 & ADtEA1derx(1,1,1,1,1,1))
7078 C End 6-th order cumulants
7079 call transpose2(EUgder(1,1,k),auxmat(1,1))
7080 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7081 call transpose2(EUg(1,1,k),auxmat(1,1))
7082 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7083 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7087 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7088 & EAEAderx(1,1,lll,kkk,iii,1))
7092 C A2T kernel(i+1)T A1
7093 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7094 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7095 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7096 C Following matrices are needed only for 6-th order cumulants
7097 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7098 & j.eq.i+4 .and. l.eq.i+3)) THEN
7099 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7100 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7101 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7102 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7103 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7104 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7105 & ADtEAderx(1,1,1,1,1,2))
7106 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7107 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7108 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7109 & ADtEA1derx(1,1,1,1,1,2))
7111 C End 6-th order cumulants
7112 call transpose2(EUgder(1,1,j),auxmat(1,1))
7113 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7114 call transpose2(EUg(1,1,j),auxmat(1,1))
7115 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7116 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7120 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7121 & EAEAderx(1,1,lll,kkk,iii,2))
7126 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7127 C They are needed only when the fifth- or the sixth-order cumulants are
7129 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7130 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7131 call transpose2(AEA(1,1,1),auxmat(1,1))
7132 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7133 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7134 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7135 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7136 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7137 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7138 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7139 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7140 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7141 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7142 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7143 call transpose2(AEA(1,1,2),auxmat(1,1))
7144 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7145 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7146 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7147 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7148 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7149 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7150 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7151 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7152 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7153 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7154 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7155 C Calculate the Cartesian derivatives of the vectors.
7159 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7160 call matvec2(auxmat(1,1),b1(1,iti),
7161 & AEAb1derx(1,lll,kkk,iii,1,1))
7162 call matvec2(auxmat(1,1),Ub2(1,i),
7163 & AEAb2derx(1,lll,kkk,iii,1,1))
7164 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7165 & AEAb1derx(1,lll,kkk,iii,2,1))
7166 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7167 & AEAb2derx(1,lll,kkk,iii,2,1))
7168 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7169 call matvec2(auxmat(1,1),b1(1,itl),
7170 & AEAb1derx(1,lll,kkk,iii,1,2))
7171 call matvec2(auxmat(1,1),Ub2(1,l),
7172 & AEAb2derx(1,lll,kkk,iii,1,2))
7173 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7174 & AEAb1derx(1,lll,kkk,iii,2,2))
7175 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7176 & AEAb2derx(1,lll,kkk,iii,2,2))
7185 C---------------------------------------------------------------------------
7186 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7187 & KK,KKderg,AKA,AKAderg,AKAderx)
7191 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7192 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7193 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7198 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7200 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7203 cd if (lprn) write (2,*) 'In kernel'
7205 cd if (lprn) write (2,*) 'kkk=',kkk
7207 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7208 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7210 cd write (2,*) 'lll=',lll
7211 cd write (2,*) 'iii=1'
7213 cd write (2,'(3(2f10.5),5x)')
7214 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7217 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7218 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7220 cd write (2,*) 'lll=',lll
7221 cd write (2,*) 'iii=2'
7223 cd write (2,'(3(2f10.5),5x)')
7224 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7231 C---------------------------------------------------------------------------
7232 double precision function eello4(i,j,k,l,jj,kk)
7233 implicit real*8 (a-h,o-z)
7234 include 'DIMENSIONS'
7235 include 'COMMON.IOUNITS'
7236 include 'COMMON.CHAIN'
7237 include 'COMMON.DERIV'
7238 include 'COMMON.INTERACT'
7239 include 'COMMON.CONTACTS'
7240 include 'COMMON.TORSION'
7241 include 'COMMON.VAR'
7242 include 'COMMON.GEO'
7243 double precision pizda(2,2),ggg1(3),ggg2(3)
7244 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7248 cd print *,'eello4:',i,j,k,l,jj,kk
7249 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7250 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7251 cold eij=facont_hb(jj,i)
7252 cold ekl=facont_hb(kk,k)
7254 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7255 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7256 gcorr_loc(k-1)=gcorr_loc(k-1)
7257 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7259 gcorr_loc(l-1)=gcorr_loc(l-1)
7260 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7262 gcorr_loc(j-1)=gcorr_loc(j-1)
7263 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7268 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7269 & -EAEAderx(2,2,lll,kkk,iii,1)
7270 cd derx(lll,kkk,iii)=0.0d0
7274 cd gcorr_loc(l-1)=0.0d0
7275 cd gcorr_loc(j-1)=0.0d0
7276 cd gcorr_loc(k-1)=0.0d0
7278 cd write (iout,*)'Contacts have occurred for peptide groups',
7279 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7280 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7281 if (j.lt.nres-1) then
7288 if (l.lt.nres-1) then
7296 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7297 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7298 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7299 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7300 cgrad ghalf=0.5d0*ggg1(ll)
7301 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7302 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7303 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7304 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7305 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7306 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7307 cgrad ghalf=0.5d0*ggg2(ll)
7308 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7309 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7310 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7311 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7312 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7313 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7317 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7322 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7327 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7332 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7336 cd write (2,*) iii,gcorr_loc(iii)
7339 cd write (2,*) 'ekont',ekont
7340 cd write (iout,*) 'eello4',ekont*eel4
7343 C---------------------------------------------------------------------------
7344 double precision function eello5(i,j,k,l,jj,kk)
7345 implicit real*8 (a-h,o-z)
7346 include 'DIMENSIONS'
7347 include 'COMMON.IOUNITS'
7348 include 'COMMON.CHAIN'
7349 include 'COMMON.DERIV'
7350 include 'COMMON.INTERACT'
7351 include 'COMMON.CONTACTS'
7352 include 'COMMON.TORSION'
7353 include 'COMMON.VAR'
7354 include 'COMMON.GEO'
7355 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7356 double precision ggg1(3),ggg2(3)
7357 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7362 C /l\ / \ \ / \ / \ / C
7363 C / \ / \ \ / \ / \ / C
7364 C j| o |l1 | o | o| o | | o |o C
7365 C \ |/k\| |/ \| / |/ \| |/ \| C
7366 C \i/ \ / \ / / \ / \ C
7368 C (I) (II) (III) (IV) C
7370 C eello5_1 eello5_2 eello5_3 eello5_4 C
7372 C Antiparallel chains C
7375 C /j\ / \ \ / \ / \ / C
7376 C / \ / \ \ / \ / \ / C
7377 C j1| o |l | o | o| o | | o |o C
7378 C \ |/k\| |/ \| / |/ \| |/ \| C
7379 C \i/ \ / \ / / \ / \ C
7381 C (I) (II) (III) (IV) C
7383 C eello5_1 eello5_2 eello5_3 eello5_4 C
7385 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7387 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7388 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7393 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7395 itk=itortyp(itype(k))
7396 itl=itortyp(itype(l))
7397 itj=itortyp(itype(j))
7402 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7403 cd & eel5_3_num,eel5_4_num)
7407 derx(lll,kkk,iii)=0.0d0
7411 cd eij=facont_hb(jj,i)
7412 cd ekl=facont_hb(kk,k)
7414 cd write (iout,*)'Contacts have occurred for peptide groups',
7415 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7417 C Contribution from the graph I.
7418 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7419 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7420 call transpose2(EUg(1,1,k),auxmat(1,1))
7421 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7422 vv(1)=pizda(1,1)-pizda(2,2)
7423 vv(2)=pizda(1,2)+pizda(2,1)
7424 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7425 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7426 C Explicit gradient in virtual-dihedral angles.
7427 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7428 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7429 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7430 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7431 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7432 vv(1)=pizda(1,1)-pizda(2,2)
7433 vv(2)=pizda(1,2)+pizda(2,1)
7434 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7435 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7436 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7437 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7438 vv(1)=pizda(1,1)-pizda(2,2)
7439 vv(2)=pizda(1,2)+pizda(2,1)
7441 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7442 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7443 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7445 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7446 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7447 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7449 C Cartesian gradient
7453 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7455 vv(1)=pizda(1,1)-pizda(2,2)
7456 vv(2)=pizda(1,2)+pizda(2,1)
7457 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7458 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7459 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7465 C Contribution from graph II
7466 call transpose2(EE(1,1,itk),auxmat(1,1))
7467 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7468 vv(1)=pizda(1,1)+pizda(2,2)
7469 vv(2)=pizda(2,1)-pizda(1,2)
7470 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7471 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7472 C Explicit gradient in virtual-dihedral angles.
7473 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7474 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7475 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7476 vv(1)=pizda(1,1)+pizda(2,2)
7477 vv(2)=pizda(2,1)-pizda(1,2)
7479 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7480 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7481 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7483 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7484 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7485 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7487 C Cartesian gradient
7491 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7493 vv(1)=pizda(1,1)+pizda(2,2)
7494 vv(2)=pizda(2,1)-pizda(1,2)
7495 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7496 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7497 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7505 C Parallel orientation
7506 C Contribution from graph III
7507 call transpose2(EUg(1,1,l),auxmat(1,1))
7508 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7509 vv(1)=pizda(1,1)-pizda(2,2)
7510 vv(2)=pizda(1,2)+pizda(2,1)
7511 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7512 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7513 C Explicit gradient in virtual-dihedral angles.
7514 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7515 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7516 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7517 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7518 vv(1)=pizda(1,1)-pizda(2,2)
7519 vv(2)=pizda(1,2)+pizda(2,1)
7520 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7521 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7522 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7523 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7524 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7525 vv(1)=pizda(1,1)-pizda(2,2)
7526 vv(2)=pizda(1,2)+pizda(2,1)
7527 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7528 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7529 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7530 C Cartesian gradient
7534 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7536 vv(1)=pizda(1,1)-pizda(2,2)
7537 vv(2)=pizda(1,2)+pizda(2,1)
7538 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7539 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7540 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7545 C Contribution from graph IV
7547 call transpose2(EE(1,1,itl),auxmat(1,1))
7548 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7549 vv(1)=pizda(1,1)+pizda(2,2)
7550 vv(2)=pizda(2,1)-pizda(1,2)
7551 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7552 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7553 C Explicit gradient in virtual-dihedral angles.
7554 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7555 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7556 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7557 vv(1)=pizda(1,1)+pizda(2,2)
7558 vv(2)=pizda(2,1)-pizda(1,2)
7559 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7560 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7561 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7562 C Cartesian gradient
7566 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7568 vv(1)=pizda(1,1)+pizda(2,2)
7569 vv(2)=pizda(2,1)-pizda(1,2)
7570 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7571 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7572 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7577 C Antiparallel orientation
7578 C Contribution from graph III
7580 call transpose2(EUg(1,1,j),auxmat(1,1))
7581 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7582 vv(1)=pizda(1,1)-pizda(2,2)
7583 vv(2)=pizda(1,2)+pizda(2,1)
7584 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7585 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7586 C Explicit gradient in virtual-dihedral angles.
7587 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7588 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7589 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7590 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7591 vv(1)=pizda(1,1)-pizda(2,2)
7592 vv(2)=pizda(1,2)+pizda(2,1)
7593 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7594 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7595 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7596 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7597 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7598 vv(1)=pizda(1,1)-pizda(2,2)
7599 vv(2)=pizda(1,2)+pizda(2,1)
7600 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7601 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7602 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7603 C Cartesian gradient
7607 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7609 vv(1)=pizda(1,1)-pizda(2,2)
7610 vv(2)=pizda(1,2)+pizda(2,1)
7611 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7612 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7613 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7618 C Contribution from graph IV
7620 call transpose2(EE(1,1,itj),auxmat(1,1))
7621 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7622 vv(1)=pizda(1,1)+pizda(2,2)
7623 vv(2)=pizda(2,1)-pizda(1,2)
7624 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7625 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7626 C Explicit gradient in virtual-dihedral angles.
7627 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7628 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7629 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7630 vv(1)=pizda(1,1)+pizda(2,2)
7631 vv(2)=pizda(2,1)-pizda(1,2)
7632 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7633 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7634 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7635 C Cartesian gradient
7639 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7641 vv(1)=pizda(1,1)+pizda(2,2)
7642 vv(2)=pizda(2,1)-pizda(1,2)
7643 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7644 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7645 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7651 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7652 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7653 cd write (2,*) 'ijkl',i,j,k,l
7654 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7655 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7657 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7658 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7659 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7660 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7661 if (j.lt.nres-1) then
7668 if (l.lt.nres-1) then
7678 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7679 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7680 C summed up outside the subrouine as for the other subroutines
7681 C handling long-range interactions. The old code is commented out
7682 C with "cgrad" to keep track of changes.
7684 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7685 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7686 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7687 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7688 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7689 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7690 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7691 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7692 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7693 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7695 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7696 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7697 cgrad ghalf=0.5d0*ggg1(ll)
7699 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7700 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7701 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7702 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7703 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7704 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7705 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7706 cgrad ghalf=0.5d0*ggg2(ll)
7708 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7709 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7710 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7711 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7712 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7713 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7718 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7719 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7724 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7725 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7731 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7736 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7740 cd write (2,*) iii,g_corr5_loc(iii)
7743 cd write (2,*) 'ekont',ekont
7744 cd write (iout,*) 'eello5',ekont*eel5
7747 c--------------------------------------------------------------------------
7748 double precision function eello6(i,j,k,l,jj,kk)
7749 implicit real*8 (a-h,o-z)
7750 include 'DIMENSIONS'
7751 include 'COMMON.IOUNITS'
7752 include 'COMMON.CHAIN'
7753 include 'COMMON.DERIV'
7754 include 'COMMON.INTERACT'
7755 include 'COMMON.CONTACTS'
7756 include 'COMMON.TORSION'
7757 include 'COMMON.VAR'
7758 include 'COMMON.GEO'
7759 include 'COMMON.FFIELD'
7760 double precision ggg1(3),ggg2(3)
7761 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7766 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7774 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7775 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7779 derx(lll,kkk,iii)=0.0d0
7783 cd eij=facont_hb(jj,i)
7784 cd ekl=facont_hb(kk,k)
7790 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7791 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7792 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7793 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7794 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7795 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7797 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7798 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7799 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7800 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7801 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7802 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7806 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7808 C If turn contributions are considered, they will be handled separately.
7809 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7810 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7811 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7812 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7813 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7814 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7815 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7817 if (j.lt.nres-1) then
7824 if (l.lt.nres-1) then
7832 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7833 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7834 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7835 cgrad ghalf=0.5d0*ggg1(ll)
7837 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7838 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7839 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7840 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7841 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7842 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7843 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7844 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7845 cgrad ghalf=0.5d0*ggg2(ll)
7846 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7848 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7849 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7850 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7851 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7852 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7853 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7858 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7859 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7864 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7865 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7871 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7876 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7880 cd write (2,*) iii,g_corr6_loc(iii)
7883 cd write (2,*) 'ekont',ekont
7884 cd write (iout,*) 'eello6',ekont*eel6
7887 c--------------------------------------------------------------------------
7888 double precision function eello6_graph1(i,j,k,l,imat,swap)
7889 implicit real*8 (a-h,o-z)
7890 include 'DIMENSIONS'
7891 include 'COMMON.IOUNITS'
7892 include 'COMMON.CHAIN'
7893 include 'COMMON.DERIV'
7894 include 'COMMON.INTERACT'
7895 include 'COMMON.CONTACTS'
7896 include 'COMMON.TORSION'
7897 include 'COMMON.VAR'
7898 include 'COMMON.GEO'
7899 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7903 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7905 C Parallel Antiparallel C
7911 C \ j|/k\| / \ |/k\|l / C
7916 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7917 itk=itortyp(itype(k))
7918 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7919 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7920 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7921 call transpose2(EUgC(1,1,k),auxmat(1,1))
7922 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7923 vv1(1)=pizda1(1,1)-pizda1(2,2)
7924 vv1(2)=pizda1(1,2)+pizda1(2,1)
7925 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7926 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7927 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7928 s5=scalar2(vv(1),Dtobr2(1,i))
7929 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7930 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7931 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7932 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7933 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7934 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7935 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7936 & +scalar2(vv(1),Dtobr2der(1,i)))
7937 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7941 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7943 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7944 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7945 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7946 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7947 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7949 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7950 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7951 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7952 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7953 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7955 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7956 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7957 vv1(1)=pizda1(1,1)-pizda1(2,2)
7958 vv1(2)=pizda1(1,2)+pizda1(2,1)
7959 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7960 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7961 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7962 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7971 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7972 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7973 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7974 call transpose2(EUgC(1,1,k),auxmat(1,1))
7975 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7977 vv1(1)=pizda1(1,1)-pizda1(2,2)
7978 vv1(2)=pizda1(1,2)+pizda1(2,1)
7979 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7980 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7981 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7982 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7983 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7984 s5=scalar2(vv(1),Dtobr2(1,i))
7985 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7991 c----------------------------------------------------------------------------
7992 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7993 implicit real*8 (a-h,o-z)
7994 include 'DIMENSIONS'
7995 include 'COMMON.IOUNITS'
7996 include 'COMMON.CHAIN'
7997 include 'COMMON.DERIV'
7998 include 'COMMON.INTERACT'
7999 include 'COMMON.CONTACTS'
8000 include 'COMMON.TORSION'
8001 include 'COMMON.VAR'
8002 include 'COMMON.GEO'
8004 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8005 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8008 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8010 C Parallel Antiparallel C
8016 C \ j|/k\| \ |/k\|l C
8021 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8022 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8023 C AL 7/4/01 s1 would occur in the sixth-order moment,
8024 C but not in a cluster cumulant
8026 s1=dip(1,jj,i)*dip(1,kk,k)
8028 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8029 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8030 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8031 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8032 call transpose2(EUg(1,1,k),auxmat(1,1))
8033 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8034 vv(1)=pizda(1,1)-pizda(2,2)
8035 vv(2)=pizda(1,2)+pizda(2,1)
8036 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8037 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8039 eello6_graph2=-(s1+s2+s3+s4)
8041 eello6_graph2=-(s2+s3+s4)
8044 C Derivatives in gamma(i-1)
8047 s1=dipderg(1,jj,i)*dip(1,kk,k)
8049 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8050 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8051 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8052 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8054 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8056 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8058 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8060 C Derivatives in gamma(k-1)
8062 s1=dip(1,jj,i)*dipderg(1,kk,k)
8064 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8065 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8066 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8067 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8068 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8069 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8070 vv(1)=pizda(1,1)-pizda(2,2)
8071 vv(2)=pizda(1,2)+pizda(2,1)
8072 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8074 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8076 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8078 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8079 C Derivatives in gamma(j-1) or gamma(l-1)
8082 s1=dipderg(3,jj,i)*dip(1,kk,k)
8084 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8085 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8086 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8087 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8088 vv(1)=pizda(1,1)-pizda(2,2)
8089 vv(2)=pizda(1,2)+pizda(2,1)
8090 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8093 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8095 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8098 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8099 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8101 C Derivatives in gamma(l-1) or gamma(j-1)
8104 s1=dip(1,jj,i)*dipderg(3,kk,k)
8106 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8107 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8108 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8109 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8110 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8111 vv(1)=pizda(1,1)-pizda(2,2)
8112 vv(2)=pizda(1,2)+pizda(2,1)
8113 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8116 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8118 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8121 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8122 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8124 C Cartesian derivatives.
8126 write (2,*) 'In eello6_graph2'
8128 write (2,*) 'iii=',iii
8130 write (2,*) 'kkk=',kkk
8132 write (2,'(3(2f10.5),5x)')
8133 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8143 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8145 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8148 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8150 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8151 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8153 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8154 call transpose2(EUg(1,1,k),auxmat(1,1))
8155 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8157 vv(1)=pizda(1,1)-pizda(2,2)
8158 vv(2)=pizda(1,2)+pizda(2,1)
8159 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8160 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8162 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8164 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8167 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8169 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8176 c----------------------------------------------------------------------------
8177 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8178 implicit real*8 (a-h,o-z)
8179 include 'DIMENSIONS'
8180 include 'COMMON.IOUNITS'
8181 include 'COMMON.CHAIN'
8182 include 'COMMON.DERIV'
8183 include 'COMMON.INTERACT'
8184 include 'COMMON.CONTACTS'
8185 include 'COMMON.TORSION'
8186 include 'COMMON.VAR'
8187 include 'COMMON.GEO'
8188 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8190 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8192 C Parallel Antiparallel C
8198 C j|/k\| / |/k\|l / C
8203 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8205 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8206 C energy moment and not to the cluster cumulant.
8207 iti=itortyp(itype(i))
8208 if (j.lt.nres-1) then
8209 itj1=itortyp(itype(j+1))
8213 itk=itortyp(itype(k))
8214 itk1=itortyp(itype(k+1))
8215 if (l.lt.nres-1) then
8216 itl1=itortyp(itype(l+1))
8221 s1=dip(4,jj,i)*dip(4,kk,k)
8223 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8224 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8225 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8226 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8227 call transpose2(EE(1,1,itk),auxmat(1,1))
8228 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8229 vv(1)=pizda(1,1)+pizda(2,2)
8230 vv(2)=pizda(2,1)-pizda(1,2)
8231 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8232 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8233 cd & "sum",-(s2+s3+s4)
8235 eello6_graph3=-(s1+s2+s3+s4)
8237 eello6_graph3=-(s2+s3+s4)
8240 C Derivatives in gamma(k-1)
8241 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8242 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8243 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8244 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8245 C Derivatives in gamma(l-1)
8246 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8247 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8248 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8249 vv(1)=pizda(1,1)+pizda(2,2)
8250 vv(2)=pizda(2,1)-pizda(1,2)
8251 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8252 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8253 C Cartesian derivatives.
8259 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8261 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8264 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8266 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8267 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8269 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8270 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8272 vv(1)=pizda(1,1)+pizda(2,2)
8273 vv(2)=pizda(2,1)-pizda(1,2)
8274 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8276 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8278 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8281 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8283 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8285 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8291 c----------------------------------------------------------------------------
8292 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8293 implicit real*8 (a-h,o-z)
8294 include 'DIMENSIONS'
8295 include 'COMMON.IOUNITS'
8296 include 'COMMON.CHAIN'
8297 include 'COMMON.DERIV'
8298 include 'COMMON.INTERACT'
8299 include 'COMMON.CONTACTS'
8300 include 'COMMON.TORSION'
8301 include 'COMMON.VAR'
8302 include 'COMMON.GEO'
8303 include 'COMMON.FFIELD'
8304 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8305 & auxvec1(2),auxmat1(2,2)
8307 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8309 C Parallel Antiparallel C
8315 C \ j|/k\| \ |/k\|l C
8320 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8322 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8323 C energy moment and not to the cluster cumulant.
8324 cd write (2,*) 'eello_graph4: wturn6',wturn6
8325 iti=itortyp(itype(i))
8326 itj=itortyp(itype(j))
8327 if (j.lt.nres-1) then
8328 itj1=itortyp(itype(j+1))
8332 itk=itortyp(itype(k))
8333 if (k.lt.nres-1) then
8334 itk1=itortyp(itype(k+1))
8338 itl=itortyp(itype(l))
8339 if (l.lt.nres-1) then
8340 itl1=itortyp(itype(l+1))
8344 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8345 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8346 cd & ' itl',itl,' itl1',itl1
8349 s1=dip(3,jj,i)*dip(3,kk,k)
8351 s1=dip(2,jj,j)*dip(2,kk,l)
8354 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8355 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8357 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8358 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8360 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8361 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8363 call transpose2(EUg(1,1,k),auxmat(1,1))
8364 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8365 vv(1)=pizda(1,1)-pizda(2,2)
8366 vv(2)=pizda(2,1)+pizda(1,2)
8367 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8368 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8370 eello6_graph4=-(s1+s2+s3+s4)
8372 eello6_graph4=-(s2+s3+s4)
8374 C Derivatives in gamma(i-1)
8378 s1=dipderg(2,jj,i)*dip(3,kk,k)
8380 s1=dipderg(4,jj,j)*dip(2,kk,l)
8383 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8385 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8386 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8388 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8389 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8391 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8392 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8393 cd write (2,*) 'turn6 derivatives'
8395 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8397 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8401 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8403 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8407 C Derivatives in gamma(k-1)
8410 s1=dip(3,jj,i)*dipderg(2,kk,k)
8412 s1=dip(2,jj,j)*dipderg(4,kk,l)
8415 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8416 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8418 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8419 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8421 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8422 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8424 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8425 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8426 vv(1)=pizda(1,1)-pizda(2,2)
8427 vv(2)=pizda(2,1)+pizda(1,2)
8428 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8429 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8431 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8433 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8437 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8439 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8442 C Derivatives in gamma(j-1) or gamma(l-1)
8443 if (l.eq.j+1 .and. l.gt.1) then
8444 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8445 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8446 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8447 vv(1)=pizda(1,1)-pizda(2,2)
8448 vv(2)=pizda(2,1)+pizda(1,2)
8449 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8450 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8451 else if (j.gt.1) then
8452 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8453 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8454 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(2,1)+pizda(1,2)
8457 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8458 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8459 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8461 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8464 C Cartesian derivatives.
8471 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8473 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8477 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8479 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8483 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8485 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8487 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8488 & b1(1,itj1),auxvec(1))
8489 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8491 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8492 & b1(1,itl1),auxvec(1))
8493 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8495 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8497 vv(1)=pizda(1,1)-pizda(2,2)
8498 vv(2)=pizda(2,1)+pizda(1,2)
8499 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8501 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8503 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8506 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8509 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8512 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8514 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8516 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8520 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8522 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8525 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8527 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8535 c----------------------------------------------------------------------------
8536 double precision function eello_turn6(i,jj,kk)
8537 implicit real*8 (a-h,o-z)
8538 include 'DIMENSIONS'
8539 include 'COMMON.IOUNITS'
8540 include 'COMMON.CHAIN'
8541 include 'COMMON.DERIV'
8542 include 'COMMON.INTERACT'
8543 include 'COMMON.CONTACTS'
8544 include 'COMMON.TORSION'
8545 include 'COMMON.VAR'
8546 include 'COMMON.GEO'
8547 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8548 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8550 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8551 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8552 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8553 C the respective energy moment and not to the cluster cumulant.
8562 iti=itortyp(itype(i))
8563 itk=itortyp(itype(k))
8564 itk1=itortyp(itype(k+1))
8565 itl=itortyp(itype(l))
8566 itj=itortyp(itype(j))
8567 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8568 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8569 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8574 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8576 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8580 derx_turn(lll,kkk,iii)=0.0d0
8587 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8589 cd write (2,*) 'eello6_5',eello6_5
8591 call transpose2(AEA(1,1,1),auxmat(1,1))
8592 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8593 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8594 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8596 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8597 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8598 s2 = scalar2(b1(1,itk),vtemp1(1))
8600 call transpose2(AEA(1,1,2),atemp(1,1))
8601 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8602 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8603 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8605 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8606 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8607 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8609 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8610 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8611 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8612 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8613 ss13 = scalar2(b1(1,itk),vtemp4(1))
8614 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8616 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8622 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8623 C Derivatives in gamma(i+2)
8627 call transpose2(AEA(1,1,1),auxmatd(1,1))
8628 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8629 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8630 call transpose2(AEAderg(1,1,2),atempd(1,1))
8631 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8632 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8634 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8635 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8636 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8642 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8643 C Derivatives in gamma(i+3)
8645 call transpose2(AEA(1,1,1),auxmatd(1,1))
8646 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8647 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8648 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8650 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8651 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8652 s2d = scalar2(b1(1,itk),vtemp1d(1))
8654 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8655 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8657 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8659 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8660 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8661 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8669 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8670 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8672 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8673 & -0.5d0*ekont*(s2d+s12d)
8675 C Derivatives in gamma(i+4)
8676 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8677 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8678 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8680 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8681 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8682 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8690 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8692 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8694 C Derivatives in gamma(i+5)
8696 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8697 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8698 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8700 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8701 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8702 s2d = scalar2(b1(1,itk),vtemp1d(1))
8704 call transpose2(AEA(1,1,2),atempd(1,1))
8705 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8706 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8708 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8709 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8711 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8712 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8713 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8721 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8722 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8724 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8725 & -0.5d0*ekont*(s2d+s12d)
8727 C Cartesian derivatives
8732 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8733 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8734 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8736 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8737 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8739 s2d = scalar2(b1(1,itk),vtemp1d(1))
8741 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8742 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8743 s8d = -(atempd(1,1)+atempd(2,2))*
8744 & scalar2(cc(1,1,itl),vtemp2(1))
8746 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8748 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8749 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8756 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8759 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8763 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8764 & - 0.5d0*(s8d+s12d)
8766 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8775 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8777 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8778 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8779 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8780 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8781 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8783 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8784 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8785 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8789 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8790 cd & 16*eel_turn6_num
8792 if (j.lt.nres-1) then
8799 if (l.lt.nres-1) then
8807 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8808 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8809 cgrad ghalf=0.5d0*ggg1(ll)
8811 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8812 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8813 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8814 & +ekont*derx_turn(ll,2,1)
8815 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8816 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8817 & +ekont*derx_turn(ll,4,1)
8818 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8819 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8820 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8821 cgrad ghalf=0.5d0*ggg2(ll)
8823 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8824 & +ekont*derx_turn(ll,2,2)
8825 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8826 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8827 & +ekont*derx_turn(ll,4,2)
8828 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8829 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8830 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8835 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8840 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8846 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8851 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8855 cd write (2,*) iii,g_corr6_loc(iii)
8857 eello_turn6=ekont*eel_turn6
8858 cd write (2,*) 'ekont',ekont
8859 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8863 C-----------------------------------------------------------------------------
8864 double precision function scalar(u,v)
8865 !DIR$ INLINEALWAYS scalar
8867 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8870 double precision u(3),v(3)
8871 cd double precision sc
8879 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8882 crc-------------------------------------------------
8883 SUBROUTINE MATVEC2(A1,V1,V2)
8884 !DIR$ INLINEALWAYS MATVEC2
8886 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8888 implicit real*8 (a-h,o-z)
8889 include 'DIMENSIONS'
8890 DIMENSION A1(2,2),V1(2),V2(2)
8894 c 3 VI=VI+A1(I,K)*V1(K)
8898 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8899 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8904 C---------------------------------------
8905 SUBROUTINE MATMAT2(A1,A2,A3)
8907 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8909 implicit real*8 (a-h,o-z)
8910 include 'DIMENSIONS'
8911 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8912 c DIMENSION AI3(2,2)
8916 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8922 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8923 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8924 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8925 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8933 c-------------------------------------------------------------------------
8934 double precision function scalar2(u,v)
8935 !DIR$ INLINEALWAYS scalar2
8937 double precision u(2),v(2)
8940 scalar2=u(1)*v(1)+u(2)*v(2)
8944 C-----------------------------------------------------------------------------
8946 subroutine transpose2(a,at)
8947 !DIR$ INLINEALWAYS transpose2
8949 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8952 double precision a(2,2),at(2,2)
8959 c--------------------------------------------------------------------------
8960 subroutine transpose(n,a,at)
8963 double precision a(n,n),at(n,n)
8971 C---------------------------------------------------------------------------
8972 subroutine prodmat3(a1,a2,kk,transp,prod)
8973 !DIR$ INLINEALWAYS prodmat3
8975 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8979 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8981 crc double precision auxmat(2,2),prod_(2,2)
8984 crc call transpose2(kk(1,1),auxmat(1,1))
8985 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8986 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8988 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8989 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8990 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8991 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8992 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8993 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8994 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8995 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8998 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8999 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9001 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9002 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9003 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9004 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9005 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9006 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9007 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9008 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9011 c call transpose2(a2(1,1),a2t(1,1))
9014 crc print *,((prod_(i,j),i=1,2),j=1,2)
9015 crc print *,((prod(i,j),i=1,2),j=1,2)