1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
124 c print *,"Processor",myrank," computed USCSC"
130 time_vec=time_vec+MPI_Wtime()-time01
132 c print *,"Processor",myrank," left VEC_AND_DERIV"
135 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
136 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
137 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
138 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
140 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
154 c write (iout,*) "Soft-spheer ELEC potential"
155 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
158 c print *,"Processor",myrank," computed UELEC"
160 C Calculate excluded-volume interaction energy between peptide groups
165 call escp(evdw2,evdw2_14)
171 c write (iout,*) "Soft-sphere SCP potential"
172 call escp_soft_sphere(evdw2,evdw2_14)
175 c Calculate the bond-stretching energy
179 C Calculate the disulfide-bridge and other energy and the contributions
180 C from other distance constraints.
181 cd print *,'Calling EHPB'
183 cd print *,'EHPB exitted succesfully.'
185 C Calculate the virtual-bond-angle energy.
187 if (wang.gt.0d0) then
192 c print *,"Processor",myrank," computed UB"
194 C Calculate the SC local energy.
197 c print *,"Processor",myrank," computed USC"
199 C Calculate the virtual-bond torsional energy.
201 cd print *,'nterm=',nterm
203 call etor(etors,edihcnstr)
208 c print *,"Processor",myrank," computed Utor"
210 C 6/23/01 Calculate double-torsional energy
212 if (wtor_d.gt.0) then
217 c print *,"Processor",myrank," computed Utord"
219 C 21/5/07 Calculate local sicdechain correlation energy
221 if (wsccor.gt.0.0d0) then
222 call eback_sc_corr(esccor)
226 c print *,"Processor",myrank," computed Usccorr"
228 C 12/1/95 Multi-body terms
232 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
233 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
234 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
235 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
236 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
243 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
245 cd write (iout,*) "multibody_hb ecorr",ecorr
247 c print *,"Processor",myrank," computed Ucorr"
249 C If performing constraint dynamics, call the constraint energy
250 C after the equilibration time
251 if(usampl.and.totT.gt.eq_time) then
259 time_enecalc=time_enecalc+MPI_Wtime()-time00
261 c print *,"Processor",myrank," computed Uconstr"
270 energia(2)=evdw2-evdw2_14
287 energia(8)=eello_turn3
288 energia(9)=eello_turn4
295 energia(19)=edihcnstr
297 energia(20)=Uconst+Uconst_back
299 c print *," Processor",myrank," calls SUM_ENERGY"
300 call sum_energy(energia,.true.)
301 c print *," Processor",myrank," left SUM_ENERGY"
303 time_sumene=time_sumene+MPI_Wtime()-time00
307 c-------------------------------------------------------------------------------
308 subroutine sum_energy(energia,reduce)
309 implicit real*8 (a-h,o-z)
314 cMS$ATTRIBUTES C :: proc_proc
320 include 'COMMON.SETUP'
321 include 'COMMON.IOUNITS'
322 double precision energia(0:n_ene),enebuff(0:n_ene+1)
323 include 'COMMON.FFIELD'
324 include 'COMMON.DERIV'
325 include 'COMMON.INTERACT'
326 include 'COMMON.SBRIDGE'
327 include 'COMMON.CHAIN'
329 include 'COMMON.CONTROL'
330 include 'COMMON.TIME1'
333 if (nfgtasks.gt.1 .and. reduce) then
335 write (iout,*) "energies before REDUCE"
336 call enerprint(energia)
340 enebuff(i)=energia(i)
343 call MPI_Barrier(FG_COMM,IERR)
344 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
346 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
347 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
349 write (iout,*) "energies after REDUCE"
350 call enerprint(energia)
353 time_Reduce=time_Reduce+MPI_Wtime()-time00
355 if (fg_rank.eq.0) then
359 evdw2=energia(2)+energia(18)
375 eello_turn3=energia(8)
376 eello_turn4=energia(9)
383 edihcnstr=energia(19)
388 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
389 & +wang*ebe+wtor*etors+wscloc*escloc
390 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
391 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
392 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
393 & +wbond*estr+Uconst+wsccor*esccor
395 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
396 & +wang*ebe+wtor*etors+wscloc*escloc
397 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
398 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
399 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
400 & +wbond*estr+Uconst+wsccor*esccor
406 if (isnan(etot).ne.0) energia(0)=1.0d+99
408 if (isnan(etot)) energia(0)=1.0d+99
413 idumm=proc_proc(etot,i)
415 call proc_proc(etot,i)
417 if(i.eq.1)energia(0)=1.0d+99
424 c-------------------------------------------------------------------------------
425 subroutine sum_gradient
426 implicit real*8 (a-h,o-z)
431 cMS$ATTRIBUTES C :: proc_proc
436 double precision gradbufc(3,maxres),gradbufx(3,maxres),
437 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
439 include 'COMMON.SETUP'
440 include 'COMMON.IOUNITS'
441 include 'COMMON.FFIELD'
442 include 'COMMON.DERIV'
443 include 'COMMON.INTERACT'
444 include 'COMMON.SBRIDGE'
445 include 'COMMON.CHAIN'
447 include 'COMMON.CONTROL'
448 include 'COMMON.TIME1'
449 include 'COMMON.MAXGRAD'
450 include 'COMMON.SCCOR'
455 write (iout,*) "sum_gradient gvdwc, gvdwx"
457 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
458 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
463 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
464 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
465 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
468 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
469 C in virtual-bond-vector coordinates
472 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
474 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
475 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
477 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
479 c write (iout,'(i5,3f10.5,2x,f10.5)')
480 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
482 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
484 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
485 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
493 gradbufc(j,i)=wsc*gvdwc(j,i)+
494 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
495 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
496 & wel_loc*gel_loc_long(j,i)+
497 & wcorr*gradcorr_long(j,i)+
498 & wcorr5*gradcorr5_long(j,i)+
499 & wcorr6*gradcorr6_long(j,i)+
500 & wturn6*gcorr6_turn_long(j,i)+
507 gradbufc(j,i)=wsc*gvdwc(j,i)+
508 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
509 & welec*gelc_long(j,i)+
511 & wel_loc*gel_loc_long(j,i)+
512 & wcorr*gradcorr_long(j,i)+
513 & wcorr5*gradcorr5_long(j,i)+
514 & wcorr6*gradcorr6_long(j,i)+
515 & wturn6*gcorr6_turn_long(j,i)+
521 if (nfgtasks.gt.1) then
524 write (iout,*) "gradbufc before allreduce"
526 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
532 gradbufc_sum(j,i)=gradbufc(j,i)
535 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
536 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
537 c time_reduce=time_reduce+MPI_Wtime()-time00
539 c write (iout,*) "gradbufc_sum after allreduce"
541 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
546 c time_allreduce=time_allreduce+MPI_Wtime()-time00
554 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
555 write (iout,*) (i," jgrad_start",jgrad_start(i),
556 & " jgrad_end ",jgrad_end(i),
557 & i=igrad_start,igrad_end)
560 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
561 c do not parallelize this part.
563 c do i=igrad_start,igrad_end
564 c do j=jgrad_start(i),jgrad_end(i)
566 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
571 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
575 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
579 write (iout,*) "gradbufc after summing"
581 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
588 write (iout,*) "gradbufc"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
596 gradbufc_sum(j,i)=gradbufc(j,i)
601 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
605 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
610 c gradbufc(k,i)=0.0d0
614 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
619 write (iout,*) "gradbufc after summing"
621 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
629 gradbufc(k,nres)=0.0d0
634 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
635 & wel_loc*gel_loc(j,i)+
636 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
637 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
638 & wel_loc*gel_loc_long(j,i)+
639 & wcorr*gradcorr_long(j,i)+
640 & wcorr5*gradcorr5_long(j,i)+
641 & wcorr6*gradcorr6_long(j,i)+
642 & wturn6*gcorr6_turn_long(j,i))+
644 & wcorr*gradcorr(j,i)+
645 & wturn3*gcorr3_turn(j,i)+
646 & wturn4*gcorr4_turn(j,i)+
647 & wcorr5*gradcorr5(j,i)+
648 & wcorr6*gradcorr6(j,i)+
649 & wturn6*gcorr6_turn(j,i)+
650 & wsccor*gsccorc(j,i)
651 & +wscloc*gscloc(j,i)
653 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
654 & wel_loc*gel_loc(j,i)+
655 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
656 & welec*gelc_long(j,i)
657 & wel_loc*gel_loc_long(j,i)+
658 & wcorr*gcorr_long(j,i)+
659 & wcorr5*gradcorr5_long(j,i)+
660 & wcorr6*gradcorr6_long(j,i)+
661 & wturn6*gcorr6_turn_long(j,i))+
663 & wcorr*gradcorr(j,i)+
664 & wturn3*gcorr3_turn(j,i)+
665 & wturn4*gcorr4_turn(j,i)+
666 & wcorr5*gradcorr5(j,i)+
667 & wcorr6*gradcorr6(j,i)+
668 & wturn6*gcorr6_turn(j,i)+
669 & wsccor*gsccorc(j,i)
670 & +wscloc*gscloc(j,i)
672 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
674 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
675 & wsccor*gsccorx(j,i)
676 & +wscloc*gsclocx(j,i)
680 write (iout,*) "gloc before adding corr"
682 write (iout,*) i,gloc(i,icg)
686 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
687 & +wcorr5*g_corr5_loc(i)
688 & +wcorr6*g_corr6_loc(i)
689 & +wturn4*gel_loc_turn4(i)
690 & +wturn3*gel_loc_turn3(i)
691 & +wturn6*gel_loc_turn6(i)
692 & +wel_loc*gel_loc_loc(i)
695 write (iout,*) "gloc after adding corr"
697 write (iout,*) i,gloc(i,icg)
701 if (nfgtasks.gt.1) then
704 gradbufc(j,i)=gradc(j,i,icg)
705 gradbufx(j,i)=gradx(j,i,icg)
709 glocbuf(i)=gloc(i,icg)
713 write (iout,*) "gloc_sc before reduce"
716 write (iout,*) i,j,gloc_sc(j,i,icg)
723 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
727 call MPI_Barrier(FG_COMM,IERR)
728 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
730 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
731 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
732 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
734 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
736 time_reduce=time_reduce+MPI_Wtime()-time00
737 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
738 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
739 time_reduce=time_reduce+MPI_Wtime()-time00
742 write (iout,*) "gloc_sc after reduce"
745 write (iout,*) i,j,gloc_sc(j,i,icg)
751 write (iout,*) "gloc after reduce"
753 write (iout,*) i,gloc(i,icg)
758 if (gnorm_check) then
760 c Compute the maximum elements of the gradient
770 gcorr3_turn_max=0.0d0
771 gcorr4_turn_max=0.0d0
774 gcorr6_turn_max=0.0d0
784 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
785 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
786 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
787 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
788 & gvdwc_scp_max=gvdwc_scp_norm
789 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
790 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
791 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
792 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
793 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
794 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
795 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
796 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
797 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
798 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
799 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
800 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
801 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
803 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
804 & gcorr3_turn_max=gcorr3_turn_norm
805 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
807 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
808 & gcorr4_turn_max=gcorr4_turn_norm
809 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
810 if (gradcorr5_norm.gt.gradcorr5_max)
811 & gradcorr5_max=gradcorr5_norm
812 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
813 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
814 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
816 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
817 & gcorr6_turn_max=gcorr6_turn_norm
818 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
819 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
820 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
821 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
822 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
823 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
824 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
825 if (gradx_scp_norm.gt.gradx_scp_max)
826 & gradx_scp_max=gradx_scp_norm
827 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
828 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
829 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
830 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
831 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
832 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
833 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
834 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
838 open(istat,file=statname,position="append")
840 open(istat,file=statname,access="append")
842 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
843 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
844 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
845 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
846 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
847 & gsccorx_max,gsclocx_max
849 if (gvdwc_max.gt.1.0d4) then
850 write (iout,*) "gvdwc gvdwx gradb gradbx"
852 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
853 & gradb(j,i),gradbx(j,i),j=1,3)
855 call pdbout(0.0d0,'cipiszcze',iout)
861 write (iout,*) "gradc gradx gloc"
863 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
864 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
868 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
872 c-------------------------------------------------------------------------------
873 subroutine rescale_weights(t_bath)
874 implicit real*8 (a-h,o-z)
876 include 'COMMON.IOUNITS'
877 include 'COMMON.FFIELD'
878 include 'COMMON.SBRIDGE'
879 double precision kfac /2.4d0/
880 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
882 c facT=2*temp0/(t_bath+temp0)
883 if (rescale_mode.eq.0) then
889 else if (rescale_mode.eq.1) then
890 facT=kfac/(kfac-1.0d0+t_bath/temp0)
891 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
892 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
893 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
894 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
895 else if (rescale_mode.eq.2) then
901 facT=licznik/dlog(dexp(x)+dexp(-x))
902 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
903 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
904 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
905 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
907 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
908 write (*,*) "Wrong RESCALE_MODE",rescale_mode
910 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
914 welec=weights(3)*fact
915 wcorr=weights(4)*fact3
916 wcorr5=weights(5)*fact4
917 wcorr6=weights(6)*fact5
918 wel_loc=weights(7)*fact2
919 wturn3=weights(8)*fact2
920 wturn4=weights(9)*fact3
921 wturn6=weights(10)*fact5
922 wtor=weights(13)*fact
923 wtor_d=weights(14)*fact2
924 wsccor=weights(21)*fact
928 C------------------------------------------------------------------------
929 subroutine enerprint(energia)
930 implicit real*8 (a-h,o-z)
932 include 'COMMON.IOUNITS'
933 include 'COMMON.FFIELD'
934 include 'COMMON.SBRIDGE'
936 double precision energia(0:n_ene)
941 evdw2=energia(2)+energia(18)
953 eello_turn3=energia(8)
954 eello_turn4=energia(9)
955 eello_turn6=energia(10)
961 edihcnstr=energia(19)
966 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
967 & estr,wbond,ebe,wang,
968 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
970 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
971 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
974 10 format (/'Virtual-chain energies:'//
975 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
976 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
977 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
978 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
979 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
980 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
981 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
982 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
983 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
984 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
985 & ' (SS bridges & dist. cnstr.)'/
986 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
987 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
988 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
989 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
990 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
991 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
992 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
993 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
994 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
995 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
996 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
997 & 'ETOT= ',1pE16.6,' (total)')
999 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1000 & estr,wbond,ebe,wang,
1001 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1003 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1004 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1005 & ebr*nss,Uconst,etot
1006 10 format (/'Virtual-chain energies:'//
1007 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1008 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1009 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1010 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1011 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1012 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1013 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1014 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1015 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1016 & ' (SS bridges & dist. cnstr.)'/
1017 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1018 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1019 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1021 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1022 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1023 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1024 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1025 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1026 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1027 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1028 & 'ETOT= ',1pE16.6,' (total)')
1032 C-----------------------------------------------------------------------
1033 subroutine elj(evdw)
1035 C This subroutine calculates the interaction energy of nonbonded side chains
1036 C assuming the LJ potential of interaction.
1038 implicit real*8 (a-h,o-z)
1039 include 'DIMENSIONS'
1040 parameter (accur=1.0d-10)
1041 include 'COMMON.GEO'
1042 include 'COMMON.VAR'
1043 include 'COMMON.LOCAL'
1044 include 'COMMON.CHAIN'
1045 include 'COMMON.DERIV'
1046 include 'COMMON.INTERACT'
1047 include 'COMMON.TORSION'
1048 include 'COMMON.SBRIDGE'
1049 include 'COMMON.NAMES'
1050 include 'COMMON.IOUNITS'
1051 include 'COMMON.CONTACTS'
1053 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1055 do i=iatsc_s,iatsc_e
1056 itypi=iabs(itype(i))
1057 if (itypi.eq.ntyp1) cycle
1058 itypi1=iabs(itype(i+1))
1065 C Calculate SC interaction energy.
1067 do iint=1,nint_gr(i)
1068 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1069 cd & 'iend=',iend(i,iint)
1070 do j=istart(i,iint),iend(i,iint)
1071 itypj=iabs(itype(j))
1072 if (itypj.eq.ntyp1) cycle
1076 C Change 12/1/95 to calculate four-body interactions
1077 rij=xj*xj+yj*yj+zj*zj
1079 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1080 eps0ij=eps(itypi,itypj)
1082 e1=fac*fac*aa(itypi,itypj)
1083 e2=fac*bb(itypi,itypj)
1085 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1086 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1087 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1088 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1089 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1090 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1093 C Calculate the components of the gradient in DC and X
1095 fac=-rrij*(e1+evdwij)
1100 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1101 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1102 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1103 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1107 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1111 C 12/1/95, revised on 5/20/97
1113 C Calculate the contact function. The ith column of the array JCONT will
1114 C contain the numbers of atoms that make contacts with the atom I (of numbers
1115 C greater than I). The arrays FACONT and GACONT will contain the values of
1116 C the contact function and its derivative.
1118 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1119 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1120 C Uncomment next line, if the correlation interactions are contact function only
1121 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1123 sigij=sigma(itypi,itypj)
1124 r0ij=rs0(itypi,itypj)
1126 C Check whether the SC's are not too far to make a contact.
1129 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1130 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1132 if (fcont.gt.0.0D0) then
1133 C If the SC-SC distance if close to sigma, apply spline.
1134 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1135 cAdam & fcont1,fprimcont1)
1136 cAdam fcont1=1.0d0-fcont1
1137 cAdam if (fcont1.gt.0.0d0) then
1138 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1139 cAdam fcont=fcont*fcont1
1141 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1142 cga eps0ij=1.0d0/dsqrt(eps0ij)
1144 cga gg(k)=gg(k)*eps0ij
1146 cga eps0ij=-evdwij*eps0ij
1147 C Uncomment for AL's type of SC correlation interactions.
1148 cadam eps0ij=-evdwij
1149 num_conti=num_conti+1
1150 jcont(num_conti,i)=j
1151 facont(num_conti,i)=fcont*eps0ij
1152 fprimcont=eps0ij*fprimcont/rij
1154 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1155 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1156 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1157 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1158 gacont(1,num_conti,i)=-fprimcont*xj
1159 gacont(2,num_conti,i)=-fprimcont*yj
1160 gacont(3,num_conti,i)=-fprimcont*zj
1161 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1162 cd write (iout,'(2i3,3f10.5)')
1163 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1169 num_cont(i)=num_conti
1173 gvdwc(j,i)=expon*gvdwc(j,i)
1174 gvdwx(j,i)=expon*gvdwx(j,i)
1177 C******************************************************************************
1181 C To save time, the factor of EXPON has been extracted from ALL components
1182 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1185 C******************************************************************************
1188 C-----------------------------------------------------------------------------
1189 subroutine eljk(evdw)
1191 C This subroutine calculates the interaction energy of nonbonded side chains
1192 C assuming the LJK potential of interaction.
1194 implicit real*8 (a-h,o-z)
1195 include 'DIMENSIONS'
1196 include 'COMMON.GEO'
1197 include 'COMMON.VAR'
1198 include 'COMMON.LOCAL'
1199 include 'COMMON.CHAIN'
1200 include 'COMMON.DERIV'
1201 include 'COMMON.INTERACT'
1202 include 'COMMON.IOUNITS'
1203 include 'COMMON.NAMES'
1206 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1208 do i=iatsc_s,iatsc_e
1209 itypi=iabs(itype(i))
1210 if (itypi.eq.ntyp1) cycle
1211 itypi1=iabs(itype(i+1))
1216 C Calculate SC interaction energy.
1218 do iint=1,nint_gr(i)
1219 do j=istart(i,iint),iend(i,iint)
1220 itypj=iabs(itype(j))
1221 if (itypj.eq.ntyp1) cycle
1225 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1226 fac_augm=rrij**expon
1227 e_augm=augm(itypi,itypj)*fac_augm
1228 r_inv_ij=dsqrt(rrij)
1230 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1231 fac=r_shift_inv**expon
1232 e1=fac*fac*aa(itypi,itypj)
1233 e2=fac*bb(itypi,itypj)
1235 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1236 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1237 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1238 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1239 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1240 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1241 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1244 C Calculate the components of the gradient in DC and X
1246 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1251 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1252 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1253 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1254 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1258 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1266 gvdwc(j,i)=expon*gvdwc(j,i)
1267 gvdwx(j,i)=expon*gvdwx(j,i)
1272 C-----------------------------------------------------------------------------
1273 subroutine ebp(evdw)
1275 C This subroutine calculates the interaction energy of nonbonded side chains
1276 C assuming the Berne-Pechukas potential of interaction.
1278 implicit real*8 (a-h,o-z)
1279 include 'DIMENSIONS'
1280 include 'COMMON.GEO'
1281 include 'COMMON.VAR'
1282 include 'COMMON.LOCAL'
1283 include 'COMMON.CHAIN'
1284 include 'COMMON.DERIV'
1285 include 'COMMON.NAMES'
1286 include 'COMMON.INTERACT'
1287 include 'COMMON.IOUNITS'
1288 include 'COMMON.CALC'
1289 common /srutu/ icall
1290 c double precision rrsave(maxdim)
1293 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1295 c if (icall.eq.0) then
1301 do i=iatsc_s,iatsc_e
1302 itypi=iabs(itype(i))
1303 if (itypi.eq.ntyp1) cycle
1304 itypi1=iabs(itype(i+1))
1308 dxi=dc_norm(1,nres+i)
1309 dyi=dc_norm(2,nres+i)
1310 dzi=dc_norm(3,nres+i)
1311 c dsci_inv=dsc_inv(itypi)
1312 dsci_inv=vbld_inv(i+nres)
1314 C Calculate SC interaction energy.
1316 do iint=1,nint_gr(i)
1317 do j=istart(i,iint),iend(i,iint)
1319 itypj=iabs(itype(j))
1320 if (itypj.eq.ntyp1) cycle
1321 c dscj_inv=dsc_inv(itypj)
1322 dscj_inv=vbld_inv(j+nres)
1323 chi1=chi(itypi,itypj)
1324 chi2=chi(itypj,itypi)
1331 alf12=0.5D0*(alf1+alf2)
1332 C For diagnostics only!!!
1345 dxj=dc_norm(1,nres+j)
1346 dyj=dc_norm(2,nres+j)
1347 dzj=dc_norm(3,nres+j)
1348 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1349 cd if (icall.eq.0) then
1355 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1357 C Calculate whole angle-dependent part of epsilon and contributions
1358 C to its derivatives
1359 fac=(rrij*sigsq)**expon2
1360 e1=fac*fac*aa(itypi,itypj)
1361 e2=fac*bb(itypi,itypj)
1362 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1363 eps2der=evdwij*eps3rt
1364 eps3der=evdwij*eps2rt
1365 evdwij=evdwij*eps2rt*eps3rt
1368 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1369 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1370 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1371 cd & restyp(itypi),i,restyp(itypj),j,
1372 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1373 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1374 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1377 C Calculate gradient components.
1378 e1=e1*eps1*eps2rt**2*eps3rt**2
1379 fac=-expon*(e1+evdwij)
1382 C Calculate radial part of the gradient
1386 C Calculate the angular part of the gradient and sum add the contributions
1387 C to the appropriate components of the Cartesian gradient.
1395 C-----------------------------------------------------------------------------
1396 subroutine egb(evdw)
1398 C This subroutine calculates the interaction energy of nonbonded side chains
1399 C assuming the Gay-Berne potential of interaction.
1401 implicit real*8 (a-h,o-z)
1402 include 'DIMENSIONS'
1403 include 'COMMON.GEO'
1404 include 'COMMON.VAR'
1405 include 'COMMON.LOCAL'
1406 include 'COMMON.CHAIN'
1407 include 'COMMON.DERIV'
1408 include 'COMMON.NAMES'
1409 include 'COMMON.INTERACT'
1410 include 'COMMON.IOUNITS'
1411 include 'COMMON.CALC'
1412 include 'COMMON.CONTROL'
1415 ccccc energy_dec=.false.
1416 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1419 c if (icall.eq.0) lprn=.false.
1421 do i=iatsc_s,iatsc_e
1422 itypi=iabs(itype(i))
1423 if (itypi.eq.ntyp1) cycle
1424 itypi1=iabs(itype(i+1))
1428 dxi=dc_norm(1,nres+i)
1429 dyi=dc_norm(2,nres+i)
1430 dzi=dc_norm(3,nres+i)
1431 c dsci_inv=dsc_inv(itypi)
1432 dsci_inv=vbld_inv(i+nres)
1433 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1434 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1436 C Calculate SC interaction energy.
1438 do iint=1,nint_gr(i)
1439 do j=istart(i,iint),iend(i,iint)
1441 itypj=iabs(itype(j))
1442 if (itypj.eq.ntyp1) cycle
1443 c dscj_inv=dsc_inv(itypj)
1444 dscj_inv=vbld_inv(j+nres)
1445 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1446 c & 1.0d0/vbld(j+nres)
1447 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1448 sig0ij=sigma(itypi,itypj)
1449 chi1=chi(itypi,itypj)
1450 chi2=chi(itypj,itypi)
1457 alf12=0.5D0*(alf1+alf2)
1458 C For diagnostics only!!!
1471 dxj=dc_norm(1,nres+j)
1472 dyj=dc_norm(2,nres+j)
1473 dzj=dc_norm(3,nres+j)
1474 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1475 c write (iout,*) "j",j," dc_norm",
1476 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1477 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1479 C Calculate angle-dependent terms of energy and contributions to their
1483 sig=sig0ij*dsqrt(sigsq)
1484 rij_shift=1.0D0/rij-sig+sig0ij
1485 c for diagnostics; uncomment
1486 c rij_shift=1.2*sig0ij
1487 C I hate to put IF's in the loops, but here don't have another choice!!!!
1488 if (rij_shift.le.0.0D0) then
1490 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1491 cd & restyp(itypi),i,restyp(itypj),j,
1492 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1496 c---------------------------------------------------------------
1497 rij_shift=1.0D0/rij_shift
1498 fac=rij_shift**expon
1499 e1=fac*fac*aa(itypi,itypj)
1500 e2=fac*bb(itypi,itypj)
1501 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1502 eps2der=evdwij*eps3rt
1503 eps3der=evdwij*eps2rt
1504 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1505 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1506 evdwij=evdwij*eps2rt*eps3rt
1509 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1510 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1511 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1512 & restyp(itypi),i,restyp(itypj),j,
1513 & epsi,sigm,chi1,chi2,chip1,chip2,
1514 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1515 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1519 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1522 C Calculate gradient components.
1523 e1=e1*eps1*eps2rt**2*eps3rt**2
1524 fac=-expon*(e1+evdwij)*rij_shift
1528 C Calculate the radial part of the gradient
1532 C Calculate angular part of the gradient.
1537 c write (iout,*) "Number of loop steps in EGB:",ind
1538 cccc energy_dec=.false.
1541 C-----------------------------------------------------------------------------
1542 subroutine egbv(evdw)
1544 C This subroutine calculates the interaction energy of nonbonded side chains
1545 C assuming the Gay-Berne-Vorobjev potential of interaction.
1547 implicit real*8 (a-h,o-z)
1548 include 'DIMENSIONS'
1549 include 'COMMON.GEO'
1550 include 'COMMON.VAR'
1551 include 'COMMON.LOCAL'
1552 include 'COMMON.CHAIN'
1553 include 'COMMON.DERIV'
1554 include 'COMMON.NAMES'
1555 include 'COMMON.INTERACT'
1556 include 'COMMON.IOUNITS'
1557 include 'COMMON.CALC'
1558 common /srutu/ icall
1561 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1564 c if (icall.eq.0) lprn=.true.
1566 do i=iatsc_s,iatsc_e
1567 itypi=iabs(itype(i))
1568 if (itypi.eq.ntyp1) cycle
1569 itypi1=iabs(itype(i+1))
1573 dxi=dc_norm(1,nres+i)
1574 dyi=dc_norm(2,nres+i)
1575 dzi=dc_norm(3,nres+i)
1576 c dsci_inv=dsc_inv(itypi)
1577 dsci_inv=vbld_inv(i+nres)
1579 C Calculate SC interaction energy.
1581 do iint=1,nint_gr(i)
1582 do j=istart(i,iint),iend(i,iint)
1584 itypj=iabs(itype(j))
1585 if (itypj.eq.ntyp1) cycle
1586 c dscj_inv=dsc_inv(itypj)
1587 dscj_inv=vbld_inv(j+nres)
1588 sig0ij=sigma(itypi,itypj)
1589 r0ij=r0(itypi,itypj)
1590 chi1=chi(itypi,itypj)
1591 chi2=chi(itypj,itypi)
1598 alf12=0.5D0*(alf1+alf2)
1599 C For diagnostics only!!!
1612 dxj=dc_norm(1,nres+j)
1613 dyj=dc_norm(2,nres+j)
1614 dzj=dc_norm(3,nres+j)
1615 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1617 C Calculate angle-dependent terms of energy and contributions to their
1621 sig=sig0ij*dsqrt(sigsq)
1622 rij_shift=1.0D0/rij-sig+r0ij
1623 C I hate to put IF's in the loops, but here don't have another choice!!!!
1624 if (rij_shift.le.0.0D0) then
1629 c---------------------------------------------------------------
1630 rij_shift=1.0D0/rij_shift
1631 fac=rij_shift**expon
1632 e1=fac*fac*aa(itypi,itypj)
1633 e2=fac*bb(itypi,itypj)
1634 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1635 eps2der=evdwij*eps3rt
1636 eps3der=evdwij*eps2rt
1637 fac_augm=rrij**expon
1638 e_augm=augm(itypi,itypj)*fac_augm
1639 evdwij=evdwij*eps2rt*eps3rt
1640 evdw=evdw+evdwij+e_augm
1642 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1643 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1644 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1645 & restyp(itypi),i,restyp(itypj),j,
1646 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1647 & chi1,chi2,chip1,chip2,
1648 & eps1,eps2rt**2,eps3rt**2,
1649 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1652 C Calculate gradient components.
1653 e1=e1*eps1*eps2rt**2*eps3rt**2
1654 fac=-expon*(e1+evdwij)*rij_shift
1656 fac=rij*fac-2*expon*rrij*e_augm
1657 C Calculate the radial part of the gradient
1661 C Calculate angular part of the gradient.
1667 C-----------------------------------------------------------------------------
1668 subroutine sc_angular
1669 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1670 C om12. Called by ebp, egb, and egbv.
1672 include 'COMMON.CALC'
1673 include 'COMMON.IOUNITS'
1677 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1678 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1679 om12=dxi*dxj+dyi*dyj+dzi*dzj
1681 C Calculate eps1(om12) and its derivative in om12
1682 faceps1=1.0D0-om12*chiom12
1683 faceps1_inv=1.0D0/faceps1
1684 eps1=dsqrt(faceps1_inv)
1685 C Following variable is eps1*deps1/dom12
1686 eps1_om12=faceps1_inv*chiom12
1691 c write (iout,*) "om12",om12," eps1",eps1
1692 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1697 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1698 sigsq=1.0D0-facsig*faceps1_inv
1699 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1700 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1701 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1707 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1708 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1710 C Calculate eps2 and its derivatives in om1, om2, and om12.
1713 chipom12=chip12*om12
1714 facp=1.0D0-om12*chipom12
1716 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1717 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1718 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1719 C Following variable is the square root of eps2
1720 eps2rt=1.0D0-facp1*facp_inv
1721 C Following three variables are the derivatives of the square root of eps
1722 C in om1, om2, and om12.
1723 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1724 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1725 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1726 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1727 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1728 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1729 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1730 c & " eps2rt_om12",eps2rt_om12
1731 C Calculate whole angle-dependent part of epsilon and contributions
1732 C to its derivatives
1735 C----------------------------------------------------------------------------
1737 implicit real*8 (a-h,o-z)
1738 include 'DIMENSIONS'
1739 include 'COMMON.CHAIN'
1740 include 'COMMON.DERIV'
1741 include 'COMMON.CALC'
1742 include 'COMMON.IOUNITS'
1743 double precision dcosom1(3),dcosom2(3)
1744 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1745 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1746 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1747 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1751 c eom12=evdwij*eps1_om12
1753 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1754 c & " sigder",sigder
1755 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1756 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1758 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1759 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1762 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1764 c write (iout,*) "gg",(gg(k),k=1,3)
1766 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1767 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1768 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1769 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1770 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1771 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1772 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1773 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1774 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1775 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1778 C Calculate the components of the gradient in DC and X
1782 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1786 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1787 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1791 C-----------------------------------------------------------------------
1792 subroutine e_softsphere(evdw)
1794 C This subroutine calculates the interaction energy of nonbonded side chains
1795 C assuming the LJ potential of interaction.
1797 implicit real*8 (a-h,o-z)
1798 include 'DIMENSIONS'
1799 parameter (accur=1.0d-10)
1800 include 'COMMON.GEO'
1801 include 'COMMON.VAR'
1802 include 'COMMON.LOCAL'
1803 include 'COMMON.CHAIN'
1804 include 'COMMON.DERIV'
1805 include 'COMMON.INTERACT'
1806 include 'COMMON.TORSION'
1807 include 'COMMON.SBRIDGE'
1808 include 'COMMON.NAMES'
1809 include 'COMMON.IOUNITS'
1810 include 'COMMON.CONTACTS'
1812 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1814 do i=iatsc_s,iatsc_e
1815 itypi=iabs(itype(i))
1816 if (itypi.eq.ntyp1) cycle
1817 itypi1=iabs(itype(i+1))
1822 C Calculate SC interaction energy.
1824 do iint=1,nint_gr(i)
1825 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1826 cd & 'iend=',iend(i,iint)
1827 do j=istart(i,iint),iend(i,iint)
1828 itypj=iabs(itype(j))
1829 if (itypj.eq.ntyp1) cycle
1833 rij=xj*xj+yj*yj+zj*zj
1834 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1835 r0ij=r0(itypi,itypj)
1837 c print *,i,j,r0ij,dsqrt(rij)
1838 if (rij.lt.r0ijsq) then
1839 evdwij=0.25d0*(rij-r0ijsq)**2
1847 C Calculate the components of the gradient in DC and X
1853 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1854 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1855 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1856 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1860 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1868 C--------------------------------------------------------------------------
1869 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1872 C Soft-sphere potential of p-p interaction
1874 implicit real*8 (a-h,o-z)
1875 include 'DIMENSIONS'
1876 include 'COMMON.CONTROL'
1877 include 'COMMON.IOUNITS'
1878 include 'COMMON.GEO'
1879 include 'COMMON.VAR'
1880 include 'COMMON.LOCAL'
1881 include 'COMMON.CHAIN'
1882 include 'COMMON.DERIV'
1883 include 'COMMON.INTERACT'
1884 include 'COMMON.CONTACTS'
1885 include 'COMMON.TORSION'
1886 include 'COMMON.VECTORS'
1887 include 'COMMON.FFIELD'
1889 cd write(iout,*) 'In EELEC_soft_sphere'
1896 do i=iatel_s,iatel_e
1897 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1901 xmedi=c(1,i)+0.5d0*dxi
1902 ymedi=c(2,i)+0.5d0*dyi
1903 zmedi=c(3,i)+0.5d0*dzi
1905 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1906 do j=ielstart(i),ielend(i)
1907 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1911 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1912 r0ij=rpp(iteli,itelj)
1917 xj=c(1,j)+0.5D0*dxj-xmedi
1918 yj=c(2,j)+0.5D0*dyj-ymedi
1919 zj=c(3,j)+0.5D0*dzj-zmedi
1920 rij=xj*xj+yj*yj+zj*zj
1921 if (rij.lt.r0ijsq) then
1922 evdw1ij=0.25d0*(rij-r0ijsq)**2
1930 C Calculate contributions to the Cartesian gradient.
1936 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1937 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1940 * Loop over residues i+1 thru j-1.
1944 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1949 cgrad do i=nnt,nct-1
1951 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1953 cgrad do j=i+1,nct-1
1955 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1961 c------------------------------------------------------------------------------
1962 subroutine vec_and_deriv
1963 implicit real*8 (a-h,o-z)
1964 include 'DIMENSIONS'
1968 include 'COMMON.IOUNITS'
1969 include 'COMMON.GEO'
1970 include 'COMMON.VAR'
1971 include 'COMMON.LOCAL'
1972 include 'COMMON.CHAIN'
1973 include 'COMMON.VECTORS'
1974 include 'COMMON.SETUP'
1975 include 'COMMON.TIME1'
1976 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1977 C Compute the local reference systems. For reference system (i), the
1978 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1979 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1981 do i=ivec_start,ivec_end
1985 if (i.eq.nres-1) then
1986 C Case of the last full residue
1987 C Compute the Z-axis
1988 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1989 costh=dcos(pi-theta(nres))
1990 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1994 C Compute the derivatives of uz
1996 uzder(2,1,1)=-dc_norm(3,i-1)
1997 uzder(3,1,1)= dc_norm(2,i-1)
1998 uzder(1,2,1)= dc_norm(3,i-1)
2000 uzder(3,2,1)=-dc_norm(1,i-1)
2001 uzder(1,3,1)=-dc_norm(2,i-1)
2002 uzder(2,3,1)= dc_norm(1,i-1)
2005 uzder(2,1,2)= dc_norm(3,i)
2006 uzder(3,1,2)=-dc_norm(2,i)
2007 uzder(1,2,2)=-dc_norm(3,i)
2009 uzder(3,2,2)= dc_norm(1,i)
2010 uzder(1,3,2)= dc_norm(2,i)
2011 uzder(2,3,2)=-dc_norm(1,i)
2013 C Compute the Y-axis
2016 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2018 C Compute the derivatives of uy
2021 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2022 & -dc_norm(k,i)*dc_norm(j,i-1)
2023 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2025 uyder(j,j,1)=uyder(j,j,1)-costh
2026 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2031 uygrad(l,k,j,i)=uyder(l,k,j)
2032 uzgrad(l,k,j,i)=uzder(l,k,j)
2036 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2037 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2038 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2039 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2042 C Compute the Z-axis
2043 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2044 costh=dcos(pi-theta(i+2))
2045 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2049 C Compute the derivatives of uz
2051 uzder(2,1,1)=-dc_norm(3,i+1)
2052 uzder(3,1,1)= dc_norm(2,i+1)
2053 uzder(1,2,1)= dc_norm(3,i+1)
2055 uzder(3,2,1)=-dc_norm(1,i+1)
2056 uzder(1,3,1)=-dc_norm(2,i+1)
2057 uzder(2,3,1)= dc_norm(1,i+1)
2060 uzder(2,1,2)= dc_norm(3,i)
2061 uzder(3,1,2)=-dc_norm(2,i)
2062 uzder(1,2,2)=-dc_norm(3,i)
2064 uzder(3,2,2)= dc_norm(1,i)
2065 uzder(1,3,2)= dc_norm(2,i)
2066 uzder(2,3,2)=-dc_norm(1,i)
2068 C Compute the Y-axis
2071 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2073 C Compute the derivatives of uy
2076 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2077 & -dc_norm(k,i)*dc_norm(j,i+1)
2078 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2080 uyder(j,j,1)=uyder(j,j,1)-costh
2081 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2086 uygrad(l,k,j,i)=uyder(l,k,j)
2087 uzgrad(l,k,j,i)=uzder(l,k,j)
2091 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2092 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2093 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2094 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2098 vbld_inv_temp(1)=vbld_inv(i+1)
2099 if (i.lt.nres-1) then
2100 vbld_inv_temp(2)=vbld_inv(i+2)
2102 vbld_inv_temp(2)=vbld_inv(i)
2107 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2108 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2113 #if defined(PARVEC) && defined(MPI)
2114 if (nfgtasks1.gt.1) then
2116 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2117 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2118 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2119 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2120 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2122 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2123 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2125 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2126 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2127 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2128 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2129 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2130 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2131 time_gather=time_gather+MPI_Wtime()-time00
2133 c if (fg_rank.eq.0) then
2134 c write (iout,*) "Arrays UY and UZ"
2136 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2143 C-----------------------------------------------------------------------------
2144 subroutine check_vecgrad
2145 implicit real*8 (a-h,o-z)
2146 include 'DIMENSIONS'
2147 include 'COMMON.IOUNITS'
2148 include 'COMMON.GEO'
2149 include 'COMMON.VAR'
2150 include 'COMMON.LOCAL'
2151 include 'COMMON.CHAIN'
2152 include 'COMMON.VECTORS'
2153 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2154 dimension uyt(3,maxres),uzt(3,maxres)
2155 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2156 double precision delta /1.0d-7/
2159 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2160 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2161 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2162 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2163 cd & (dc_norm(if90,i),if90=1,3)
2164 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2165 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2166 cd write(iout,'(a)')
2172 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2173 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2186 cd write (iout,*) 'i=',i
2188 erij(k)=dc_norm(k,i)
2192 dc_norm(k,i)=erij(k)
2194 dc_norm(j,i)=dc_norm(j,i)+delta
2195 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2197 c dc_norm(k,i)=dc_norm(k,i)/fac
2199 c write (iout,*) (dc_norm(k,i),k=1,3)
2200 c write (iout,*) (erij(k),k=1,3)
2203 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2204 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2205 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2206 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2208 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2209 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2210 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2213 dc_norm(k,i)=erij(k)
2216 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2217 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2218 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2219 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2220 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2221 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2222 cd write (iout,'(a)')
2227 C--------------------------------------------------------------------------
2228 subroutine set_matrices
2229 implicit real*8 (a-h,o-z)
2230 include 'DIMENSIONS'
2233 include "COMMON.SETUP"
2235 integer status(MPI_STATUS_SIZE)
2237 include 'COMMON.IOUNITS'
2238 include 'COMMON.GEO'
2239 include 'COMMON.VAR'
2240 include 'COMMON.LOCAL'
2241 include 'COMMON.CHAIN'
2242 include 'COMMON.DERIV'
2243 include 'COMMON.INTERACT'
2244 include 'COMMON.CONTACTS'
2245 include 'COMMON.TORSION'
2246 include 'COMMON.VECTORS'
2247 include 'COMMON.FFIELD'
2248 double precision auxvec(2),auxmat(2,2)
2250 C Compute the virtual-bond-torsional-angle dependent quantities needed
2251 C to calculate the el-loc multibody terms of various order.
2254 do i=ivec_start+2,ivec_end+2
2258 if (i .lt. nres+1) then
2295 if (i .gt. 3 .and. i .lt. nres+1) then
2296 obrot_der(1,i-2)=-sin1
2297 obrot_der(2,i-2)= cos1
2298 Ugder(1,1,i-2)= sin1
2299 Ugder(1,2,i-2)=-cos1
2300 Ugder(2,1,i-2)=-cos1
2301 Ugder(2,2,i-2)=-sin1
2304 obrot2_der(1,i-2)=-dwasin2
2305 obrot2_der(2,i-2)= dwacos2
2306 Ug2der(1,1,i-2)= dwasin2
2307 Ug2der(1,2,i-2)=-dwacos2
2308 Ug2der(2,1,i-2)=-dwacos2
2309 Ug2der(2,2,i-2)=-dwasin2
2311 obrot_der(1,i-2)=0.0d0
2312 obrot_der(2,i-2)=0.0d0
2313 Ugder(1,1,i-2)=0.0d0
2314 Ugder(1,2,i-2)=0.0d0
2315 Ugder(2,1,i-2)=0.0d0
2316 Ugder(2,2,i-2)=0.0d0
2317 obrot2_der(1,i-2)=0.0d0
2318 obrot2_der(2,i-2)=0.0d0
2319 Ug2der(1,1,i-2)=0.0d0
2320 Ug2der(1,2,i-2)=0.0d0
2321 Ug2der(2,1,i-2)=0.0d0
2322 Ug2der(2,2,i-2)=0.0d0
2324 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2325 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2326 iti = itortyp(itype(i-2))
2330 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2331 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2332 iti1 = itortyp(itype(i-1))
2336 cd write (iout,*) '*******i',i,' iti1',iti
2337 cd write (iout,*) 'b1',b1(:,iti)
2338 cd write (iout,*) 'b2',b2(:,iti)
2339 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2340 c if (i .gt. iatel_s+2) then
2341 if (i .gt. nnt+2) then
2342 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2343 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2344 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2346 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2347 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2348 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2349 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2350 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2361 DtUg2(l,k,i-2)=0.0d0
2365 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2366 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2368 muder(k,i-2)=Ub2der(k,i-2)
2370 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2371 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2372 iti1 = itortyp(itype(i-1))
2377 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2379 cd write (iout,*) 'mu ',mu(:,i-2)
2380 cd write (iout,*) 'mu1',mu1(:,i-2)
2381 cd write (iout,*) 'mu2',mu2(:,i-2)
2382 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2384 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2385 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2386 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2387 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2388 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2389 C Vectors and matrices dependent on a single virtual-bond dihedral.
2390 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2391 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2392 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2393 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2394 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2395 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2396 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2397 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2398 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2401 C Matrices dependent on two consecutive virtual-bond dihedrals.
2402 C The order of matrices is from left to right.
2403 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2405 c do i=max0(ivec_start,2),ivec_end
2407 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2408 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2409 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2410 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2411 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2412 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2413 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2414 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2417 #if defined(MPI) && defined(PARMAT)
2419 c if (fg_rank.eq.0) then
2420 write (iout,*) "Arrays UG and UGDER before GATHER"
2422 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2423 & ((ug(l,k,i),l=1,2),k=1,2),
2424 & ((ugder(l,k,i),l=1,2),k=1,2)
2426 write (iout,*) "Arrays UG2 and UG2DER"
2428 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2429 & ((ug2(l,k,i),l=1,2),k=1,2),
2430 & ((ug2der(l,k,i),l=1,2),k=1,2)
2432 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2434 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2435 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2436 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2438 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2440 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2441 & costab(i),sintab(i),costab2(i),sintab2(i)
2443 write (iout,*) "Array MUDER"
2445 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2449 if (nfgtasks.gt.1) then
2451 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2452 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2453 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2455 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2456 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2458 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2459 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2461 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2462 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2464 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2465 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2467 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2468 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2470 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2471 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2473 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2474 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2475 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2476 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2477 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2478 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2479 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2480 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2481 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2482 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2483 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2484 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2485 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2487 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2488 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2490 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2491 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2493 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2494 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2496 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2497 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2499 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2500 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2502 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2503 & ivec_count(fg_rank1),
2504 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2506 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2509 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2510 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2512 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2515 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2516 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2518 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2519 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2521 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2524 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2527 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2528 & ivec_count(fg_rank1),
2529 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2531 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2532 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2534 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2535 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2537 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2538 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2540 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2543 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2544 & ivec_count(fg_rank1),
2545 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2547 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2548 & ivec_count(fg_rank1),
2549 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2551 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2552 & ivec_count(fg_rank1),
2553 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2554 & MPI_MAT2,FG_COMM1,IERR)
2555 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2556 & ivec_count(fg_rank1),
2557 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2558 & MPI_MAT2,FG_COMM1,IERR)
2561 c Passes matrix info through the ring
2564 if (irecv.lt.0) irecv=nfgtasks1-1
2567 if (inext.ge.nfgtasks1) inext=0
2569 c write (iout,*) "isend",isend," irecv",irecv
2571 lensend=lentyp(isend)
2572 lenrecv=lentyp(irecv)
2573 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2574 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2575 c & MPI_ROTAT1(lensend),inext,2200+isend,
2576 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2577 c & iprev,2200+irecv,FG_COMM,status,IERR)
2578 c write (iout,*) "Gather ROTAT1"
2580 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2581 c & MPI_ROTAT2(lensend),inext,3300+isend,
2582 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2583 c & iprev,3300+irecv,FG_COMM,status,IERR)
2584 c write (iout,*) "Gather ROTAT2"
2586 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2587 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2588 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2589 & iprev,4400+irecv,FG_COMM,status,IERR)
2590 c write (iout,*) "Gather ROTAT_OLD"
2592 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2593 & MPI_PRECOMP11(lensend),inext,5500+isend,
2594 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2595 & iprev,5500+irecv,FG_COMM,status,IERR)
2596 c write (iout,*) "Gather PRECOMP11"
2598 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2599 & MPI_PRECOMP12(lensend),inext,6600+isend,
2600 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2601 & iprev,6600+irecv,FG_COMM,status,IERR)
2602 c write (iout,*) "Gather PRECOMP12"
2604 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2606 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2607 & MPI_ROTAT2(lensend),inext,7700+isend,
2608 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2609 & iprev,7700+irecv,FG_COMM,status,IERR)
2610 c write (iout,*) "Gather PRECOMP21"
2612 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2613 & MPI_PRECOMP22(lensend),inext,8800+isend,
2614 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2615 & iprev,8800+irecv,FG_COMM,status,IERR)
2616 c write (iout,*) "Gather PRECOMP22"
2618 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2619 & MPI_PRECOMP23(lensend),inext,9900+isend,
2620 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2621 & MPI_PRECOMP23(lenrecv),
2622 & iprev,9900+irecv,FG_COMM,status,IERR)
2623 c write (iout,*) "Gather PRECOMP23"
2628 if (irecv.lt.0) irecv=nfgtasks1-1
2631 time_gather=time_gather+MPI_Wtime()-time00
2634 c if (fg_rank.eq.0) then
2635 write (iout,*) "Arrays UG and UGDER"
2637 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2638 & ((ug(l,k,i),l=1,2),k=1,2),
2639 & ((ugder(l,k,i),l=1,2),k=1,2)
2641 write (iout,*) "Arrays UG2 and UG2DER"
2643 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2644 & ((ug2(l,k,i),l=1,2),k=1,2),
2645 & ((ug2der(l,k,i),l=1,2),k=1,2)
2647 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2649 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2650 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2651 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2653 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2655 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2656 & costab(i),sintab(i),costab2(i),sintab2(i)
2658 write (iout,*) "Array MUDER"
2660 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2666 cd iti = itortyp(itype(i))
2669 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2670 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2675 C--------------------------------------------------------------------------
2676 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2678 C This subroutine calculates the average interaction energy and its gradient
2679 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2680 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2681 C The potential depends both on the distance of peptide-group centers and on
2682 C the orientation of the CA-CA virtual bonds.
2684 implicit real*8 (a-h,o-z)
2688 include 'DIMENSIONS'
2689 include 'COMMON.CONTROL'
2690 include 'COMMON.SETUP'
2691 include 'COMMON.IOUNITS'
2692 include 'COMMON.GEO'
2693 include 'COMMON.VAR'
2694 include 'COMMON.LOCAL'
2695 include 'COMMON.CHAIN'
2696 include 'COMMON.DERIV'
2697 include 'COMMON.INTERACT'
2698 include 'COMMON.CONTACTS'
2699 include 'COMMON.TORSION'
2700 include 'COMMON.VECTORS'
2701 include 'COMMON.FFIELD'
2702 include 'COMMON.TIME1'
2703 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2704 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2705 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2706 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2707 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2708 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2710 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2712 double precision scal_el /1.0d0/
2714 double precision scal_el /0.5d0/
2717 C 13-go grudnia roku pamietnego...
2718 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2719 & 0.0d0,1.0d0,0.0d0,
2720 & 0.0d0,0.0d0,1.0d0/
2721 cd write(iout,*) 'In EELEC'
2723 cd write(iout,*) 'Type',i
2724 cd write(iout,*) 'B1',B1(:,i)
2725 cd write(iout,*) 'B2',B2(:,i)
2726 cd write(iout,*) 'CC',CC(:,:,i)
2727 cd write(iout,*) 'DD',DD(:,:,i)
2728 cd write(iout,*) 'EE',EE(:,:,i)
2730 cd call check_vecgrad
2732 if (icheckgrad.eq.1) then
2734 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2736 dc_norm(k,i)=dc(k,i)*fac
2738 c write (iout,*) 'i',i,' fac',fac
2741 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2742 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2743 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2744 c call vec_and_deriv
2750 time_mat=time_mat+MPI_Wtime()-time01
2754 cd write (iout,*) 'i=',i
2756 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2759 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2760 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2773 cd print '(a)','Enter EELEC'
2774 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2776 gel_loc_loc(i)=0.0d0
2781 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2783 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2785 do i=iturn3_start,iturn3_end
2786 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2787 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2791 dx_normi=dc_norm(1,i)
2792 dy_normi=dc_norm(2,i)
2793 dz_normi=dc_norm(3,i)
2794 xmedi=c(1,i)+0.5d0*dxi
2795 ymedi=c(2,i)+0.5d0*dyi
2796 zmedi=c(3,i)+0.5d0*dzi
2798 call eelecij(i,i+2,ees,evdw1,eel_loc)
2799 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2800 num_cont_hb(i)=num_conti
2802 do i=iturn4_start,iturn4_end
2803 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2804 & .or. itype(i+3).eq.ntyp1
2805 & .or. itype(i+4).eq.ntyp1) cycle
2809 dx_normi=dc_norm(1,i)
2810 dy_normi=dc_norm(2,i)
2811 dz_normi=dc_norm(3,i)
2812 xmedi=c(1,i)+0.5d0*dxi
2813 ymedi=c(2,i)+0.5d0*dyi
2814 zmedi=c(3,i)+0.5d0*dzi
2815 num_conti=num_cont_hb(i)
2816 call eelecij(i,i+3,ees,evdw1,eel_loc)
2817 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2818 & call eturn4(i,eello_turn4)
2819 num_cont_hb(i)=num_conti
2822 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2824 do i=iatel_s,iatel_e
2825 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2829 dx_normi=dc_norm(1,i)
2830 dy_normi=dc_norm(2,i)
2831 dz_normi=dc_norm(3,i)
2832 xmedi=c(1,i)+0.5d0*dxi
2833 ymedi=c(2,i)+0.5d0*dyi
2834 zmedi=c(3,i)+0.5d0*dzi
2835 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2836 num_conti=num_cont_hb(i)
2837 do j=ielstart(i),ielend(i)
2838 c write (iout,*) i,j,itype(i),itype(j)
2839 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2840 call eelecij(i,j,ees,evdw1,eel_loc)
2842 num_cont_hb(i)=num_conti
2844 c write (iout,*) "Number of loop steps in EELEC:",ind
2846 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2847 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2849 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2850 ccc eel_loc=eel_loc+eello_turn3
2851 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2854 C-------------------------------------------------------------------------------
2855 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2856 implicit real*8 (a-h,o-z)
2857 include 'DIMENSIONS'
2861 include 'COMMON.CONTROL'
2862 include 'COMMON.IOUNITS'
2863 include 'COMMON.GEO'
2864 include 'COMMON.VAR'
2865 include 'COMMON.LOCAL'
2866 include 'COMMON.CHAIN'
2867 include 'COMMON.DERIV'
2868 include 'COMMON.INTERACT'
2869 include 'COMMON.CONTACTS'
2870 include 'COMMON.TORSION'
2871 include 'COMMON.VECTORS'
2872 include 'COMMON.FFIELD'
2873 include 'COMMON.TIME1'
2874 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2875 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2876 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2877 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2878 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2879 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2881 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2883 double precision scal_el /1.0d0/
2885 double precision scal_el /0.5d0/
2888 C 13-go grudnia roku pamietnego...
2889 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2890 & 0.0d0,1.0d0,0.0d0,
2891 & 0.0d0,0.0d0,1.0d0/
2892 c time00=MPI_Wtime()
2893 cd write (iout,*) "eelecij",i,j
2897 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2898 aaa=app(iteli,itelj)
2899 bbb=bpp(iteli,itelj)
2900 ael6i=ael6(iteli,itelj)
2901 ael3i=ael3(iteli,itelj)
2905 dx_normj=dc_norm(1,j)
2906 dy_normj=dc_norm(2,j)
2907 dz_normj=dc_norm(3,j)
2908 xj=c(1,j)+0.5D0*dxj-xmedi
2909 yj=c(2,j)+0.5D0*dyj-ymedi
2910 zj=c(3,j)+0.5D0*dzj-zmedi
2911 rij=xj*xj+yj*yj+zj*zj
2917 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2918 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2919 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2920 fac=cosa-3.0D0*cosb*cosg
2922 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2923 if (j.eq.i+2) ev1=scal_el*ev1
2928 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2931 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2932 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2935 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2936 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2937 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2938 cd & xmedi,ymedi,zmedi,xj,yj,zj
2940 if (energy_dec) then
2941 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2942 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2946 C Calculate contributions to the Cartesian gradient.
2949 facvdw=-6*rrmij*(ev1+evdwij)
2950 facel=-3*rrmij*(el1+eesij)
2956 * Radial derivatives. First process both termini of the fragment (i,j)
2962 c ghalf=0.5D0*ggg(k)
2963 c gelc(k,i)=gelc(k,i)+ghalf
2964 c gelc(k,j)=gelc(k,j)+ghalf
2966 c 9/28/08 AL Gradient compotents will be summed only at the end
2968 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2969 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2972 * Loop over residues i+1 thru j-1.
2976 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2983 c ghalf=0.5D0*ggg(k)
2984 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2985 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2987 c 9/28/08 AL Gradient compotents will be summed only at the end
2989 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2990 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2993 * Loop over residues i+1 thru j-1.
2997 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3004 fac=-3*rrmij*(facvdw+facvdw+facel)
3009 * Radial derivatives. First process both termini of the fragment (i,j)
3015 c ghalf=0.5D0*ggg(k)
3016 c gelc(k,i)=gelc(k,i)+ghalf
3017 c gelc(k,j)=gelc(k,j)+ghalf
3019 c 9/28/08 AL Gradient compotents will be summed only at the end
3021 gelc_long(k,j)=gelc(k,j)+ggg(k)
3022 gelc_long(k,i)=gelc(k,i)-ggg(k)
3025 * Loop over residues i+1 thru j-1.
3029 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3032 c 9/28/08 AL Gradient compotents will be summed only at the end
3037 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3038 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3044 ecosa=2.0D0*fac3*fac1+fac4
3047 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3048 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3050 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3051 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3053 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3054 cd & (dcosg(k),k=1,3)
3056 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3059 c ghalf=0.5D0*ggg(k)
3060 c gelc(k,i)=gelc(k,i)+ghalf
3061 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3062 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3063 c gelc(k,j)=gelc(k,j)+ghalf
3064 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3065 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3069 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3074 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3075 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3077 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3078 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3079 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3080 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3082 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3083 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3084 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3086 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3087 C energy of a peptide unit is assumed in the form of a second-order
3088 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3089 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3090 C are computed for EVERY pair of non-contiguous peptide groups.
3092 if (j.lt.nres-1) then
3103 muij(kkk)=mu(k,i)*mu(l,j)
3106 cd write (iout,*) 'EELEC: i',i,' j',j
3107 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3108 cd write(iout,*) 'muij',muij
3109 ury=scalar(uy(1,i),erij)
3110 urz=scalar(uz(1,i),erij)
3111 vry=scalar(uy(1,j),erij)
3112 vrz=scalar(uz(1,j),erij)
3113 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3114 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3115 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3116 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3117 fac=dsqrt(-ael6i)*r3ij
3122 cd write (iout,'(4i5,4f10.5)')
3123 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3124 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3125 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3126 cd & uy(:,j),uz(:,j)
3127 cd write (iout,'(4f10.5)')
3128 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3129 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3130 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3131 cd write (iout,'(9f10.5/)')
3132 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3133 C Derivatives of the elements of A in virtual-bond vectors
3134 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3136 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3137 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3138 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3139 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3140 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3141 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3142 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3143 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3144 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3145 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3146 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3147 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3149 C Compute radial contributions to the gradient
3167 C Add the contributions coming from er
3170 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3171 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3172 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3173 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3176 C Derivatives in DC(i)
3177 cgrad ghalf1=0.5d0*agg(k,1)
3178 cgrad ghalf2=0.5d0*agg(k,2)
3179 cgrad ghalf3=0.5d0*agg(k,3)
3180 cgrad ghalf4=0.5d0*agg(k,4)
3181 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3182 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3183 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3184 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3185 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3186 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3187 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3188 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3189 C Derivatives in DC(i+1)
3190 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3191 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3192 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3193 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3194 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3195 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3196 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3197 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3198 C Derivatives in DC(j)
3199 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3200 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3201 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3202 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3203 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3204 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3205 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3206 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3207 C Derivatives in DC(j+1) or DC(nres-1)
3208 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3209 & -3.0d0*vryg(k,3)*ury)
3210 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3211 & -3.0d0*vrzg(k,3)*ury)
3212 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3213 & -3.0d0*vryg(k,3)*urz)
3214 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3215 & -3.0d0*vrzg(k,3)*urz)
3216 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3218 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3231 aggi(k,l)=-aggi(k,l)
3232 aggi1(k,l)=-aggi1(k,l)
3233 aggj(k,l)=-aggj(k,l)
3234 aggj1(k,l)=-aggj1(k,l)
3237 if (j.lt.nres-1) then
3243 aggi(k,l)=-aggi(k,l)
3244 aggi1(k,l)=-aggi1(k,l)
3245 aggj(k,l)=-aggj(k,l)
3246 aggj1(k,l)=-aggj1(k,l)
3257 aggi(k,l)=-aggi(k,l)
3258 aggi1(k,l)=-aggi1(k,l)
3259 aggj(k,l)=-aggj(k,l)
3260 aggj1(k,l)=-aggj1(k,l)
3265 IF (wel_loc.gt.0.0d0) THEN
3266 C Contribution to the local-electrostatic energy coming from the i-j pair
3267 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3269 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3271 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3272 & 'eelloc',i,j,eel_loc_ij
3274 eel_loc=eel_loc+eel_loc_ij
3275 C Partial derivatives in virtual-bond dihedral angles gamma
3277 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3278 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3279 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3280 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3281 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3282 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3283 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3285 ggg(l)=agg(l,1)*muij(1)+
3286 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3287 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3288 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3289 cgrad ghalf=0.5d0*ggg(l)
3290 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3291 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3295 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3298 C Remaining derivatives of eello
3300 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3301 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3302 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3303 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3304 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3305 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3306 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3307 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3310 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3311 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3312 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3313 & .and. num_conti.le.maxconts) then
3314 c write (iout,*) i,j," entered corr"
3316 C Calculate the contact function. The ith column of the array JCONT will
3317 C contain the numbers of atoms that make contacts with the atom I (of numbers
3318 C greater than I). The arrays FACONT and GACONT will contain the values of
3319 C the contact function and its derivative.
3320 c r0ij=1.02D0*rpp(iteli,itelj)
3321 c r0ij=1.11D0*rpp(iteli,itelj)
3322 r0ij=2.20D0*rpp(iteli,itelj)
3323 c r0ij=1.55D0*rpp(iteli,itelj)
3324 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3325 if (fcont.gt.0.0D0) then
3326 num_conti=num_conti+1
3327 if (num_conti.gt.maxconts) then
3328 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3329 & ' will skip next contacts for this conf.'
3331 jcont_hb(num_conti,i)=j
3332 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3333 cd & " jcont_hb",jcont_hb(num_conti,i)
3334 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3335 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3336 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3338 d_cont(num_conti,i)=rij
3339 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3340 C --- Electrostatic-interaction matrix ---
3341 a_chuj(1,1,num_conti,i)=a22
3342 a_chuj(1,2,num_conti,i)=a23
3343 a_chuj(2,1,num_conti,i)=a32
3344 a_chuj(2,2,num_conti,i)=a33
3345 C --- Gradient of rij
3347 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3354 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3355 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3356 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3357 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3358 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3363 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3364 C Calculate contact energies
3366 wij=cosa-3.0D0*cosb*cosg
3369 c fac3=dsqrt(-ael6i)/r0ij**3
3370 fac3=dsqrt(-ael6i)*r3ij
3371 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3372 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3373 if (ees0tmp.gt.0) then
3374 ees0pij=dsqrt(ees0tmp)
3378 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3379 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3380 if (ees0tmp.gt.0) then
3381 ees0mij=dsqrt(ees0tmp)
3386 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3387 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3388 C Diagnostics. Comment out or remove after debugging!
3389 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3390 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3391 c ees0m(num_conti,i)=0.0D0
3393 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3394 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3395 C Angular derivatives of the contact function
3396 ees0pij1=fac3/ees0pij
3397 ees0mij1=fac3/ees0mij
3398 fac3p=-3.0D0*fac3*rrmij
3399 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3400 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3402 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3403 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3404 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3405 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3406 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3407 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3408 ecosap=ecosa1+ecosa2
3409 ecosbp=ecosb1+ecosb2
3410 ecosgp=ecosg1+ecosg2
3411 ecosam=ecosa1-ecosa2
3412 ecosbm=ecosb1-ecosb2
3413 ecosgm=ecosg1-ecosg2
3422 facont_hb(num_conti,i)=fcont
3423 fprimcont=fprimcont/rij
3424 cd facont_hb(num_conti,i)=1.0D0
3425 C Following line is for diagnostics.
3428 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3429 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3432 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3433 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3435 gggp(1)=gggp(1)+ees0pijp*xj
3436 gggp(2)=gggp(2)+ees0pijp*yj
3437 gggp(3)=gggp(3)+ees0pijp*zj
3438 gggm(1)=gggm(1)+ees0mijp*xj
3439 gggm(2)=gggm(2)+ees0mijp*yj
3440 gggm(3)=gggm(3)+ees0mijp*zj
3441 C Derivatives due to the contact function
3442 gacont_hbr(1,num_conti,i)=fprimcont*xj
3443 gacont_hbr(2,num_conti,i)=fprimcont*yj
3444 gacont_hbr(3,num_conti,i)=fprimcont*zj
3447 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3448 c following the change of gradient-summation algorithm.
3450 cgrad ghalfp=0.5D0*gggp(k)
3451 cgrad ghalfm=0.5D0*gggm(k)
3452 gacontp_hb1(k,num_conti,i)=!ghalfp
3453 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3454 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3455 gacontp_hb2(k,num_conti,i)=!ghalfp
3456 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3457 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3458 gacontp_hb3(k,num_conti,i)=gggp(k)
3459 gacontm_hb1(k,num_conti,i)=!ghalfm
3460 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3461 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3462 gacontm_hb2(k,num_conti,i)=!ghalfm
3463 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3464 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3465 gacontm_hb3(k,num_conti,i)=gggm(k)
3467 C Diagnostics. Comment out or remove after debugging!
3469 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3470 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3471 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3472 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3473 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3474 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3477 endif ! num_conti.le.maxconts
3480 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3483 ghalf=0.5d0*agg(l,k)
3484 aggi(l,k)=aggi(l,k)+ghalf
3485 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3486 aggj(l,k)=aggj(l,k)+ghalf
3489 if (j.eq.nres-1 .and. i.lt.j-2) then
3492 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3497 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3500 C-----------------------------------------------------------------------------
3501 subroutine eturn3(i,eello_turn3)
3502 C Third- and fourth-order contributions from turns
3503 implicit real*8 (a-h,o-z)
3504 include 'DIMENSIONS'
3505 include 'COMMON.IOUNITS'
3506 include 'COMMON.GEO'
3507 include 'COMMON.VAR'
3508 include 'COMMON.LOCAL'
3509 include 'COMMON.CHAIN'
3510 include 'COMMON.DERIV'
3511 include 'COMMON.INTERACT'
3512 include 'COMMON.CONTACTS'
3513 include 'COMMON.TORSION'
3514 include 'COMMON.VECTORS'
3515 include 'COMMON.FFIELD'
3516 include 'COMMON.CONTROL'
3518 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3519 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3520 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3521 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3522 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3523 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3524 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3527 c write (iout,*) "eturn3",i,j,j1,j2
3532 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3534 C Third-order contributions
3541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3542 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3543 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3544 call transpose2(auxmat(1,1),auxmat1(1,1))
3545 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3546 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3547 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3548 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3549 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3550 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3551 cd & ' eello_turn3_num',4*eello_turn3_num
3552 C Derivatives in gamma(i)
3553 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3554 call transpose2(auxmat2(1,1),auxmat3(1,1))
3555 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3556 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3557 C Derivatives in gamma(i+1)
3558 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3559 call transpose2(auxmat2(1,1),auxmat3(1,1))
3560 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3561 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3562 & +0.5d0*(pizda(1,1)+pizda(2,2))
3563 C Cartesian derivatives
3565 c ghalf1=0.5d0*agg(l,1)
3566 c ghalf2=0.5d0*agg(l,2)
3567 c ghalf3=0.5d0*agg(l,3)
3568 c ghalf4=0.5d0*agg(l,4)
3569 a_temp(1,1)=aggi(l,1)!+ghalf1
3570 a_temp(1,2)=aggi(l,2)!+ghalf2
3571 a_temp(2,1)=aggi(l,3)!+ghalf3
3572 a_temp(2,2)=aggi(l,4)!+ghalf4
3573 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3574 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3575 & +0.5d0*(pizda(1,1)+pizda(2,2))
3576 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3577 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3578 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3579 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3580 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3581 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3582 & +0.5d0*(pizda(1,1)+pizda(2,2))
3583 a_temp(1,1)=aggj(l,1)!+ghalf1
3584 a_temp(1,2)=aggj(l,2)!+ghalf2
3585 a_temp(2,1)=aggj(l,3)!+ghalf3
3586 a_temp(2,2)=aggj(l,4)!+ghalf4
3587 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3588 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3589 & +0.5d0*(pizda(1,1)+pizda(2,2))
3590 a_temp(1,1)=aggj1(l,1)
3591 a_temp(1,2)=aggj1(l,2)
3592 a_temp(2,1)=aggj1(l,3)
3593 a_temp(2,2)=aggj1(l,4)
3594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3595 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3596 & +0.5d0*(pizda(1,1)+pizda(2,2))
3600 C-------------------------------------------------------------------------------
3601 subroutine eturn4(i,eello_turn4)
3602 C Third- and fourth-order contributions from turns
3603 implicit real*8 (a-h,o-z)
3604 include 'DIMENSIONS'
3605 include 'COMMON.IOUNITS'
3606 include 'COMMON.GEO'
3607 include 'COMMON.VAR'
3608 include 'COMMON.LOCAL'
3609 include 'COMMON.CHAIN'
3610 include 'COMMON.DERIV'
3611 include 'COMMON.INTERACT'
3612 include 'COMMON.CONTACTS'
3613 include 'COMMON.TORSION'
3614 include 'COMMON.VECTORS'
3615 include 'COMMON.FFIELD'
3616 include 'COMMON.CONTROL'
3618 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3619 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3620 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3621 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3622 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3623 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3624 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3627 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3629 C Fourth-order contributions
3637 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3638 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3639 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3644 iti1=itortyp(itype(i+1))
3645 iti2=itortyp(itype(i+2))
3646 iti3=itortyp(itype(i+3))
3647 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3648 call transpose2(EUg(1,1,i+1),e1t(1,1))
3649 call transpose2(Eug(1,1,i+2),e2t(1,1))
3650 call transpose2(Eug(1,1,i+3),e3t(1,1))
3651 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3652 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3653 s1=scalar2(b1(1,iti2),auxvec(1))
3654 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3655 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3656 s2=scalar2(b1(1,iti1),auxvec(1))
3657 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3658 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3659 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3660 eello_turn4=eello_turn4-(s1+s2+s3)
3661 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3662 & 'eturn4',i,j,-(s1+s2+s3)
3663 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3664 cd & ' eello_turn4_num',8*eello_turn4_num
3665 C Derivatives in gamma(i)
3666 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3667 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3668 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3669 s1=scalar2(b1(1,iti2),auxvec(1))
3670 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3671 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3672 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3673 C Derivatives in gamma(i+1)
3674 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3675 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3676 s2=scalar2(b1(1,iti1),auxvec(1))
3677 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3678 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3679 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3680 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3681 C Derivatives in gamma(i+2)
3682 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3683 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3684 s1=scalar2(b1(1,iti2),auxvec(1))
3685 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3686 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3687 s2=scalar2(b1(1,iti1),auxvec(1))
3688 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3689 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3690 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3691 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3692 C Cartesian derivatives
3693 C Derivatives of this turn contributions in DC(i+2)
3694 if (j.lt.nres-1) then
3696 a_temp(1,1)=agg(l,1)
3697 a_temp(1,2)=agg(l,2)
3698 a_temp(2,1)=agg(l,3)
3699 a_temp(2,2)=agg(l,4)
3700 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3701 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3702 s1=scalar2(b1(1,iti2),auxvec(1))
3703 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3704 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3705 s2=scalar2(b1(1,iti1),auxvec(1))
3706 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3707 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3708 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3710 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3713 C Remaining derivatives of this turn contribution
3715 a_temp(1,1)=aggi(l,1)
3716 a_temp(1,2)=aggi(l,2)
3717 a_temp(2,1)=aggi(l,3)
3718 a_temp(2,2)=aggi(l,4)
3719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3724 s2=scalar2(b1(1,iti1),auxvec(1))
3725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3728 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3729 a_temp(1,1)=aggi1(l,1)
3730 a_temp(1,2)=aggi1(l,2)
3731 a_temp(2,1)=aggi1(l,3)
3732 a_temp(2,2)=aggi1(l,4)
3733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3735 s1=scalar2(b1(1,iti2),auxvec(1))
3736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3738 s2=scalar2(b1(1,iti1),auxvec(1))
3739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3742 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3743 a_temp(1,1)=aggj(l,1)
3744 a_temp(1,2)=aggj(l,2)
3745 a_temp(2,1)=aggj(l,3)
3746 a_temp(2,2)=aggj(l,4)
3747 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3748 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3749 s1=scalar2(b1(1,iti2),auxvec(1))
3750 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3751 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3752 s2=scalar2(b1(1,iti1),auxvec(1))
3753 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3754 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3755 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3756 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3757 a_temp(1,1)=aggj1(l,1)
3758 a_temp(1,2)=aggj1(l,2)
3759 a_temp(2,1)=aggj1(l,3)
3760 a_temp(2,2)=aggj1(l,4)
3761 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3762 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3763 s1=scalar2(b1(1,iti2),auxvec(1))
3764 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3765 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3766 s2=scalar2(b1(1,iti1),auxvec(1))
3767 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3768 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3769 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3770 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3771 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3775 C-----------------------------------------------------------------------------
3776 subroutine vecpr(u,v,w)
3777 implicit real*8(a-h,o-z)
3778 dimension u(3),v(3),w(3)
3779 w(1)=u(2)*v(3)-u(3)*v(2)
3780 w(2)=-u(1)*v(3)+u(3)*v(1)
3781 w(3)=u(1)*v(2)-u(2)*v(1)
3784 C-----------------------------------------------------------------------------
3785 subroutine unormderiv(u,ugrad,unorm,ungrad)
3786 C This subroutine computes the derivatives of a normalized vector u, given
3787 C the derivatives computed without normalization conditions, ugrad. Returns
3790 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3791 double precision vec(3)
3792 double precision scalar
3794 c write (2,*) 'ugrad',ugrad
3797 vec(i)=scalar(ugrad(1,i),u(1))
3799 c write (2,*) 'vec',vec
3802 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3805 c write (2,*) 'ungrad',ungrad
3808 C-----------------------------------------------------------------------------
3809 subroutine escp_soft_sphere(evdw2,evdw2_14)
3811 C This subroutine calculates the excluded-volume interaction energy between
3812 C peptide-group centers and side chains and its gradient in virtual-bond and
3813 C side-chain vectors.
3815 implicit real*8 (a-h,o-z)
3816 include 'DIMENSIONS'
3817 include 'COMMON.GEO'
3818 include 'COMMON.VAR'
3819 include 'COMMON.LOCAL'
3820 include 'COMMON.CHAIN'
3821 include 'COMMON.DERIV'
3822 include 'COMMON.INTERACT'
3823 include 'COMMON.FFIELD'
3824 include 'COMMON.IOUNITS'
3825 include 'COMMON.CONTROL'
3830 cd print '(a)','Enter ESCP'
3831 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3832 do i=iatscp_s,iatscp_e
3833 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3835 xi=0.5D0*(c(1,i)+c(1,i+1))
3836 yi=0.5D0*(c(2,i)+c(2,i+1))
3837 zi=0.5D0*(c(3,i)+c(3,i+1))
3839 do iint=1,nscp_gr(i)
3841 do j=iscpstart(i,iint),iscpend(i,iint)
3842 if (itype(j).eq.ntyp1) cycle
3843 itypj=iabs(itype(j))
3844 C Uncomment following three lines for SC-p interactions
3848 C Uncomment following three lines for Ca-p interactions
3852 rij=xj*xj+yj*yj+zj*zj
3855 if (rij.lt.r0ijsq) then
3856 evdwij=0.25d0*(rij-r0ijsq)**2
3864 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3869 cgrad if (j.lt.i) then
3870 cd write (iout,*) 'j<i'
3871 C Uncomment following three lines for SC-p interactions
3873 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3876 cd write (iout,*) 'j>i'
3878 cgrad ggg(k)=-ggg(k)
3879 C Uncomment following line for SC-p interactions
3880 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3884 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3886 cgrad kstart=min0(i+1,j)
3887 cgrad kend=max0(i-1,j-1)
3888 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3889 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3890 cgrad do k=kstart,kend
3892 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3896 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3897 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3905 C-----------------------------------------------------------------------------
3906 subroutine escp(evdw2,evdw2_14)
3908 C This subroutine calculates the excluded-volume interaction energy between
3909 C peptide-group centers and side chains and its gradient in virtual-bond and
3910 C side-chain vectors.
3912 implicit real*8 (a-h,o-z)
3913 include 'DIMENSIONS'
3914 include 'COMMON.GEO'
3915 include 'COMMON.VAR'
3916 include 'COMMON.LOCAL'
3917 include 'COMMON.CHAIN'
3918 include 'COMMON.DERIV'
3919 include 'COMMON.INTERACT'
3920 include 'COMMON.FFIELD'
3921 include 'COMMON.IOUNITS'
3922 include 'COMMON.CONTROL'
3926 cd print '(a)','Enter ESCP'
3927 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3928 do i=iatscp_s,iatscp_e
3929 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3931 xi=0.5D0*(c(1,i)+c(1,i+1))
3932 yi=0.5D0*(c(2,i)+c(2,i+1))
3933 zi=0.5D0*(c(3,i)+c(3,i+1))
3935 do iint=1,nscp_gr(i)
3937 do j=iscpstart(i,iint),iscpend(i,iint)
3938 itypj=iabs(itype(j))
3939 if (itypj.eq.ntyp1) cycle
3940 C Uncomment following three lines for SC-p interactions
3944 C Uncomment following three lines for Ca-p interactions
3948 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3950 e1=fac*fac*aad(itypj,iteli)
3951 e2=fac*bad(itypj,iteli)
3952 if (iabs(j-i) .le. 2) then
3955 evdw2_14=evdw2_14+e1+e2
3959 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3960 & 'evdw2',i,j,evdwij
3962 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3964 fac=-(evdwij+e1)*rrij
3968 cgrad if (j.lt.i) then
3969 cd write (iout,*) 'j<i'
3970 C Uncomment following three lines for SC-p interactions
3972 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3975 cd write (iout,*) 'j>i'
3977 cgrad ggg(k)=-ggg(k)
3978 C Uncomment following line for SC-p interactions
3979 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3980 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3984 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3986 cgrad kstart=min0(i+1,j)
3987 cgrad kend=max0(i-1,j-1)
3988 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3989 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3990 cgrad do k=kstart,kend
3992 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3996 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3997 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4005 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4006 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4007 gradx_scp(j,i)=expon*gradx_scp(j,i)
4010 C******************************************************************************
4014 C To save time the factor EXPON has been extracted from ALL components
4015 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4018 C******************************************************************************
4021 C--------------------------------------------------------------------------
4022 subroutine edis(ehpb)
4024 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4026 implicit real*8 (a-h,o-z)
4027 include 'DIMENSIONS'
4028 include 'COMMON.SBRIDGE'
4029 include 'COMMON.CHAIN'
4030 include 'COMMON.DERIV'
4031 include 'COMMON.VAR'
4032 include 'COMMON.INTERACT'
4033 include 'COMMON.IOUNITS'
4036 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4037 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4038 if (link_end.eq.0) return
4039 do i=link_start,link_end
4040 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4041 C CA-CA distance used in regularization of structure.
4044 C iii and jjj point to the residues for which the distance is assigned.
4045 if (ii.gt.nres) then
4052 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4053 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4054 C distance and angle dependent SS bond potential.
4055 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4056 & iabs(itype(jjj)).eq.1) then
4057 call ssbond_ene(iii,jjj,eij)
4059 cd write (iout,*) "eij",eij
4061 C Calculate the distance between the two points and its difference from the
4065 C Get the force constant corresponding to this distance.
4067 C Calculate the contribution to energy.
4068 ehpb=ehpb+waga*rdis*rdis
4070 C Evaluate gradient.
4073 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4074 cd & ' waga=',waga,' fac=',fac
4076 ggg(j)=fac*(c(j,jj)-c(j,ii))
4078 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4079 C If this is a SC-SC distance, we need to calculate the contributions to the
4080 C Cartesian gradient in the SC vectors (ghpbx).
4083 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4084 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4087 cgrad do j=iii,jjj-1
4089 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4093 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4094 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4101 C--------------------------------------------------------------------------
4102 subroutine ssbond_ene(i,j,eij)
4104 C Calculate the distance and angle dependent SS-bond potential energy
4105 C using a free-energy function derived based on RHF/6-31G** ab initio
4106 C calculations of diethyl disulfide.
4108 C A. Liwo and U. Kozlowska, 11/24/03
4110 implicit real*8 (a-h,o-z)
4111 include 'DIMENSIONS'
4112 include 'COMMON.SBRIDGE'
4113 include 'COMMON.CHAIN'
4114 include 'COMMON.DERIV'
4115 include 'COMMON.LOCAL'
4116 include 'COMMON.INTERACT'
4117 include 'COMMON.VAR'
4118 include 'COMMON.IOUNITS'
4119 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4120 itypi=iabs(itype(i))
4124 dxi=dc_norm(1,nres+i)
4125 dyi=dc_norm(2,nres+i)
4126 dzi=dc_norm(3,nres+i)
4127 c dsci_inv=dsc_inv(itypi)
4128 dsci_inv=vbld_inv(nres+i)
4129 itypj=iabs(itype(j))
4130 c dscj_inv=dsc_inv(itypj)
4131 dscj_inv=vbld_inv(nres+j)
4135 dxj=dc_norm(1,nres+j)
4136 dyj=dc_norm(2,nres+j)
4137 dzj=dc_norm(3,nres+j)
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4143 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4144 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4145 om12=dxi*dxj+dyi*dyj+dzi*dzj
4147 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4148 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4154 deltat12=om2-om1+2.0d0
4156 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4157 & +akct*deltad*deltat12
4158 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4159 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4160 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4161 c & " deltat12",deltat12," eij",eij
4162 ed=2*akcm*deltad+akct*deltat12
4164 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4165 eom1=-2*akth*deltat1-pom1-om2*pom2
4166 eom2= 2*akth*deltat2+pom1-om1*pom2
4169 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4170 ghpbx(k,i)=ghpbx(k,i)-ggk
4171 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4172 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4173 ghpbx(k,j)=ghpbx(k,j)+ggk
4174 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4175 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4176 ghpbc(k,i)=ghpbc(k,i)-ggk
4177 ghpbc(k,j)=ghpbc(k,j)+ggk
4180 C Calculate the components of the gradient in DC and X
4184 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4189 C--------------------------------------------------------------------------
4190 subroutine ebond(estr)
4192 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4194 implicit real*8 (a-h,o-z)
4195 include 'DIMENSIONS'
4196 include 'COMMON.LOCAL'
4197 include 'COMMON.GEO'
4198 include 'COMMON.INTERACT'
4199 include 'COMMON.DERIV'
4200 include 'COMMON.VAR'
4201 include 'COMMON.CHAIN'
4202 include 'COMMON.IOUNITS'
4203 include 'COMMON.NAMES'
4204 include 'COMMON.FFIELD'
4205 include 'COMMON.CONTROL'
4206 include 'COMMON.SETUP'
4207 double precision u(3),ud(3)
4210 do i=ibondp_start,ibondp_end
4211 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4212 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4214 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4215 & *dc(j,i-1)/vbld(i)
4217 if (energy_dec) write(iout,*)
4218 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4220 diff = vbld(i)-vbldp0
4221 if (energy_dec) write (iout,*)
4222 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4225 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4227 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4230 estr=0.5d0*AKP*estr+estr1
4232 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4234 do i=ibond_start,ibond_end
4236 if (iti.ne.10 .and. iti.ne.ntyp1) then
4239 diff=vbld(i+nres)-vbldsc0(1,iti)
4240 if (energy_dec) write (iout,*)
4241 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4242 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4243 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4245 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4249 diff=vbld(i+nres)-vbldsc0(j,iti)
4250 ud(j)=aksc(j,iti)*diff
4251 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4265 uprod2=uprod2*u(k)*u(k)
4269 usumsqder=usumsqder+ud(j)*uprod2
4271 estr=estr+uprod/usum
4273 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4281 C--------------------------------------------------------------------------
4282 subroutine ebend(etheta)
4284 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4285 C angles gamma and its derivatives in consecutive thetas and gammas.
4287 implicit real*8 (a-h,o-z)
4288 include 'DIMENSIONS'
4289 include 'COMMON.LOCAL'
4290 include 'COMMON.GEO'
4291 include 'COMMON.INTERACT'
4292 include 'COMMON.DERIV'
4293 include 'COMMON.VAR'
4294 include 'COMMON.CHAIN'
4295 include 'COMMON.IOUNITS'
4296 include 'COMMON.NAMES'
4297 include 'COMMON.FFIELD'
4298 include 'COMMON.CONTROL'
4299 common /calcthet/ term1,term2,termm,diffak,ratak,
4300 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4301 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4302 double precision y(2),z(2)
4304 c time11=dexp(-2*time)
4307 c write (*,'(a,i2)') 'EBEND ICG=',icg
4308 do i=ithet_start,ithet_end
4309 if (itype(i-1).eq.ntyp1) cycle
4310 C Zero the energy function and its derivative at 0 or pi.
4311 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4313 ichir1=isign(1,itype(i-2))
4314 ichir2=isign(1,itype(i))
4315 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4316 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4317 if (itype(i-1).eq.10) then
4318 itype1=isign(10,itype(i-2))
4319 ichir11=isign(1,itype(i-2))
4320 ichir12=isign(1,itype(i-2))
4321 itype2=isign(10,itype(i))
4322 ichir21=isign(1,itype(i))
4323 ichir22=isign(1,itype(i))
4326 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4329 if (phii.ne.phii) phii=150.0
4339 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4342 if (phii1.ne.phii1) phii1=150.0
4354 C Calculate the "mean" value of theta from the part of the distribution
4355 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4356 C In following comments this theta will be referred to as t_c.
4357 thet_pred_mean=0.0d0
4359 athetk=athet(k,it,ichir1,ichir2)
4360 bthetk=bthet(k,it,ichir1,ichir2)
4362 athetk=athet(k,itype1,ichir11,ichir12)
4363 bthetk=bthet(k,itype2,ichir21,ichir22)
4365 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4367 dthett=thet_pred_mean*ssd
4368 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4369 C Derivatives of the "mean" values in gamma1 and gamma2.
4370 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4371 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4372 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4373 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4375 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4376 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4377 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4378 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4380 if (theta(i).gt.pi-delta) then
4381 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4383 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4384 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4385 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4387 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4389 else if (theta(i).lt.delta) then
4390 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4391 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4392 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4394 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4395 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4398 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4401 etheta=etheta+ethetai
4402 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4404 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4405 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4406 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4408 C Ufff.... We've done all this!!!
4411 C---------------------------------------------------------------------------
4412 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4414 implicit real*8 (a-h,o-z)
4415 include 'DIMENSIONS'
4416 include 'COMMON.LOCAL'
4417 include 'COMMON.IOUNITS'
4418 common /calcthet/ term1,term2,termm,diffak,ratak,
4419 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4420 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4421 C Calculate the contributions to both Gaussian lobes.
4422 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4423 C The "polynomial part" of the "standard deviation" of this part of
4427 sig=sig*thet_pred_mean+polthet(j,it)
4429 C Derivative of the "interior part" of the "standard deviation of the"
4430 C gamma-dependent Gaussian lobe in t_c.
4431 sigtc=3*polthet(3,it)
4433 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4436 C Set the parameters of both Gaussian lobes of the distribution.
4437 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4438 fac=sig*sig+sigc0(it)
4441 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4442 sigsqtc=-4.0D0*sigcsq*sigtc
4443 c print *,i,sig,sigtc,sigsqtc
4444 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4445 sigtc=-sigtc/(fac*fac)
4446 C Following variable is sigma(t_c)**(-2)
4447 sigcsq=sigcsq*sigcsq
4449 sig0inv=1.0D0/sig0i**2
4450 delthec=thetai-thet_pred_mean
4451 delthe0=thetai-theta0i
4452 term1=-0.5D0*sigcsq*delthec*delthec
4453 term2=-0.5D0*sig0inv*delthe0*delthe0
4454 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4455 C NaNs in taking the logarithm. We extract the largest exponent which is added
4456 C to the energy (this being the log of the distribution) at the end of energy
4457 C term evaluation for this virtual-bond angle.
4458 if (term1.gt.term2) then
4460 term2=dexp(term2-termm)
4464 term1=dexp(term1-termm)
4467 C The ratio between the gamma-independent and gamma-dependent lobes of
4468 C the distribution is a Gaussian function of thet_pred_mean too.
4469 diffak=gthet(2,it)-thet_pred_mean
4470 ratak=diffak/gthet(3,it)**2
4471 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4472 C Let's differentiate it in thet_pred_mean NOW.
4474 C Now put together the distribution terms to make complete distribution.
4475 termexp=term1+ak*term2
4476 termpre=sigc+ak*sig0i
4477 C Contribution of the bending energy from this theta is just the -log of
4478 C the sum of the contributions from the two lobes and the pre-exponential
4479 C factor. Simple enough, isn't it?
4480 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4481 C NOW the derivatives!!!
4482 C 6/6/97 Take into account the deformation.
4483 E_theta=(delthec*sigcsq*term1
4484 & +ak*delthe0*sig0inv*term2)/termexp
4485 E_tc=((sigtc+aktc*sig0i)/termpre
4486 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4487 & aktc*term2)/termexp)
4490 c-----------------------------------------------------------------------------
4491 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4492 implicit real*8 (a-h,o-z)
4493 include 'DIMENSIONS'
4494 include 'COMMON.LOCAL'
4495 include 'COMMON.IOUNITS'
4496 common /calcthet/ term1,term2,termm,diffak,ratak,
4497 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4498 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4499 delthec=thetai-thet_pred_mean
4500 delthe0=thetai-theta0i
4501 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4502 t3 = thetai-thet_pred_mean
4506 t14 = t12+t6*sigsqtc
4508 t21 = thetai-theta0i
4514 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4515 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4516 & *(-t12*t9-ak*sig0inv*t27)
4520 C--------------------------------------------------------------------------
4521 subroutine ebend(etheta)
4523 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4524 C angles gamma and its derivatives in consecutive thetas and gammas.
4525 C ab initio-derived potentials from
4526 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4528 implicit real*8 (a-h,o-z)
4529 include 'DIMENSIONS'
4530 include 'COMMON.LOCAL'
4531 include 'COMMON.GEO'
4532 include 'COMMON.INTERACT'
4533 include 'COMMON.DERIV'
4534 include 'COMMON.VAR'
4535 include 'COMMON.CHAIN'
4536 include 'COMMON.IOUNITS'
4537 include 'COMMON.NAMES'
4538 include 'COMMON.FFIELD'
4539 include 'COMMON.CONTROL'
4540 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4541 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4542 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4543 & sinph1ph2(maxdouble,maxdouble)
4544 logical lprn /.false./, lprn1 /.false./
4546 do i=ithet_start,ithet_end
4547 if (itype(i-1).eq.ntyp1) cycle
4548 if (iabs(itype(i+1)).eq.20) iblock=2
4549 if (iabs(itype(i+1)).ne.20) iblock=1
4553 theti2=0.5d0*theta(i)
4554 ityp2=ithetyp((itype(i-1)))
4556 coskt(k)=dcos(k*theti2)
4557 sinkt(k)=dsin(k*theti2)
4559 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4562 if (phii.ne.phii) phii=150.0
4566 ityp1=ithetyp((itype(i-2)))
4567 C propagation of chirality for glycine type
4569 cosph1(k)=dcos(k*phii)
4570 sinph1(k)=dsin(k*phii)
4580 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4583 if (phii1.ne.phii1) phii1=150.0
4588 ityp3=ithetyp((itype(i)))
4590 cosph2(k)=dcos(k*phii1)
4591 sinph2(k)=dsin(k*phii1)
4601 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4604 ccl=cosph1(l)*cosph2(k-l)
4605 ssl=sinph1(l)*sinph2(k-l)
4606 scl=sinph1(l)*cosph2(k-l)
4607 csl=cosph1(l)*sinph2(k-l)
4608 cosph1ph2(l,k)=ccl-ssl
4609 cosph1ph2(k,l)=ccl+ssl
4610 sinph1ph2(l,k)=scl+csl
4611 sinph1ph2(k,l)=scl-csl
4615 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4616 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4617 write (iout,*) "coskt and sinkt"
4619 write (iout,*) k,coskt(k),sinkt(k)
4623 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4624 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4627 & write (iout,*) "k",k,"
4628 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4629 & " ethetai",ethetai
4632 write (iout,*) "cosph and sinph"
4634 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4636 write (iout,*) "cosph1ph2 and sinph2ph2"
4639 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4640 & sinph1ph2(l,k),sinph1ph2(k,l)
4643 write(iout,*) "ethetai",ethetai
4647 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4648 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4649 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4650 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4651 ethetai=ethetai+sinkt(m)*aux
4652 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4653 dephii=dephii+k*sinkt(m)*(
4654 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4655 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4656 dephii1=dephii1+k*sinkt(m)*(
4657 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4658 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4660 & write (iout,*) "m",m," k",k," bbthet",
4661 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4662 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4663 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4664 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4668 & write(iout,*) "ethetai",ethetai
4672 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4673 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4674 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4675 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4676 ethetai=ethetai+sinkt(m)*aux
4677 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4678 dephii=dephii+l*sinkt(m)*(
4679 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4680 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4681 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4682 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4683 dephii1=dephii1+(k-l)*sinkt(m)*(
4684 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4685 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4686 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4687 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4689 write (iout,*) "m",m," k",k," l",l," ffthet",
4690 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4691 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4692 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4693 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4694 & " ethetai",ethetai
4695 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4696 & cosph1ph2(k,l)*sinkt(m),
4697 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4705 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4706 & i,theta(i)*rad2deg,phii*rad2deg,
4707 & phii1*rad2deg,ethetai
4709 etheta=etheta+ethetai
4710 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4711 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4712 gloc(nphi+i-2,icg)=wang*dethetai
4718 c-----------------------------------------------------------------------------
4719 subroutine esc(escloc)
4720 C Calculate the local energy of a side chain and its derivatives in the
4721 C corresponding virtual-bond valence angles THETA and the spherical angles
4723 implicit real*8 (a-h,o-z)
4724 include 'DIMENSIONS'
4725 include 'COMMON.GEO'
4726 include 'COMMON.LOCAL'
4727 include 'COMMON.VAR'
4728 include 'COMMON.INTERACT'
4729 include 'COMMON.DERIV'
4730 include 'COMMON.CHAIN'
4731 include 'COMMON.IOUNITS'
4732 include 'COMMON.NAMES'
4733 include 'COMMON.FFIELD'
4734 include 'COMMON.CONTROL'
4735 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4736 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4737 common /sccalc/ time11,time12,time112,theti,it,nlobit
4740 c write (iout,'(a)') 'ESC'
4741 do i=loc_start,loc_end
4743 if (it.eq.ntyp1) cycle
4744 if (it.eq.10) goto 1
4745 nlobit=nlob(iabs(it))
4746 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4747 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4748 theti=theta(i+1)-pipol
4753 if (x(2).gt.pi-delta) then
4757 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4759 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4760 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4762 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4763 & ddersc0(1),dersc(1))
4764 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4765 & ddersc0(3),dersc(3))
4767 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4769 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4770 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4771 & dersc0(2),esclocbi,dersc02)
4772 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4774 call splinthet(x(2),0.5d0*delta,ss,ssd)
4779 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4781 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4782 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4784 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4786 c write (iout,*) escloci
4787 else if (x(2).lt.delta) then
4791 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4793 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4794 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4796 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4797 & ddersc0(1),dersc(1))
4798 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4799 & ddersc0(3),dersc(3))
4801 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4803 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4804 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4805 & dersc0(2),esclocbi,dersc02)
4806 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4811 call splinthet(x(2),0.5d0*delta,ss,ssd)
4813 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4815 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4816 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4818 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4819 c write (iout,*) escloci
4821 call enesc(x,escloci,dersc,ddummy,.false.)
4824 escloc=escloc+escloci
4825 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4826 & 'escloc',i,escloci
4827 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4829 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4831 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4832 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4837 C---------------------------------------------------------------------------
4838 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4839 implicit real*8 (a-h,o-z)
4840 include 'DIMENSIONS'
4841 include 'COMMON.GEO'
4842 include 'COMMON.LOCAL'
4843 include 'COMMON.IOUNITS'
4844 common /sccalc/ time11,time12,time112,theti,it,nlobit
4845 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4846 double precision contr(maxlob,-1:1)
4848 c write (iout,*) 'it=',it,' nlobit=',nlobit
4852 if (mixed) ddersc(j)=0.0d0
4856 C Because of periodicity of the dependence of the SC energy in omega we have
4857 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4858 C To avoid underflows, first compute & store the exponents.
4866 z(k)=x(k)-censc(k,j,it)
4871 Axk=Axk+gaussc(l,k,j,it)*z(l)
4877 expfac=expfac+Ax(k,j,iii)*z(k)
4885 C As in the case of ebend, we want to avoid underflows in exponentiation and
4886 C subsequent NaNs and INFs in energy calculation.
4887 C Find the largest exponent
4891 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4895 cd print *,'it=',it,' emin=',emin
4897 C Compute the contribution to SC energy and derivatives
4902 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4903 if(adexp.ne.adexp) adexp=1.0
4906 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4908 cd print *,'j=',j,' expfac=',expfac
4909 escloc_i=escloc_i+expfac
4911 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4915 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4916 & +gaussc(k,2,j,it))*expfac
4923 dersc(1)=dersc(1)/cos(theti)**2
4924 ddersc(1)=ddersc(1)/cos(theti)**2
4927 escloci=-(dlog(escloc_i)-emin)
4929 dersc(j)=dersc(j)/escloc_i
4933 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4938 C------------------------------------------------------------------------------
4939 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4940 implicit real*8 (a-h,o-z)
4941 include 'DIMENSIONS'
4942 include 'COMMON.GEO'
4943 include 'COMMON.LOCAL'
4944 include 'COMMON.IOUNITS'
4945 common /sccalc/ time11,time12,time112,theti,it,nlobit
4946 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4947 double precision contr(maxlob)
4958 z(k)=x(k)-censc(k,j,it)
4964 Axk=Axk+gaussc(l,k,j,it)*z(l)
4970 expfac=expfac+Ax(k,j)*z(k)
4975 C As in the case of ebend, we want to avoid underflows in exponentiation and
4976 C subsequent NaNs and INFs in energy calculation.
4977 C Find the largest exponent
4980 if (emin.gt.contr(j)) emin=contr(j)
4984 C Compute the contribution to SC energy and derivatives
4988 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4989 escloc_i=escloc_i+expfac
4991 dersc(k)=dersc(k)+Ax(k,j)*expfac
4993 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4994 & +gaussc(1,2,j,it))*expfac
4998 dersc(1)=dersc(1)/cos(theti)**2
4999 dersc12=dersc12/cos(theti)**2
5000 escloci=-(dlog(escloc_i)-emin)
5002 dersc(j)=dersc(j)/escloc_i
5004 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5008 c----------------------------------------------------------------------------------
5009 subroutine esc(escloc)
5010 C Calculate the local energy of a side chain and its derivatives in the
5011 C corresponding virtual-bond valence angles THETA and the spherical angles
5012 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5013 C added by Urszula Kozlowska. 07/11/2007
5015 implicit real*8 (a-h,o-z)
5016 include 'DIMENSIONS'
5017 include 'COMMON.GEO'
5018 include 'COMMON.LOCAL'
5019 include 'COMMON.VAR'
5020 include 'COMMON.SCROT'
5021 include 'COMMON.INTERACT'
5022 include 'COMMON.DERIV'
5023 include 'COMMON.CHAIN'
5024 include 'COMMON.IOUNITS'
5025 include 'COMMON.NAMES'
5026 include 'COMMON.FFIELD'
5027 include 'COMMON.CONTROL'
5028 include 'COMMON.VECTORS'
5029 double precision x_prime(3),y_prime(3),z_prime(3)
5030 & , sumene,dsc_i,dp2_i,x(65),
5031 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5032 & de_dxx,de_dyy,de_dzz,de_dt
5033 double precision s1_t,s1_6_t,s2_t,s2_6_t
5035 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5036 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5037 & dt_dCi(3),dt_dCi1(3)
5038 common /sccalc/ time11,time12,time112,theti,it,nlobit
5041 do i=loc_start,loc_end
5042 if (itype(i).eq.ntyp1) cycle
5043 costtab(i+1) =dcos(theta(i+1))
5044 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5045 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5046 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5047 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5048 cosfac=dsqrt(cosfac2)
5049 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5050 sinfac=dsqrt(sinfac2)
5052 if (it.eq.10) goto 1
5054 C Compute the axes of tghe local cartesian coordinates system; store in
5055 c x_prime, y_prime and z_prime
5062 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5063 C & dc_norm(3,i+nres)
5065 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5066 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5069 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5072 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5073 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5074 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5075 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5076 c & " xy",scalar(x_prime(1),y_prime(1)),
5077 c & " xz",scalar(x_prime(1),z_prime(1)),
5078 c & " yy",scalar(y_prime(1),y_prime(1)),
5079 c & " yz",scalar(y_prime(1),z_prime(1)),
5080 c & " zz",scalar(z_prime(1),z_prime(1))
5082 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5083 C to local coordinate system. Store in xx, yy, zz.
5089 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5090 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5091 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5098 C Compute the energy of the ith side cbain
5100 c write (2,*) "xx",xx," yy",yy," zz",zz
5103 x(j) = sc_parmin(j,it)
5106 Cc diagnostics - remove later
5108 yy1 = dsin(alph(2))*dcos(omeg(2))
5109 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5110 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5111 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5113 C," --- ", xx_w,yy_w,zz_w
5116 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5117 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5119 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5120 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5122 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5123 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5124 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5125 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5126 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5128 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5129 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5130 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5131 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5132 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5134 dsc_i = 0.743d0+x(61)
5136 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5137 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5138 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5139 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5140 s1=(1+x(63))/(0.1d0 + dscp1)
5141 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5142 s2=(1+x(65))/(0.1d0 + dscp2)
5143 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5144 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5145 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5146 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5148 c & dscp1,dscp2,sumene
5149 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5150 escloc = escloc + sumene
5151 c write (2,*) "i",i," escloc",sumene,escloc
5155 C This section to check the numerical derivatives of the energy of ith side
5156 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5157 C #define DEBUG in the code to turn it on.
5159 write (2,*) "sumene =",sumene
5163 write (2,*) xx,yy,zz
5164 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5165 de_dxx_num=(sumenep-sumene)/aincr
5167 write (2,*) "xx+ sumene from enesc=",sumenep
5170 write (2,*) xx,yy,zz
5171 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5172 de_dyy_num=(sumenep-sumene)/aincr
5174 write (2,*) "yy+ sumene from enesc=",sumenep
5177 write (2,*) xx,yy,zz
5178 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5179 de_dzz_num=(sumenep-sumene)/aincr
5181 write (2,*) "zz+ sumene from enesc=",sumenep
5182 costsave=cost2tab(i+1)
5183 sintsave=sint2tab(i+1)
5184 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5185 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5186 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5187 de_dt_num=(sumenep-sumene)/aincr
5188 write (2,*) " t+ sumene from enesc=",sumenep
5189 cost2tab(i+1)=costsave
5190 sint2tab(i+1)=sintsave
5191 C End of diagnostics section.
5194 C Compute the gradient of esc
5196 c zz=zz*dsign(1.0,dfloat(itype(i)))
5197 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5198 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5199 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5200 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5201 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5202 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5203 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5204 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5205 pom1=(sumene3*sint2tab(i+1)+sumene1)
5206 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5207 pom2=(sumene4*cost2tab(i+1)+sumene2)
5208 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5209 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5210 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5211 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5213 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5214 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5215 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5217 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5218 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5219 & +(pom1+pom2)*pom_dx
5221 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5224 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5225 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5226 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5228 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5229 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5230 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5231 & +x(59)*zz**2 +x(60)*xx*zz
5232 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5233 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5234 & +(pom1-pom2)*pom_dy
5236 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5239 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5240 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5241 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5242 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5243 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5244 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5245 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5246 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5248 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5251 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5252 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5253 & +pom1*pom_dt1+pom2*pom_dt2
5255 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5260 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5261 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5262 cosfac2xx=cosfac2*xx
5263 sinfac2yy=sinfac2*yy
5265 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5267 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5269 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5270 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5271 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5272 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5273 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5274 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5275 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5276 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5277 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5278 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5282 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5283 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5284 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5285 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5288 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5289 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5290 dZZ_XYZ(k)=vbld_inv(i+nres)*
5291 & (z_prime(k)-zz*dC_norm(k,i+nres))
5293 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5294 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5298 dXX_Ctab(k,i)=dXX_Ci(k)
5299 dXX_C1tab(k,i)=dXX_Ci1(k)
5300 dYY_Ctab(k,i)=dYY_Ci(k)
5301 dYY_C1tab(k,i)=dYY_Ci1(k)
5302 dZZ_Ctab(k,i)=dZZ_Ci(k)
5303 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5304 dXX_XYZtab(k,i)=dXX_XYZ(k)
5305 dYY_XYZtab(k,i)=dYY_XYZ(k)
5306 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5310 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5311 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5312 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5313 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5314 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5316 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5317 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5318 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5319 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5320 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5321 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5322 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5323 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5325 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5326 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5328 C to check gradient call subroutine check_grad
5334 c------------------------------------------------------------------------------
5335 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5337 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5338 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5339 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5340 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5342 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5343 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5345 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5346 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5347 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5348 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5349 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5351 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5352 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5353 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5354 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5355 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5357 dsc_i = 0.743d0+x(61)
5359 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5360 & *(xx*cost2+yy*sint2))
5361 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5362 & *(xx*cost2-yy*sint2))
5363 s1=(1+x(63))/(0.1d0 + dscp1)
5364 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5365 s2=(1+x(65))/(0.1d0 + dscp2)
5366 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5367 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5368 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5373 c------------------------------------------------------------------------------
5374 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5376 C This procedure calculates two-body contact function g(rij) and its derivative:
5379 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5382 C where x=(rij-r0ij)/delta
5384 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5387 double precision rij,r0ij,eps0ij,fcont,fprimcont
5388 double precision x,x2,x4,delta
5392 if (x.lt.-1.0D0) then
5395 else if (x.le.1.0D0) then
5398 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5399 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5406 c------------------------------------------------------------------------------
5407 subroutine splinthet(theti,delta,ss,ssder)
5408 implicit real*8 (a-h,o-z)
5409 include 'DIMENSIONS'
5410 include 'COMMON.VAR'
5411 include 'COMMON.GEO'
5414 if (theti.gt.pipol) then
5415 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5417 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5422 c------------------------------------------------------------------------------
5423 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5425 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5426 double precision ksi,ksi2,ksi3,a1,a2,a3
5427 a1=fprim0*delta/(f1-f0)
5433 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5434 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5437 c------------------------------------------------------------------------------
5438 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5440 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5441 double precision ksi,ksi2,ksi3,a1,a2,a3
5446 a2=3*(f1x-f0x)-2*fprim0x*delta
5447 a3=fprim0x*delta-2*(f1x-f0x)
5448 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5451 C-----------------------------------------------------------------------------
5453 C-----------------------------------------------------------------------------
5454 subroutine etor(etors,edihcnstr)
5455 implicit real*8 (a-h,o-z)
5456 include 'DIMENSIONS'
5457 include 'COMMON.VAR'
5458 include 'COMMON.GEO'
5459 include 'COMMON.LOCAL'
5460 include 'COMMON.TORSION'
5461 include 'COMMON.INTERACT'
5462 include 'COMMON.DERIV'
5463 include 'COMMON.CHAIN'
5464 include 'COMMON.NAMES'
5465 include 'COMMON.IOUNITS'
5466 include 'COMMON.FFIELD'
5467 include 'COMMON.TORCNSTR'
5468 include 'COMMON.CONTROL'
5470 C Set lprn=.true. for debugging
5474 do i=iphi_start,iphi_end
5476 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5477 & .or. itype(i).eq.ntyp1) cycle
5478 itori=itortyp(itype(i-2))
5479 itori1=itortyp(itype(i-1))
5482 C Proline-Proline pair is a special case...
5483 if (itori.eq.3 .and. itori1.eq.3) then
5484 if (phii.gt.-dwapi3) then
5486 fac=1.0D0/(1.0D0-cosphi)
5487 etorsi=v1(1,3,3)*fac
5488 etorsi=etorsi+etorsi
5489 etors=etors+etorsi-v1(1,3,3)
5490 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5491 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5494 v1ij=v1(j+1,itori,itori1)
5495 v2ij=v2(j+1,itori,itori1)
5498 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5499 if (energy_dec) etors_ii=etors_ii+
5500 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5501 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5505 v1ij=v1(j,itori,itori1)
5506 v2ij=v2(j,itori,itori1)
5509 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5510 if (energy_dec) etors_ii=etors_ii+
5511 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5512 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5515 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5518 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5519 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5520 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5521 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5522 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5524 ! 6/20/98 - dihedral angle constraints
5527 itori=idih_constr(i)
5530 if (difi.gt.drange(i)) then
5532 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5533 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5534 else if (difi.lt.-drange(i)) then
5536 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5537 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5539 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5540 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5542 ! write (iout,*) 'edihcnstr',edihcnstr
5545 c------------------------------------------------------------------------------
5546 subroutine etor_d(etors_d)
5550 c----------------------------------------------------------------------------
5552 subroutine etor(etors,edihcnstr)
5553 implicit real*8 (a-h,o-z)
5554 include 'DIMENSIONS'
5555 include 'COMMON.VAR'
5556 include 'COMMON.GEO'
5557 include 'COMMON.LOCAL'
5558 include 'COMMON.TORSION'
5559 include 'COMMON.INTERACT'
5560 include 'COMMON.DERIV'
5561 include 'COMMON.CHAIN'
5562 include 'COMMON.NAMES'
5563 include 'COMMON.IOUNITS'
5564 include 'COMMON.FFIELD'
5565 include 'COMMON.TORCNSTR'
5566 include 'COMMON.CONTROL'
5568 C Set lprn=.true. for debugging
5572 do i=iphi_start,iphi_end
5573 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5574 & .or. itype(i).eq.ntyp1) cycle
5576 if (iabs(itype(i)).eq.20) then
5581 itori=itortyp(itype(i-2))
5582 itori1=itortyp(itype(i-1))
5585 C Regular cosine and sine terms
5586 do j=1,nterm(itori,itori1,iblock)
5587 v1ij=v1(j,itori,itori1,iblock)
5588 v2ij=v2(j,itori,itori1,iblock)
5591 etors=etors+v1ij*cosphi+v2ij*sinphi
5592 if (energy_dec) etors_ii=etors_ii+
5593 & v1ij*cosphi+v2ij*sinphi
5594 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5598 C E = SUM ----------------------------------- - v1
5599 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5601 cosphi=dcos(0.5d0*phii)
5602 sinphi=dsin(0.5d0*phii)
5603 do j=1,nlor(itori,itori1,iblock)
5604 vl1ij=vlor1(j,itori,itori1)
5605 vl2ij=vlor2(j,itori,itori1)
5606 vl3ij=vlor3(j,itori,itori1)
5607 pom=vl2ij*cosphi+vl3ij*sinphi
5608 pom1=1.0d0/(pom*pom+1.0d0)
5609 etors=etors+vl1ij*pom1
5610 if (energy_dec) etors_ii=etors_ii+
5613 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5615 C Subtract the constant term
5616 etors=etors-v0(itori,itori1,iblock)
5617 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5618 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5620 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5621 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5622 & (v1(j,itori,itori1,iblock),j=1,6),
5623 & (v2(j,itori,itori1,iblock),j=1,6)
5624 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5625 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5627 ! 6/20/98 - dihedral angle constraints
5629 c do i=1,ndih_constr
5630 do i=idihconstr_start,idihconstr_end
5631 itori=idih_constr(i)
5633 difi=pinorm(phii-phi0(i))
5634 if (difi.gt.drange(i)) then
5636 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5637 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5638 else if (difi.lt.-drange(i)) then
5640 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5641 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5645 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5646 cd & rad2deg*phi0(i), rad2deg*drange(i),
5647 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5649 cd write (iout,*) 'edihcnstr',edihcnstr
5652 c----------------------------------------------------------------------------
5653 subroutine etor_d(etors_d)
5654 C 6/23/01 Compute double torsional energy
5655 implicit real*8 (a-h,o-z)
5656 include 'DIMENSIONS'
5657 include 'COMMON.VAR'
5658 include 'COMMON.GEO'
5659 include 'COMMON.LOCAL'
5660 include 'COMMON.TORSION'
5661 include 'COMMON.INTERACT'
5662 include 'COMMON.DERIV'
5663 include 'COMMON.CHAIN'
5664 include 'COMMON.NAMES'
5665 include 'COMMON.IOUNITS'
5666 include 'COMMON.FFIELD'
5667 include 'COMMON.TORCNSTR'
5669 C Set lprn=.true. for debugging
5673 c write(iout,*) "a tu??"
5674 do i=iphid_start,iphid_end
5675 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5676 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5677 itori=itortyp(itype(i-2))
5678 itori1=itortyp(itype(i-1))
5679 itori2=itortyp(itype(i))
5685 if (iabs(itype(i+1)).eq.20) iblock=2
5687 C Regular cosine and sine terms
5688 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5689 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5690 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5691 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5692 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5693 cosphi1=dcos(j*phii)
5694 sinphi1=dsin(j*phii)
5695 cosphi2=dcos(j*phii1)
5696 sinphi2=dsin(j*phii1)
5697 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5698 & v2cij*cosphi2+v2sij*sinphi2
5699 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5700 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5702 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5704 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5705 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5706 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5707 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5708 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5709 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5710 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5711 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5712 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5713 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5714 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5715 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5716 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5717 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5720 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5721 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5726 c------------------------------------------------------------------------------
5727 subroutine eback_sc_corr(esccor)
5728 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5729 c conformational states; temporarily implemented as differences
5730 c between UNRES torsional potentials (dependent on three types of
5731 c residues) and the torsional potentials dependent on all 20 types
5732 c of residues computed from AM1 energy surfaces of terminally-blocked
5733 c amino-acid residues.
5734 implicit real*8 (a-h,o-z)
5735 include 'DIMENSIONS'
5736 include 'COMMON.VAR'
5737 include 'COMMON.GEO'
5738 include 'COMMON.LOCAL'
5739 include 'COMMON.TORSION'
5740 include 'COMMON.SCCOR'
5741 include 'COMMON.INTERACT'
5742 include 'COMMON.DERIV'
5743 include 'COMMON.CHAIN'
5744 include 'COMMON.NAMES'
5745 include 'COMMON.IOUNITS'
5746 include 'COMMON.FFIELD'
5747 include 'COMMON.CONTROL'
5749 C Set lprn=.true. for debugging
5752 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5754 do i=itau_start,itau_end
5755 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5757 isccori=isccortyp(itype(i-2))
5758 isccori1=isccortyp(itype(i-1))
5759 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5761 do intertyp=1,3 !intertyp
5762 cc Added 09 May 2012 (Adasko)
5763 cc Intertyp means interaction type of backbone mainchain correlation:
5764 c 1 = SC...Ca...Ca...Ca
5765 c 2 = Ca...Ca...Ca...SC
5766 c 3 = SC...Ca...Ca...SCi
5768 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5769 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5770 & (itype(i-1).eq.ntyp1)))
5771 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5772 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5773 & .or.(itype(i).eq.ntyp1)))
5774 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5775 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5776 & (itype(i-3).eq.ntyp1)))) cycle
5777 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5778 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5780 do j=1,nterm_sccor(isccori,isccori1)
5781 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5782 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5783 cosphi=dcos(j*tauangle(intertyp,i))
5784 sinphi=dsin(j*tauangle(intertyp,i))
5785 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5786 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5788 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5789 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5791 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5792 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5793 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5794 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5795 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5801 c----------------------------------------------------------------------------
5802 subroutine multibody(ecorr)
5803 C This subroutine calculates multi-body contributions to energy following
5804 C the idea of Skolnick et al. If side chains I and J make a contact and
5805 C at the same time side chains I+1 and J+1 make a contact, an extra
5806 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5807 implicit real*8 (a-h,o-z)
5808 include 'DIMENSIONS'
5809 include 'COMMON.IOUNITS'
5810 include 'COMMON.DERIV'
5811 include 'COMMON.INTERACT'
5812 include 'COMMON.CONTACTS'
5813 double precision gx(3),gx1(3)
5816 C Set lprn=.true. for debugging
5820 write (iout,'(a)') 'Contact function values:'
5822 write (iout,'(i2,20(1x,i2,f10.5))')
5823 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5838 num_conti=num_cont(i)
5839 num_conti1=num_cont(i1)
5844 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5845 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5846 cd & ' ishift=',ishift
5847 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5848 C The system gains extra energy.
5849 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5850 endif ! j1==j+-ishift
5859 c------------------------------------------------------------------------------
5860 double precision function esccorr(i,j,k,l,jj,kk)
5861 implicit real*8 (a-h,o-z)
5862 include 'DIMENSIONS'
5863 include 'COMMON.IOUNITS'
5864 include 'COMMON.DERIV'
5865 include 'COMMON.INTERACT'
5866 include 'COMMON.CONTACTS'
5867 double precision gx(3),gx1(3)
5872 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5873 C Calculate the multi-body contribution to energy.
5874 C Calculate multi-body contributions to the gradient.
5875 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5876 cd & k,l,(gacont(m,kk,k),m=1,3)
5878 gx(m) =ekl*gacont(m,jj,i)
5879 gx1(m)=eij*gacont(m,kk,k)
5880 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5881 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5882 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5883 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5887 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5892 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5898 c------------------------------------------------------------------------------
5899 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5900 C This subroutine calculates multi-body contributions to hydrogen-bonding
5901 implicit real*8 (a-h,o-z)
5902 include 'DIMENSIONS'
5903 include 'COMMON.IOUNITS'
5906 parameter (max_cont=maxconts)
5907 parameter (max_dim=26)
5908 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5909 double precision zapas(max_dim,maxconts,max_fg_procs),
5910 & zapas_recv(max_dim,maxconts,max_fg_procs)
5911 common /przechowalnia/ zapas
5912 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5913 & status_array(MPI_STATUS_SIZE,maxconts*2)
5915 include 'COMMON.SETUP'
5916 include 'COMMON.FFIELD'
5917 include 'COMMON.DERIV'
5918 include 'COMMON.INTERACT'
5919 include 'COMMON.CONTACTS'
5920 include 'COMMON.CONTROL'
5921 include 'COMMON.LOCAL'
5922 double precision gx(3),gx1(3),time00
5925 C Set lprn=.true. for debugging
5930 if (nfgtasks.le.1) goto 30
5932 write (iout,'(a)') 'Contact function values before RECEIVE:'
5934 write (iout,'(2i3,50(1x,i2,f5.2))')
5935 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5936 & j=1,num_cont_hb(i))
5940 do i=1,ntask_cont_from
5943 do i=1,ntask_cont_to
5946 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5948 C Make the list of contacts to send to send to other procesors
5949 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5951 do i=iturn3_start,iturn3_end
5952 c write (iout,*) "make contact list turn3",i," num_cont",
5954 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5956 do i=iturn4_start,iturn4_end
5957 c write (iout,*) "make contact list turn4",i," num_cont",
5959 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5963 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5965 do j=1,num_cont_hb(i)
5968 iproc=iint_sent_local(k,jjc,ii)
5969 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5970 if (iproc.gt.0) then
5971 ncont_sent(iproc)=ncont_sent(iproc)+1
5972 nn=ncont_sent(iproc)
5974 zapas(2,nn,iproc)=jjc
5975 zapas(3,nn,iproc)=facont_hb(j,i)
5976 zapas(4,nn,iproc)=ees0p(j,i)
5977 zapas(5,nn,iproc)=ees0m(j,i)
5978 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5979 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5980 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5981 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5982 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5983 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5984 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5985 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5986 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5987 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5988 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5989 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5990 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5991 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5992 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5993 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5994 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5995 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5996 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5997 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5998 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6005 & "Numbers of contacts to be sent to other processors",
6006 & (ncont_sent(i),i=1,ntask_cont_to)
6007 write (iout,*) "Contacts sent"
6008 do ii=1,ntask_cont_to
6010 iproc=itask_cont_to(ii)
6011 write (iout,*) nn," contacts to processor",iproc,
6012 & " of CONT_TO_COMM group"
6014 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6022 CorrelID1=nfgtasks+fg_rank+1
6024 C Receive the numbers of needed contacts from other processors
6025 do ii=1,ntask_cont_from
6026 iproc=itask_cont_from(ii)
6028 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6029 & FG_COMM,req(ireq),IERR)
6031 c write (iout,*) "IRECV ended"
6033 C Send the number of contacts needed by other processors
6034 do ii=1,ntask_cont_to
6035 iproc=itask_cont_to(ii)
6037 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6038 & FG_COMM,req(ireq),IERR)
6040 c write (iout,*) "ISEND ended"
6041 c write (iout,*) "number of requests (nn)",ireq
6044 & call MPI_Waitall(ireq,req,status_array,ierr)
6046 c & "Numbers of contacts to be received from other processors",
6047 c & (ncont_recv(i),i=1,ntask_cont_from)
6051 do ii=1,ntask_cont_from
6052 iproc=itask_cont_from(ii)
6054 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6055 c & " of CONT_TO_COMM group"
6059 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6060 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6061 c write (iout,*) "ireq,req",ireq,req(ireq)
6064 C Send the contacts to processors that need them
6065 do ii=1,ntask_cont_to
6066 iproc=itask_cont_to(ii)
6068 c write (iout,*) nn," contacts to processor",iproc,
6069 c & " of CONT_TO_COMM group"
6072 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6073 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6074 c write (iout,*) "ireq,req",ireq,req(ireq)
6076 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6080 c write (iout,*) "number of requests (contacts)",ireq
6081 c write (iout,*) "req",(req(i),i=1,4)
6084 & call MPI_Waitall(ireq,req,status_array,ierr)
6085 do iii=1,ntask_cont_from
6086 iproc=itask_cont_from(iii)
6089 write (iout,*) "Received",nn," contacts from processor",iproc,
6090 & " of CONT_FROM_COMM group"
6093 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6098 ii=zapas_recv(1,i,iii)
6099 c Flag the received contacts to prevent double-counting
6100 jj=-zapas_recv(2,i,iii)
6101 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6103 nnn=num_cont_hb(ii)+1
6106 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6107 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6108 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6109 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6110 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6111 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6112 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6113 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6114 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6115 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6116 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6117 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6118 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6119 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6120 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6121 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6122 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6123 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6124 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6125 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6126 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6127 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6128 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6129 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6134 write (iout,'(a)') 'Contact function values after receive:'
6136 write (iout,'(2i3,50(1x,i3,f5.2))')
6137 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6138 & j=1,num_cont_hb(i))
6145 write (iout,'(a)') 'Contact function values:'
6147 write (iout,'(2i3,50(1x,i3,f5.2))')
6148 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6149 & j=1,num_cont_hb(i))
6153 C Remove the loop below after debugging !!!
6160 C Calculate the local-electrostatic correlation terms
6161 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6163 num_conti=num_cont_hb(i)
6164 num_conti1=num_cont_hb(i+1)
6171 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6172 c & ' jj=',jj,' kk=',kk
6173 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6174 & .or. j.lt.0 .and. j1.gt.0) .and.
6175 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6176 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6177 C The system gains extra energy.
6178 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6179 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6180 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6182 else if (j1.eq.j) then
6183 C Contacts I-J and I-(J+1) occur simultaneously.
6184 C The system loses extra energy.
6185 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6190 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6191 c & ' jj=',jj,' kk=',kk
6193 C Contacts I-J and (I+1)-J occur simultaneously.
6194 C The system loses extra energy.
6195 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6202 c------------------------------------------------------------------------------
6203 subroutine add_hb_contact(ii,jj,itask)
6204 implicit real*8 (a-h,o-z)
6205 include "DIMENSIONS"
6206 include "COMMON.IOUNITS"
6209 parameter (max_cont=maxconts)
6210 parameter (max_dim=26)
6211 include "COMMON.CONTACTS"
6212 double precision zapas(max_dim,maxconts,max_fg_procs),
6213 & zapas_recv(max_dim,maxconts,max_fg_procs)
6214 common /przechowalnia/ zapas
6215 integer i,j,ii,jj,iproc,itask(4),nn
6216 c write (iout,*) "itask",itask
6219 if (iproc.gt.0) then
6220 do j=1,num_cont_hb(ii)
6222 c write (iout,*) "i",ii," j",jj," jjc",jjc
6224 ncont_sent(iproc)=ncont_sent(iproc)+1
6225 nn=ncont_sent(iproc)
6226 zapas(1,nn,iproc)=ii
6227 zapas(2,nn,iproc)=jjc
6228 zapas(3,nn,iproc)=facont_hb(j,ii)
6229 zapas(4,nn,iproc)=ees0p(j,ii)
6230 zapas(5,nn,iproc)=ees0m(j,ii)
6231 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6232 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6233 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6234 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6235 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6236 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6237 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6238 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6239 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6240 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6241 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6242 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6243 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6244 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6245 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6246 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6247 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6248 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6249 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6250 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6251 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6259 c------------------------------------------------------------------------------
6260 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6262 C This subroutine calculates multi-body contributions to hydrogen-bonding
6263 implicit real*8 (a-h,o-z)
6264 include 'DIMENSIONS'
6265 include 'COMMON.IOUNITS'
6268 parameter (max_cont=maxconts)
6269 parameter (max_dim=70)
6270 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6271 double precision zapas(max_dim,maxconts,max_fg_procs),
6272 & zapas_recv(max_dim,maxconts,max_fg_procs)
6273 common /przechowalnia/ zapas
6274 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6275 & status_array(MPI_STATUS_SIZE,maxconts*2)
6277 include 'COMMON.SETUP'
6278 include 'COMMON.FFIELD'
6279 include 'COMMON.DERIV'
6280 include 'COMMON.LOCAL'
6281 include 'COMMON.INTERACT'
6282 include 'COMMON.CONTACTS'
6283 include 'COMMON.CHAIN'
6284 include 'COMMON.CONTROL'
6285 double precision gx(3),gx1(3)
6286 integer num_cont_hb_old(maxres)
6288 double precision eello4,eello5,eelo6,eello_turn6
6289 external eello4,eello5,eello6,eello_turn6
6290 C Set lprn=.true. for debugging
6295 num_cont_hb_old(i)=num_cont_hb(i)
6299 if (nfgtasks.le.1) goto 30
6301 write (iout,'(a)') 'Contact function values before RECEIVE:'
6303 write (iout,'(2i3,50(1x,i2,f5.2))')
6304 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6305 & j=1,num_cont_hb(i))
6309 do i=1,ntask_cont_from
6312 do i=1,ntask_cont_to
6315 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6317 C Make the list of contacts to send to send to other procesors
6318 do i=iturn3_start,iturn3_end
6319 c write (iout,*) "make contact list turn3",i," num_cont",
6321 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6323 do i=iturn4_start,iturn4_end
6324 c write (iout,*) "make contact list turn4",i," num_cont",
6326 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6330 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6332 do j=1,num_cont_hb(i)
6335 iproc=iint_sent_local(k,jjc,ii)
6336 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6337 if (iproc.ne.0) then
6338 ncont_sent(iproc)=ncont_sent(iproc)+1
6339 nn=ncont_sent(iproc)
6341 zapas(2,nn,iproc)=jjc
6342 zapas(3,nn,iproc)=d_cont(j,i)
6346 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6351 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6359 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6370 & "Numbers of contacts to be sent to other processors",
6371 & (ncont_sent(i),i=1,ntask_cont_to)
6372 write (iout,*) "Contacts sent"
6373 do ii=1,ntask_cont_to
6375 iproc=itask_cont_to(ii)
6376 write (iout,*) nn," contacts to processor",iproc,
6377 & " of CONT_TO_COMM group"
6379 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6387 CorrelID1=nfgtasks+fg_rank+1
6389 C Receive the numbers of needed contacts from other processors
6390 do ii=1,ntask_cont_from
6391 iproc=itask_cont_from(ii)
6393 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6394 & FG_COMM,req(ireq),IERR)
6396 c write (iout,*) "IRECV ended"
6398 C Send the number of contacts needed by other processors
6399 do ii=1,ntask_cont_to
6400 iproc=itask_cont_to(ii)
6402 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6403 & FG_COMM,req(ireq),IERR)
6405 c write (iout,*) "ISEND ended"
6406 c write (iout,*) "number of requests (nn)",ireq
6409 & call MPI_Waitall(ireq,req,status_array,ierr)
6411 c & "Numbers of contacts to be received from other processors",
6412 c & (ncont_recv(i),i=1,ntask_cont_from)
6416 do ii=1,ntask_cont_from
6417 iproc=itask_cont_from(ii)
6419 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6420 c & " of CONT_TO_COMM group"
6424 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6425 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6426 c write (iout,*) "ireq,req",ireq,req(ireq)
6429 C Send the contacts to processors that need them
6430 do ii=1,ntask_cont_to
6431 iproc=itask_cont_to(ii)
6433 c write (iout,*) nn," contacts to processor",iproc,
6434 c & " of CONT_TO_COMM group"
6437 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6438 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6439 c write (iout,*) "ireq,req",ireq,req(ireq)
6441 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6445 c write (iout,*) "number of requests (contacts)",ireq
6446 c write (iout,*) "req",(req(i),i=1,4)
6449 & call MPI_Waitall(ireq,req,status_array,ierr)
6450 do iii=1,ntask_cont_from
6451 iproc=itask_cont_from(iii)
6454 write (iout,*) "Received",nn," contacts from processor",iproc,
6455 & " of CONT_FROM_COMM group"
6458 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6463 ii=zapas_recv(1,i,iii)
6464 c Flag the received contacts to prevent double-counting
6465 jj=-zapas_recv(2,i,iii)
6466 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6468 nnn=num_cont_hb(ii)+1
6471 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6475 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6480 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6488 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6497 write (iout,'(a)') 'Contact function values after receive:'
6499 write (iout,'(2i3,50(1x,i3,5f6.3))')
6500 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6501 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6508 write (iout,'(a)') 'Contact function values:'
6510 write (iout,'(2i3,50(1x,i2,5f6.3))')
6511 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6512 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6518 C Remove the loop below after debugging !!!
6525 C Calculate the dipole-dipole interaction energies
6526 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6527 do i=iatel_s,iatel_e+1
6528 num_conti=num_cont_hb(i)
6537 C Calculate the local-electrostatic correlation terms
6538 c write (iout,*) "gradcorr5 in eello5 before loop"
6540 c write (iout,'(i5,3f10.5)')
6541 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6543 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6544 c write (iout,*) "corr loop i",i
6546 num_conti=num_cont_hb(i)
6547 num_conti1=num_cont_hb(i+1)
6554 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6555 c & ' jj=',jj,' kk=',kk
6556 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6557 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6558 & .or. j.lt.0 .and. j1.gt.0) .and.
6559 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6560 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6561 C The system gains extra energy.
6563 sqd1=dsqrt(d_cont(jj,i))
6564 sqd2=dsqrt(d_cont(kk,i1))
6565 sred_geom = sqd1*sqd2
6566 IF (sred_geom.lt.cutoff_corr) THEN
6567 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6569 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6570 cd & ' jj=',jj,' kk=',kk
6571 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6572 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6574 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6575 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6578 cd write (iout,*) 'sred_geom=',sred_geom,
6579 cd & ' ekont=',ekont,' fprim=',fprimcont,
6580 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6581 cd write (iout,*) "g_contij",g_contij
6582 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6583 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6584 call calc_eello(i,jp,i+1,jp1,jj,kk)
6585 if (wcorr4.gt.0.0d0)
6586 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6587 if (energy_dec.and.wcorr4.gt.0.0d0)
6588 1 write (iout,'(a6,4i5,0pf7.3)')
6589 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6590 c write (iout,*) "gradcorr5 before eello5"
6592 c write (iout,'(i5,3f10.5)')
6593 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6595 if (wcorr5.gt.0.0d0)
6596 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6597 c write (iout,*) "gradcorr5 after eello5"
6599 c write (iout,'(i5,3f10.5)')
6600 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6602 if (energy_dec.and.wcorr5.gt.0.0d0)
6603 1 write (iout,'(a6,4i5,0pf7.3)')
6604 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6605 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6606 cd write(2,*)'ijkl',i,jp,i+1,jp1
6607 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6608 & .or. wturn6.eq.0.0d0))then
6609 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6610 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6611 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6612 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6613 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6614 cd & 'ecorr6=',ecorr6
6615 cd write (iout,'(4e15.5)') sred_geom,
6616 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6617 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6618 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6619 else if (wturn6.gt.0.0d0
6620 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6621 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6622 eturn6=eturn6+eello_turn6(i,jj,kk)
6623 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6624 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6625 cd write (2,*) 'multibody_eello:eturn6',eturn6
6634 num_cont_hb(i)=num_cont_hb_old(i)
6636 c write (iout,*) "gradcorr5 in eello5"
6638 c write (iout,'(i5,3f10.5)')
6639 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6643 c------------------------------------------------------------------------------
6644 subroutine add_hb_contact_eello(ii,jj,itask)
6645 implicit real*8 (a-h,o-z)
6646 include "DIMENSIONS"
6647 include "COMMON.IOUNITS"
6650 parameter (max_cont=maxconts)
6651 parameter (max_dim=70)
6652 include "COMMON.CONTACTS"
6653 double precision zapas(max_dim,maxconts,max_fg_procs),
6654 & zapas_recv(max_dim,maxconts,max_fg_procs)
6655 common /przechowalnia/ zapas
6656 integer i,j,ii,jj,iproc,itask(4),nn
6657 c write (iout,*) "itask",itask
6660 if (iproc.gt.0) then
6661 do j=1,num_cont_hb(ii)
6663 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6665 ncont_sent(iproc)=ncont_sent(iproc)+1
6666 nn=ncont_sent(iproc)
6667 zapas(1,nn,iproc)=ii
6668 zapas(2,nn,iproc)=jjc
6669 zapas(3,nn,iproc)=d_cont(j,ii)
6673 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6678 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6686 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6698 c------------------------------------------------------------------------------
6699 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6700 implicit real*8 (a-h,o-z)
6701 include 'DIMENSIONS'
6702 include 'COMMON.IOUNITS'
6703 include 'COMMON.DERIV'
6704 include 'COMMON.INTERACT'
6705 include 'COMMON.CONTACTS'
6706 double precision gx(3),gx1(3)
6716 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6717 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6718 C Following 4 lines for diagnostics.
6723 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6724 c & 'Contacts ',i,j,
6725 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6726 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6728 C Calculate the multi-body contribution to energy.
6729 c ecorr=ecorr+ekont*ees
6730 C Calculate multi-body contributions to the gradient.
6731 coeffpees0pij=coeffp*ees0pij
6732 coeffmees0mij=coeffm*ees0mij
6733 coeffpees0pkl=coeffp*ees0pkl
6734 coeffmees0mkl=coeffm*ees0mkl
6736 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6737 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6738 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6739 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6740 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6741 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6742 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6743 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6744 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6745 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6746 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6747 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6748 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6749 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6750 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6751 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6752 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6753 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6754 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6755 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6756 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6757 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6758 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6759 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6760 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6765 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6766 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6767 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6768 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6773 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6774 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6775 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6776 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6779 c write (iout,*) "ehbcorr",ekont*ees
6784 C---------------------------------------------------------------------------
6785 subroutine dipole(i,j,jj)
6786 implicit real*8 (a-h,o-z)
6787 include 'DIMENSIONS'
6788 include 'COMMON.IOUNITS'
6789 include 'COMMON.CHAIN'
6790 include 'COMMON.FFIELD'
6791 include 'COMMON.DERIV'
6792 include 'COMMON.INTERACT'
6793 include 'COMMON.CONTACTS'
6794 include 'COMMON.TORSION'
6795 include 'COMMON.VAR'
6796 include 'COMMON.GEO'
6797 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6799 iti1 = itortyp(itype(i+1))
6800 if (j.lt.nres-1) then
6801 itj1 = itortyp(itype(j+1))
6806 dipi(iii,1)=Ub2(iii,i)
6807 dipderi(iii)=Ub2der(iii,i)
6808 dipi(iii,2)=b1(iii,iti1)
6809 dipj(iii,1)=Ub2(iii,j)
6810 dipderj(iii)=Ub2der(iii,j)
6811 dipj(iii,2)=b1(iii,itj1)
6815 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6818 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6825 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6829 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6834 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6835 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6837 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6839 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6841 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6846 C---------------------------------------------------------------------------
6847 subroutine calc_eello(i,j,k,l,jj,kk)
6849 C This subroutine computes matrices and vectors needed to calculate
6850 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6852 implicit real*8 (a-h,o-z)
6853 include 'DIMENSIONS'
6854 include 'COMMON.IOUNITS'
6855 include 'COMMON.CHAIN'
6856 include 'COMMON.DERIV'
6857 include 'COMMON.INTERACT'
6858 include 'COMMON.CONTACTS'
6859 include 'COMMON.TORSION'
6860 include 'COMMON.VAR'
6861 include 'COMMON.GEO'
6862 include 'COMMON.FFIELD'
6863 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6864 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6867 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6868 cd & ' jj=',jj,' kk=',kk
6869 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6870 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6871 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6874 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6875 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6878 call transpose2(aa1(1,1),aa1t(1,1))
6879 call transpose2(aa2(1,1),aa2t(1,1))
6882 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6883 & aa1tder(1,1,lll,kkk))
6884 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6885 & aa2tder(1,1,lll,kkk))
6889 C parallel orientation of the two CA-CA-CA frames.
6891 iti=itortyp(itype(i))
6895 itk1=itortyp(itype(k+1))
6896 itj=itortyp(itype(j))
6897 if (l.lt.nres-1) then
6898 itl1=itortyp(itype(l+1))
6902 C A1 kernel(j+1) A2T
6904 cd write (iout,'(3f10.5,5x,3f10.5)')
6905 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6907 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6908 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6909 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6910 C Following matrices are needed only for 6-th order cumulants
6911 IF (wcorr6.gt.0.0d0) THEN
6912 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6913 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6914 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6915 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6916 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6917 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6918 & ADtEAderx(1,1,1,1,1,1))
6920 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6921 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6922 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6923 & ADtEA1derx(1,1,1,1,1,1))
6925 C End 6-th order cumulants
6928 cd write (2,*) 'In calc_eello6'
6930 cd write (2,*) 'iii=',iii
6932 cd write (2,*) 'kkk=',kkk
6934 cd write (2,'(3(2f10.5),5x)')
6935 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6940 call transpose2(EUgder(1,1,k),auxmat(1,1))
6941 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6942 call transpose2(EUg(1,1,k),auxmat(1,1))
6943 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6944 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6948 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6949 & EAEAderx(1,1,lll,kkk,iii,1))
6953 C A1T kernel(i+1) A2
6954 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6955 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6956 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6957 C Following matrices are needed only for 6-th order cumulants
6958 IF (wcorr6.gt.0.0d0) THEN
6959 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6960 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6961 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6962 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6963 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6964 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6965 & ADtEAderx(1,1,1,1,1,2))
6966 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6967 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6968 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6969 & ADtEA1derx(1,1,1,1,1,2))
6971 C End 6-th order cumulants
6972 call transpose2(EUgder(1,1,l),auxmat(1,1))
6973 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6974 call transpose2(EUg(1,1,l),auxmat(1,1))
6975 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6976 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6980 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6981 & EAEAderx(1,1,lll,kkk,iii,2))
6986 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6987 C They are needed only when the fifth- or the sixth-order cumulants are
6989 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6990 call transpose2(AEA(1,1,1),auxmat(1,1))
6991 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6992 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6993 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6994 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6995 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6996 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6997 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6998 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6999 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7000 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7001 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7002 call transpose2(AEA(1,1,2),auxmat(1,1))
7003 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7004 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7005 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7006 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7007 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7008 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7009 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7010 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7011 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7012 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7013 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7014 C Calculate the Cartesian derivatives of the vectors.
7018 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7019 call matvec2(auxmat(1,1),b1(1,iti),
7020 & AEAb1derx(1,lll,kkk,iii,1,1))
7021 call matvec2(auxmat(1,1),Ub2(1,i),
7022 & AEAb2derx(1,lll,kkk,iii,1,1))
7023 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7024 & AEAb1derx(1,lll,kkk,iii,2,1))
7025 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7026 & AEAb2derx(1,lll,kkk,iii,2,1))
7027 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7028 call matvec2(auxmat(1,1),b1(1,itj),
7029 & AEAb1derx(1,lll,kkk,iii,1,2))
7030 call matvec2(auxmat(1,1),Ub2(1,j),
7031 & AEAb2derx(1,lll,kkk,iii,1,2))
7032 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7033 & AEAb1derx(1,lll,kkk,iii,2,2))
7034 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7035 & AEAb2derx(1,lll,kkk,iii,2,2))
7042 C Antiparallel orientation of the two CA-CA-CA frames.
7044 iti=itortyp(itype(i))
7048 itk1=itortyp(itype(k+1))
7049 itl=itortyp(itype(l))
7050 itj=itortyp(itype(j))
7051 if (j.lt.nres-1) then
7052 itj1=itortyp(itype(j+1))
7056 C A2 kernel(j-1)T A1T
7057 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7058 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7059 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7060 C Following matrices are needed only for 6-th order cumulants
7061 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7062 & j.eq.i+4 .and. l.eq.i+3)) THEN
7063 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7064 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7065 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7066 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7067 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7068 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7069 & ADtEAderx(1,1,1,1,1,1))
7070 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7071 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7072 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7073 & ADtEA1derx(1,1,1,1,1,1))
7075 C End 6-th order cumulants
7076 call transpose2(EUgder(1,1,k),auxmat(1,1))
7077 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7078 call transpose2(EUg(1,1,k),auxmat(1,1))
7079 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7080 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7084 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7085 & EAEAderx(1,1,lll,kkk,iii,1))
7089 C A2T kernel(i+1)T A1
7090 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7091 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7092 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7093 C Following matrices are needed only for 6-th order cumulants
7094 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7095 & j.eq.i+4 .and. l.eq.i+3)) THEN
7096 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7097 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7098 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7099 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7100 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7101 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7102 & ADtEAderx(1,1,1,1,1,2))
7103 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7104 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7105 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7106 & ADtEA1derx(1,1,1,1,1,2))
7108 C End 6-th order cumulants
7109 call transpose2(EUgder(1,1,j),auxmat(1,1))
7110 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7111 call transpose2(EUg(1,1,j),auxmat(1,1))
7112 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7113 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7117 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7118 & EAEAderx(1,1,lll,kkk,iii,2))
7123 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7124 C They are needed only when the fifth- or the sixth-order cumulants are
7126 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7127 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7128 call transpose2(AEA(1,1,1),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7130 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7131 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7132 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7133 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7134 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7135 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7136 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7137 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7138 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7139 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7140 call transpose2(AEA(1,1,2),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7142 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7143 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7144 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7145 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7146 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7147 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7148 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7149 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7150 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7151 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7152 C Calculate the Cartesian derivatives of the vectors.
7156 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7157 call matvec2(auxmat(1,1),b1(1,iti),
7158 & AEAb1derx(1,lll,kkk,iii,1,1))
7159 call matvec2(auxmat(1,1),Ub2(1,i),
7160 & AEAb2derx(1,lll,kkk,iii,1,1))
7161 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7162 & AEAb1derx(1,lll,kkk,iii,2,1))
7163 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7164 & AEAb2derx(1,lll,kkk,iii,2,1))
7165 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7166 call matvec2(auxmat(1,1),b1(1,itl),
7167 & AEAb1derx(1,lll,kkk,iii,1,2))
7168 call matvec2(auxmat(1,1),Ub2(1,l),
7169 & AEAb2derx(1,lll,kkk,iii,1,2))
7170 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7171 & AEAb1derx(1,lll,kkk,iii,2,2))
7172 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7173 & AEAb2derx(1,lll,kkk,iii,2,2))
7182 C---------------------------------------------------------------------------
7183 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7184 & KK,KKderg,AKA,AKAderg,AKAderx)
7188 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7189 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7190 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7195 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7197 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7200 cd if (lprn) write (2,*) 'In kernel'
7202 cd if (lprn) write (2,*) 'kkk=',kkk
7204 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7205 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7207 cd write (2,*) 'lll=',lll
7208 cd write (2,*) 'iii=1'
7210 cd write (2,'(3(2f10.5),5x)')
7211 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7214 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7215 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7217 cd write (2,*) 'lll=',lll
7218 cd write (2,*) 'iii=2'
7220 cd write (2,'(3(2f10.5),5x)')
7221 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7228 C---------------------------------------------------------------------------
7229 double precision function eello4(i,j,k,l,jj,kk)
7230 implicit real*8 (a-h,o-z)
7231 include 'DIMENSIONS'
7232 include 'COMMON.IOUNITS'
7233 include 'COMMON.CHAIN'
7234 include 'COMMON.DERIV'
7235 include 'COMMON.INTERACT'
7236 include 'COMMON.CONTACTS'
7237 include 'COMMON.TORSION'
7238 include 'COMMON.VAR'
7239 include 'COMMON.GEO'
7240 double precision pizda(2,2),ggg1(3),ggg2(3)
7241 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7245 cd print *,'eello4:',i,j,k,l,jj,kk
7246 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7247 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7248 cold eij=facont_hb(jj,i)
7249 cold ekl=facont_hb(kk,k)
7251 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7252 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7253 gcorr_loc(k-1)=gcorr_loc(k-1)
7254 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7256 gcorr_loc(l-1)=gcorr_loc(l-1)
7257 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7259 gcorr_loc(j-1)=gcorr_loc(j-1)
7260 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7265 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7266 & -EAEAderx(2,2,lll,kkk,iii,1)
7267 cd derx(lll,kkk,iii)=0.0d0
7271 cd gcorr_loc(l-1)=0.0d0
7272 cd gcorr_loc(j-1)=0.0d0
7273 cd gcorr_loc(k-1)=0.0d0
7275 cd write (iout,*)'Contacts have occurred for peptide groups',
7276 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7277 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7278 if (j.lt.nres-1) then
7285 if (l.lt.nres-1) then
7293 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7294 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7295 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7296 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7297 cgrad ghalf=0.5d0*ggg1(ll)
7298 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7299 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7300 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7301 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7302 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7303 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7304 cgrad ghalf=0.5d0*ggg2(ll)
7305 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7306 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7307 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7308 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7309 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7310 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7314 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7319 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7324 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7329 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7333 cd write (2,*) iii,gcorr_loc(iii)
7336 cd write (2,*) 'ekont',ekont
7337 cd write (iout,*) 'eello4',ekont*eel4
7340 C---------------------------------------------------------------------------
7341 double precision function eello5(i,j,k,l,jj,kk)
7342 implicit real*8 (a-h,o-z)
7343 include 'DIMENSIONS'
7344 include 'COMMON.IOUNITS'
7345 include 'COMMON.CHAIN'
7346 include 'COMMON.DERIV'
7347 include 'COMMON.INTERACT'
7348 include 'COMMON.CONTACTS'
7349 include 'COMMON.TORSION'
7350 include 'COMMON.VAR'
7351 include 'COMMON.GEO'
7352 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7353 double precision ggg1(3),ggg2(3)
7354 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7359 C /l\ / \ \ / \ / \ / C
7360 C / \ / \ \ / \ / \ / C
7361 C j| o |l1 | o | o| o | | o |o C
7362 C \ |/k\| |/ \| / |/ \| |/ \| C
7363 C \i/ \ / \ / / \ / \ C
7365 C (I) (II) (III) (IV) C
7367 C eello5_1 eello5_2 eello5_3 eello5_4 C
7369 C Antiparallel chains C
7372 C /j\ / \ \ / \ / \ / C
7373 C / \ / \ \ / \ / \ / C
7374 C j1| o |l | o | o| o | | o |o C
7375 C \ |/k\| |/ \| / |/ \| |/ \| C
7376 C \i/ \ / \ / / \ / \ C
7378 C (I) (II) (III) (IV) C
7380 C eello5_1 eello5_2 eello5_3 eello5_4 C
7382 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7384 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7385 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7390 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7392 itk=itortyp(itype(k))
7393 itl=itortyp(itype(l))
7394 itj=itortyp(itype(j))
7399 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7400 cd & eel5_3_num,eel5_4_num)
7404 derx(lll,kkk,iii)=0.0d0
7408 cd eij=facont_hb(jj,i)
7409 cd ekl=facont_hb(kk,k)
7411 cd write (iout,*)'Contacts have occurred for peptide groups',
7412 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7414 C Contribution from the graph I.
7415 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7416 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7417 call transpose2(EUg(1,1,k),auxmat(1,1))
7418 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7419 vv(1)=pizda(1,1)-pizda(2,2)
7420 vv(2)=pizda(1,2)+pizda(2,1)
7421 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7422 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7423 C Explicit gradient in virtual-dihedral angles.
7424 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7425 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7426 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7427 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7428 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7429 vv(1)=pizda(1,1)-pizda(2,2)
7430 vv(2)=pizda(1,2)+pizda(2,1)
7431 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7432 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7433 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7434 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7435 vv(1)=pizda(1,1)-pizda(2,2)
7436 vv(2)=pizda(1,2)+pizda(2,1)
7438 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7439 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7440 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7442 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7443 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7444 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7446 C Cartesian gradient
7450 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7452 vv(1)=pizda(1,1)-pizda(2,2)
7453 vv(2)=pizda(1,2)+pizda(2,1)
7454 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7455 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7456 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7462 C Contribution from graph II
7463 call transpose2(EE(1,1,itk),auxmat(1,1))
7464 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7465 vv(1)=pizda(1,1)+pizda(2,2)
7466 vv(2)=pizda(2,1)-pizda(1,2)
7467 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7468 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7469 C Explicit gradient in virtual-dihedral angles.
7470 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7471 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7472 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7473 vv(1)=pizda(1,1)+pizda(2,2)
7474 vv(2)=pizda(2,1)-pizda(1,2)
7476 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7477 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7478 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7480 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7481 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7482 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7484 C Cartesian gradient
7488 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7490 vv(1)=pizda(1,1)+pizda(2,2)
7491 vv(2)=pizda(2,1)-pizda(1,2)
7492 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7493 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7494 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7502 C Parallel orientation
7503 C Contribution from graph III
7504 call transpose2(EUg(1,1,l),auxmat(1,1))
7505 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7506 vv(1)=pizda(1,1)-pizda(2,2)
7507 vv(2)=pizda(1,2)+pizda(2,1)
7508 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7509 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7510 C Explicit gradient in virtual-dihedral angles.
7511 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7512 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7513 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7514 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7515 vv(1)=pizda(1,1)-pizda(2,2)
7516 vv(2)=pizda(1,2)+pizda(2,1)
7517 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7518 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7519 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7520 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7521 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7522 vv(1)=pizda(1,1)-pizda(2,2)
7523 vv(2)=pizda(1,2)+pizda(2,1)
7524 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7525 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7526 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7527 C Cartesian gradient
7531 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7533 vv(1)=pizda(1,1)-pizda(2,2)
7534 vv(2)=pizda(1,2)+pizda(2,1)
7535 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7536 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7537 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7542 C Contribution from graph IV
7544 call transpose2(EE(1,1,itl),auxmat(1,1))
7545 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7546 vv(1)=pizda(1,1)+pizda(2,2)
7547 vv(2)=pizda(2,1)-pizda(1,2)
7548 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7549 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7550 C Explicit gradient in virtual-dihedral angles.
7551 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7552 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7553 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7554 vv(1)=pizda(1,1)+pizda(2,2)
7555 vv(2)=pizda(2,1)-pizda(1,2)
7556 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7557 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7558 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7559 C Cartesian gradient
7563 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7565 vv(1)=pizda(1,1)+pizda(2,2)
7566 vv(2)=pizda(2,1)-pizda(1,2)
7567 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7568 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7569 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7574 C Antiparallel orientation
7575 C Contribution from graph III
7577 call transpose2(EUg(1,1,j),auxmat(1,1))
7578 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7582 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7583 C Explicit gradient in virtual-dihedral angles.
7584 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7585 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7586 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7587 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7588 vv(1)=pizda(1,1)-pizda(2,2)
7589 vv(2)=pizda(1,2)+pizda(2,1)
7590 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7591 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7592 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7593 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7594 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7595 vv(1)=pizda(1,1)-pizda(2,2)
7596 vv(2)=pizda(1,2)+pizda(2,1)
7597 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7598 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7599 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7600 C Cartesian gradient
7604 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7606 vv(1)=pizda(1,1)-pizda(2,2)
7607 vv(2)=pizda(1,2)+pizda(2,1)
7608 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7609 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7610 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7615 C Contribution from graph IV
7617 call transpose2(EE(1,1,itj),auxmat(1,1))
7618 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7619 vv(1)=pizda(1,1)+pizda(2,2)
7620 vv(2)=pizda(2,1)-pizda(1,2)
7621 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7622 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7623 C Explicit gradient in virtual-dihedral angles.
7624 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7625 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7626 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7629 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7630 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7631 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7632 C Cartesian gradient
7636 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7638 vv(1)=pizda(1,1)+pizda(2,2)
7639 vv(2)=pizda(2,1)-pizda(1,2)
7640 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7641 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7642 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7648 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7649 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7650 cd write (2,*) 'ijkl',i,j,k,l
7651 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7652 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7654 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7655 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7656 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7657 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7658 if (j.lt.nres-1) then
7665 if (l.lt.nres-1) then
7675 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7676 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7677 C summed up outside the subrouine as for the other subroutines
7678 C handling long-range interactions. The old code is commented out
7679 C with "cgrad" to keep track of changes.
7681 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7682 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7683 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7684 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7685 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7686 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7687 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7688 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7689 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7690 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7692 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7693 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7694 cgrad ghalf=0.5d0*ggg1(ll)
7696 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7697 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7698 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7699 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7700 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7701 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7702 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7703 cgrad ghalf=0.5d0*ggg2(ll)
7705 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7706 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7707 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7708 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7709 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7710 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7715 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7716 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7721 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7722 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7728 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7733 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7737 cd write (2,*) iii,g_corr5_loc(iii)
7740 cd write (2,*) 'ekont',ekont
7741 cd write (iout,*) 'eello5',ekont*eel5
7744 c--------------------------------------------------------------------------
7745 double precision function eello6(i,j,k,l,jj,kk)
7746 implicit real*8 (a-h,o-z)
7747 include 'DIMENSIONS'
7748 include 'COMMON.IOUNITS'
7749 include 'COMMON.CHAIN'
7750 include 'COMMON.DERIV'
7751 include 'COMMON.INTERACT'
7752 include 'COMMON.CONTACTS'
7753 include 'COMMON.TORSION'
7754 include 'COMMON.VAR'
7755 include 'COMMON.GEO'
7756 include 'COMMON.FFIELD'
7757 double precision ggg1(3),ggg2(3)
7758 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7763 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7771 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7772 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7776 derx(lll,kkk,iii)=0.0d0
7780 cd eij=facont_hb(jj,i)
7781 cd ekl=facont_hb(kk,k)
7787 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7788 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7789 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7790 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7791 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7792 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7794 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7795 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7796 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7797 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7798 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7799 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7803 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7805 C If turn contributions are considered, they will be handled separately.
7806 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7807 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7808 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7809 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7810 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7811 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7812 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7814 if (j.lt.nres-1) then
7821 if (l.lt.nres-1) then
7829 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7830 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7831 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7832 cgrad ghalf=0.5d0*ggg1(ll)
7834 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7835 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7836 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7837 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7838 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7839 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7840 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7841 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7842 cgrad ghalf=0.5d0*ggg2(ll)
7843 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7845 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7846 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7847 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7848 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7849 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7850 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7855 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7856 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7861 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7862 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7868 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7873 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7877 cd write (2,*) iii,g_corr6_loc(iii)
7880 cd write (2,*) 'ekont',ekont
7881 cd write (iout,*) 'eello6',ekont*eel6
7884 c--------------------------------------------------------------------------
7885 double precision function eello6_graph1(i,j,k,l,imat,swap)
7886 implicit real*8 (a-h,o-z)
7887 include 'DIMENSIONS'
7888 include 'COMMON.IOUNITS'
7889 include 'COMMON.CHAIN'
7890 include 'COMMON.DERIV'
7891 include 'COMMON.INTERACT'
7892 include 'COMMON.CONTACTS'
7893 include 'COMMON.TORSION'
7894 include 'COMMON.VAR'
7895 include 'COMMON.GEO'
7896 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7900 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7902 C Parallel Antiparallel C
7908 C \ j|/k\| / \ |/k\|l / C
7913 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7914 itk=itortyp(itype(k))
7915 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7916 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7917 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7918 call transpose2(EUgC(1,1,k),auxmat(1,1))
7919 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7920 vv1(1)=pizda1(1,1)-pizda1(2,2)
7921 vv1(2)=pizda1(1,2)+pizda1(2,1)
7922 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7923 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7924 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7925 s5=scalar2(vv(1),Dtobr2(1,i))
7926 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7927 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7928 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7929 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7930 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7931 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7932 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7933 & +scalar2(vv(1),Dtobr2der(1,i)))
7934 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7935 vv1(1)=pizda1(1,1)-pizda1(2,2)
7936 vv1(2)=pizda1(1,2)+pizda1(2,1)
7937 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7938 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7940 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7941 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7942 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7943 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7944 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7946 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7947 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7948 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7949 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7950 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7952 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7953 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7954 vv1(1)=pizda1(1,1)-pizda1(2,2)
7955 vv1(2)=pizda1(1,2)+pizda1(2,1)
7956 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7957 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7958 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7959 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7968 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7969 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7970 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7971 call transpose2(EUgC(1,1,k),auxmat(1,1))
7972 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7974 vv1(1)=pizda1(1,1)-pizda1(2,2)
7975 vv1(2)=pizda1(1,2)+pizda1(2,1)
7976 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7977 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7978 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7979 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7980 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7981 s5=scalar2(vv(1),Dtobr2(1,i))
7982 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7988 c----------------------------------------------------------------------------
7989 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7990 implicit real*8 (a-h,o-z)
7991 include 'DIMENSIONS'
7992 include 'COMMON.IOUNITS'
7993 include 'COMMON.CHAIN'
7994 include 'COMMON.DERIV'
7995 include 'COMMON.INTERACT'
7996 include 'COMMON.CONTACTS'
7997 include 'COMMON.TORSION'
7998 include 'COMMON.VAR'
7999 include 'COMMON.GEO'
8001 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8002 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8005 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8007 C Parallel Antiparallel C
8013 C \ j|/k\| \ |/k\|l C
8018 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8019 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8020 C AL 7/4/01 s1 would occur in the sixth-order moment,
8021 C but not in a cluster cumulant
8023 s1=dip(1,jj,i)*dip(1,kk,k)
8025 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8026 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8027 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8028 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8029 call transpose2(EUg(1,1,k),auxmat(1,1))
8030 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8031 vv(1)=pizda(1,1)-pizda(2,2)
8032 vv(2)=pizda(1,2)+pizda(2,1)
8033 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8034 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8036 eello6_graph2=-(s1+s2+s3+s4)
8038 eello6_graph2=-(s2+s3+s4)
8041 C Derivatives in gamma(i-1)
8044 s1=dipderg(1,jj,i)*dip(1,kk,k)
8046 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8047 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8048 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8049 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8051 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8053 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8055 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8057 C Derivatives in gamma(k-1)
8059 s1=dip(1,jj,i)*dipderg(1,kk,k)
8061 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8062 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8063 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8064 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8065 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8066 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8067 vv(1)=pizda(1,1)-pizda(2,2)
8068 vv(2)=pizda(1,2)+pizda(2,1)
8069 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8071 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8073 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8075 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8076 C Derivatives in gamma(j-1) or gamma(l-1)
8079 s1=dipderg(3,jj,i)*dip(1,kk,k)
8081 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8082 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8083 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8084 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8085 vv(1)=pizda(1,1)-pizda(2,2)
8086 vv(2)=pizda(1,2)+pizda(2,1)
8087 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8090 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8092 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8095 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8096 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8098 C Derivatives in gamma(l-1) or gamma(j-1)
8101 s1=dip(1,jj,i)*dipderg(3,kk,k)
8103 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8104 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8105 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8106 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8107 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8108 vv(1)=pizda(1,1)-pizda(2,2)
8109 vv(2)=pizda(1,2)+pizda(2,1)
8110 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8113 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8115 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8118 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8119 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8121 C Cartesian derivatives.
8123 write (2,*) 'In eello6_graph2'
8125 write (2,*) 'iii=',iii
8127 write (2,*) 'kkk=',kkk
8129 write (2,'(3(2f10.5),5x)')
8130 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8140 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8142 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8145 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8147 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8148 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8150 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8151 call transpose2(EUg(1,1,k),auxmat(1,1))
8152 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8154 vv(1)=pizda(1,1)-pizda(2,2)
8155 vv(2)=pizda(1,2)+pizda(2,1)
8156 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8157 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8159 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8161 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8164 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8166 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8173 c----------------------------------------------------------------------------
8174 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8175 implicit real*8 (a-h,o-z)
8176 include 'DIMENSIONS'
8177 include 'COMMON.IOUNITS'
8178 include 'COMMON.CHAIN'
8179 include 'COMMON.DERIV'
8180 include 'COMMON.INTERACT'
8181 include 'COMMON.CONTACTS'
8182 include 'COMMON.TORSION'
8183 include 'COMMON.VAR'
8184 include 'COMMON.GEO'
8185 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8187 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8189 C Parallel Antiparallel C
8195 C j|/k\| / |/k\|l / C
8200 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8202 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8203 C energy moment and not to the cluster cumulant.
8204 iti=itortyp(itype(i))
8205 if (j.lt.nres-1) then
8206 itj1=itortyp(itype(j+1))
8210 itk=itortyp(itype(k))
8211 itk1=itortyp(itype(k+1))
8212 if (l.lt.nres-1) then
8213 itl1=itortyp(itype(l+1))
8218 s1=dip(4,jj,i)*dip(4,kk,k)
8220 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8221 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8222 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8223 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8224 call transpose2(EE(1,1,itk),auxmat(1,1))
8225 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8226 vv(1)=pizda(1,1)+pizda(2,2)
8227 vv(2)=pizda(2,1)-pizda(1,2)
8228 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8229 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8230 cd & "sum",-(s2+s3+s4)
8232 eello6_graph3=-(s1+s2+s3+s4)
8234 eello6_graph3=-(s2+s3+s4)
8237 C Derivatives in gamma(k-1)
8238 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8239 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8240 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8241 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8242 C Derivatives in gamma(l-1)
8243 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8244 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8245 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8246 vv(1)=pizda(1,1)+pizda(2,2)
8247 vv(2)=pizda(2,1)-pizda(1,2)
8248 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8249 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8250 C Cartesian derivatives.
8256 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8258 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8261 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8263 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8264 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8266 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8267 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8269 vv(1)=pizda(1,1)+pizda(2,2)
8270 vv(2)=pizda(2,1)-pizda(1,2)
8271 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8273 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8275 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8278 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8280 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8282 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8288 c----------------------------------------------------------------------------
8289 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8290 implicit real*8 (a-h,o-z)
8291 include 'DIMENSIONS'
8292 include 'COMMON.IOUNITS'
8293 include 'COMMON.CHAIN'
8294 include 'COMMON.DERIV'
8295 include 'COMMON.INTERACT'
8296 include 'COMMON.CONTACTS'
8297 include 'COMMON.TORSION'
8298 include 'COMMON.VAR'
8299 include 'COMMON.GEO'
8300 include 'COMMON.FFIELD'
8301 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8302 & auxvec1(2),auxmat1(2,2)
8304 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8306 C Parallel Antiparallel C
8312 C \ j|/k\| \ |/k\|l C
8317 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8319 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8320 C energy moment and not to the cluster cumulant.
8321 cd write (2,*) 'eello_graph4: wturn6',wturn6
8322 iti=itortyp(itype(i))
8323 itj=itortyp(itype(j))
8324 if (j.lt.nres-1) then
8325 itj1=itortyp(itype(j+1))
8329 itk=itortyp(itype(k))
8330 if (k.lt.nres-1) then
8331 itk1=itortyp(itype(k+1))
8335 itl=itortyp(itype(l))
8336 if (l.lt.nres-1) then
8337 itl1=itortyp(itype(l+1))
8341 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8342 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8343 cd & ' itl',itl,' itl1',itl1
8346 s1=dip(3,jj,i)*dip(3,kk,k)
8348 s1=dip(2,jj,j)*dip(2,kk,l)
8351 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8352 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8354 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8355 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8357 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8358 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8360 call transpose2(EUg(1,1,k),auxmat(1,1))
8361 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8362 vv(1)=pizda(1,1)-pizda(2,2)
8363 vv(2)=pizda(2,1)+pizda(1,2)
8364 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8365 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8367 eello6_graph4=-(s1+s2+s3+s4)
8369 eello6_graph4=-(s2+s3+s4)
8371 C Derivatives in gamma(i-1)
8375 s1=dipderg(2,jj,i)*dip(3,kk,k)
8377 s1=dipderg(4,jj,j)*dip(2,kk,l)
8380 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8382 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8383 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8385 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8386 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8388 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8389 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8390 cd write (2,*) 'turn6 derivatives'
8392 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8394 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8398 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8400 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8404 C Derivatives in gamma(k-1)
8407 s1=dip(3,jj,i)*dipderg(2,kk,k)
8409 s1=dip(2,jj,j)*dipderg(4,kk,l)
8412 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8413 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8415 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8416 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8418 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8419 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8421 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8422 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8423 vv(1)=pizda(1,1)-pizda(2,2)
8424 vv(2)=pizda(2,1)+pizda(1,2)
8425 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8426 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8428 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8430 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8434 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8436 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8439 C Derivatives in gamma(j-1) or gamma(l-1)
8440 if (l.eq.j+1 .and. l.gt.1) then
8441 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8442 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8443 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8444 vv(1)=pizda(1,1)-pizda(2,2)
8445 vv(2)=pizda(2,1)+pizda(1,2)
8446 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8447 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8448 else if (j.gt.1) then
8449 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8450 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8451 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8452 vv(1)=pizda(1,1)-pizda(2,2)
8453 vv(2)=pizda(2,1)+pizda(1,2)
8454 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8455 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8456 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8458 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8461 C Cartesian derivatives.
8468 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8470 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8474 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8476 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8480 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8482 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8484 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8485 & b1(1,itj1),auxvec(1))
8486 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8488 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8489 & b1(1,itl1),auxvec(1))
8490 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8492 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8494 vv(1)=pizda(1,1)-pizda(2,2)
8495 vv(2)=pizda(2,1)+pizda(1,2)
8496 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8498 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8500 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8503 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8506 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8509 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8511 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8513 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8517 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8519 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8522 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8524 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8532 c----------------------------------------------------------------------------
8533 double precision function eello_turn6(i,jj,kk)
8534 implicit real*8 (a-h,o-z)
8535 include 'DIMENSIONS'
8536 include 'COMMON.IOUNITS'
8537 include 'COMMON.CHAIN'
8538 include 'COMMON.DERIV'
8539 include 'COMMON.INTERACT'
8540 include 'COMMON.CONTACTS'
8541 include 'COMMON.TORSION'
8542 include 'COMMON.VAR'
8543 include 'COMMON.GEO'
8544 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8545 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8547 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8548 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8549 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8550 C the respective energy moment and not to the cluster cumulant.
8559 iti=itortyp(itype(i))
8560 itk=itortyp(itype(k))
8561 itk1=itortyp(itype(k+1))
8562 itl=itortyp(itype(l))
8563 itj=itortyp(itype(j))
8564 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8565 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8566 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8571 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8573 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8577 derx_turn(lll,kkk,iii)=0.0d0
8584 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8586 cd write (2,*) 'eello6_5',eello6_5
8588 call transpose2(AEA(1,1,1),auxmat(1,1))
8589 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8590 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8591 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8593 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8594 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8595 s2 = scalar2(b1(1,itk),vtemp1(1))
8597 call transpose2(AEA(1,1,2),atemp(1,1))
8598 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8599 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8600 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8602 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8603 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8604 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8606 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8607 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8608 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8609 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8610 ss13 = scalar2(b1(1,itk),vtemp4(1))
8611 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8613 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8619 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8620 C Derivatives in gamma(i+2)
8624 call transpose2(AEA(1,1,1),auxmatd(1,1))
8625 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8626 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8627 call transpose2(AEAderg(1,1,2),atempd(1,1))
8628 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8629 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8631 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8632 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8633 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8639 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8640 C Derivatives in gamma(i+3)
8642 call transpose2(AEA(1,1,1),auxmatd(1,1))
8643 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8644 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8645 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8647 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8648 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8649 s2d = scalar2(b1(1,itk),vtemp1d(1))
8651 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8652 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8654 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8656 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8657 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8658 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8666 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8667 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8669 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8670 & -0.5d0*ekont*(s2d+s12d)
8672 C Derivatives in gamma(i+4)
8673 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8674 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8675 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8677 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8678 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8679 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8687 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8689 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8691 C Derivatives in gamma(i+5)
8693 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8694 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8695 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8697 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8698 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8699 s2d = scalar2(b1(1,itk),vtemp1d(1))
8701 call transpose2(AEA(1,1,2),atempd(1,1))
8702 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8703 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8705 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8706 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8708 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8709 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8710 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8718 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8719 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8721 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8722 & -0.5d0*ekont*(s2d+s12d)
8724 C Cartesian derivatives
8729 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8730 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8731 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8733 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8734 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8736 s2d = scalar2(b1(1,itk),vtemp1d(1))
8738 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8739 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8740 s8d = -(atempd(1,1)+atempd(2,2))*
8741 & scalar2(cc(1,1,itl),vtemp2(1))
8743 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8745 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8746 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8753 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8756 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8760 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8761 & - 0.5d0*(s8d+s12d)
8763 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8772 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8774 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8775 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8776 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8777 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8778 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8780 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8781 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8782 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8786 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8787 cd & 16*eel_turn6_num
8789 if (j.lt.nres-1) then
8796 if (l.lt.nres-1) then
8804 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8805 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8806 cgrad ghalf=0.5d0*ggg1(ll)
8808 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8809 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8810 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8811 & +ekont*derx_turn(ll,2,1)
8812 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8813 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8814 & +ekont*derx_turn(ll,4,1)
8815 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8816 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8817 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8818 cgrad ghalf=0.5d0*ggg2(ll)
8820 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8821 & +ekont*derx_turn(ll,2,2)
8822 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8823 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8824 & +ekont*derx_turn(ll,4,2)
8825 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8826 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8827 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8832 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8837 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8843 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8848 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8852 cd write (2,*) iii,g_corr6_loc(iii)
8854 eello_turn6=ekont*eel_turn6
8855 cd write (2,*) 'ekont',ekont
8856 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8860 C-----------------------------------------------------------------------------
8861 double precision function scalar(u,v)
8862 !DIR$ INLINEALWAYS scalar
8864 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8867 double precision u(3),v(3)
8868 cd double precision sc
8876 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8879 crc-------------------------------------------------
8880 SUBROUTINE MATVEC2(A1,V1,V2)
8881 !DIR$ INLINEALWAYS MATVEC2
8883 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8885 implicit real*8 (a-h,o-z)
8886 include 'DIMENSIONS'
8887 DIMENSION A1(2,2),V1(2),V2(2)
8891 c 3 VI=VI+A1(I,K)*V1(K)
8895 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8896 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8901 C---------------------------------------
8902 SUBROUTINE MATMAT2(A1,A2,A3)
8904 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8906 implicit real*8 (a-h,o-z)
8907 include 'DIMENSIONS'
8908 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8909 c DIMENSION AI3(2,2)
8913 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8919 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8920 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8921 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8922 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8930 c-------------------------------------------------------------------------
8931 double precision function scalar2(u,v)
8932 !DIR$ INLINEALWAYS scalar2
8934 double precision u(2),v(2)
8937 scalar2=u(1)*v(1)+u(2)*v(2)
8941 C-----------------------------------------------------------------------------
8943 subroutine transpose2(a,at)
8944 !DIR$ INLINEALWAYS transpose2
8946 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8949 double precision a(2,2),at(2,2)
8956 c--------------------------------------------------------------------------
8957 subroutine transpose(n,a,at)
8960 double precision a(n,n),at(n,n)
8968 C---------------------------------------------------------------------------
8969 subroutine prodmat3(a1,a2,kk,transp,prod)
8970 !DIR$ INLINEALWAYS prodmat3
8972 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8976 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8978 crc double precision auxmat(2,2),prod_(2,2)
8981 crc call transpose2(kk(1,1),auxmat(1,1))
8982 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8983 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8985 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8986 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8987 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8988 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8989 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8990 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8991 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8992 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8995 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8996 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8998 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8999 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9000 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9001 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9002 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9003 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9004 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9005 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9008 c call transpose2(a2(1,1),a2t(1,1))
9011 crc print *,((prod_(i,j),i=1,2),j=1,2)
9012 crc print *,((prod(i,j),i=1,2),j=1,2)