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 c write (iout,*) "coskt and sinkt"
4619 c 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)
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 + dsign(1.0,dfloat(itype(i)))
5092 & *z_prime(j)*dc_norm(j,i+nres)
5099 C Compute the energy of the ith side cbain
5101 c write (2,*) "xx",xx," yy",yy," zz",zz
5104 x(j) = sc_parmin(j,it)
5107 Cc diagnostics - remove later
5109 yy1 = dsin(alph(2))*dcos(omeg(2))
5110 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5111 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5112 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5114 C," --- ", xx_w,yy_w,zz_w
5117 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5118 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5120 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5121 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5123 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5124 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5125 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5126 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5127 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5129 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5130 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5131 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5132 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5133 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5135 dsc_i = 0.743d0+x(61)
5137 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5138 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5139 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5140 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5141 s1=(1+x(63))/(0.1d0 + dscp1)
5142 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5143 s2=(1+x(65))/(0.1d0 + dscp2)
5144 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5145 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5146 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5147 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5149 c & dscp1,dscp2,sumene
5150 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5151 escloc = escloc + sumene
5152 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 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5197 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5198 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5199 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5200 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5201 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5202 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5203 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5204 pom1=(sumene3*sint2tab(i+1)+sumene1)
5205 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5206 pom2=(sumene4*cost2tab(i+1)+sumene2)
5207 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5208 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5209 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5210 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5212 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5213 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5214 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5216 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5217 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5218 & +(pom1+pom2)*pom_dx
5220 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5223 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5224 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5225 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5227 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5228 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5229 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5230 & +x(59)*zz**2 +x(60)*xx*zz
5231 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5232 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5233 & +(pom1-pom2)*pom_dy
5235 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5238 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5239 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5240 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5241 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5242 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5243 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5244 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5245 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5247 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5250 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5251 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5252 & +pom1*pom_dt1+pom2*pom_dt2
5254 write(2,*), "de_dt = ", de_dt,de_dt_num
5258 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5259 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5260 cosfac2xx=cosfac2*xx
5261 sinfac2yy=sinfac2*yy
5263 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5265 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5267 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5268 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5269 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5270 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5271 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5272 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5273 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5274 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5275 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5276 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5280 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5281 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5284 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5285 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5286 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5288 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5289 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5293 dXX_Ctab(k,i)=dXX_Ci(k)
5294 dXX_C1tab(k,i)=dXX_Ci1(k)
5295 dYY_Ctab(k,i)=dYY_Ci(k)
5296 dYY_C1tab(k,i)=dYY_Ci1(k)
5297 dZZ_Ctab(k,i)=dZZ_Ci(k)
5298 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5299 dXX_XYZtab(k,i)=dXX_XYZ(k)
5300 dYY_XYZtab(k,i)=dYY_XYZ(k)
5301 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5305 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5306 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5307 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5308 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5309 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5311 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5312 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5313 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5314 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5315 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5316 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5317 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5318 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5320 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5321 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5323 C to check gradient call subroutine check_grad
5329 c------------------------------------------------------------------------------
5330 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5332 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5333 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5334 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5335 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5337 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5338 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5340 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5341 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5342 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5343 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5344 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5346 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5347 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5348 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5349 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5350 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5352 dsc_i = 0.743d0+x(61)
5354 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5355 & *(xx*cost2+yy*sint2))
5356 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5357 & *(xx*cost2-yy*sint2))
5358 s1=(1+x(63))/(0.1d0 + dscp1)
5359 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5360 s2=(1+x(65))/(0.1d0 + dscp2)
5361 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5362 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5363 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5368 c------------------------------------------------------------------------------
5369 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5371 C This procedure calculates two-body contact function g(rij) and its derivative:
5374 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5377 C where x=(rij-r0ij)/delta
5379 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5382 double precision rij,r0ij,eps0ij,fcont,fprimcont
5383 double precision x,x2,x4,delta
5387 if (x.lt.-1.0D0) then
5390 else if (x.le.1.0D0) then
5393 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5394 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5401 c------------------------------------------------------------------------------
5402 subroutine splinthet(theti,delta,ss,ssder)
5403 implicit real*8 (a-h,o-z)
5404 include 'DIMENSIONS'
5405 include 'COMMON.VAR'
5406 include 'COMMON.GEO'
5409 if (theti.gt.pipol) then
5410 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5412 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5417 c------------------------------------------------------------------------------
5418 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5420 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5421 double precision ksi,ksi2,ksi3,a1,a2,a3
5422 a1=fprim0*delta/(f1-f0)
5428 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5429 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5432 c------------------------------------------------------------------------------
5433 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5435 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5436 double precision ksi,ksi2,ksi3,a1,a2,a3
5441 a2=3*(f1x-f0x)-2*fprim0x*delta
5442 a3=fprim0x*delta-2*(f1x-f0x)
5443 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5446 C-----------------------------------------------------------------------------
5448 C-----------------------------------------------------------------------------
5449 subroutine etor(etors,edihcnstr)
5450 implicit real*8 (a-h,o-z)
5451 include 'DIMENSIONS'
5452 include 'COMMON.VAR'
5453 include 'COMMON.GEO'
5454 include 'COMMON.LOCAL'
5455 include 'COMMON.TORSION'
5456 include 'COMMON.INTERACT'
5457 include 'COMMON.DERIV'
5458 include 'COMMON.CHAIN'
5459 include 'COMMON.NAMES'
5460 include 'COMMON.IOUNITS'
5461 include 'COMMON.FFIELD'
5462 include 'COMMON.TORCNSTR'
5463 include 'COMMON.CONTROL'
5465 C Set lprn=.true. for debugging
5469 do i=iphi_start,iphi_end
5471 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5472 & .or. itype(i).eq.ntyp1) cycle
5473 itori=itortyp(itype(i-2))
5474 itori1=itortyp(itype(i-1))
5477 C Proline-Proline pair is a special case...
5478 if (itori.eq.3 .and. itori1.eq.3) then
5479 if (phii.gt.-dwapi3) then
5481 fac=1.0D0/(1.0D0-cosphi)
5482 etorsi=v1(1,3,3)*fac
5483 etorsi=etorsi+etorsi
5484 etors=etors+etorsi-v1(1,3,3)
5485 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5486 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5489 v1ij=v1(j+1,itori,itori1)
5490 v2ij=v2(j+1,itori,itori1)
5493 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5494 if (energy_dec) etors_ii=etors_ii+
5495 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5496 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5500 v1ij=v1(j,itori,itori1)
5501 v2ij=v2(j,itori,itori1)
5504 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5505 if (energy_dec) etors_ii=etors_ii+
5506 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5507 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5510 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5513 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5514 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5515 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5516 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5517 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5519 ! 6/20/98 - dihedral angle constraints
5522 itori=idih_constr(i)
5525 if (difi.gt.drange(i)) then
5527 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5528 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5529 else if (difi.lt.-drange(i)) then
5531 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5532 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5534 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5535 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5537 ! write (iout,*) 'edihcnstr',edihcnstr
5540 c------------------------------------------------------------------------------
5541 subroutine etor_d(etors_d)
5545 c----------------------------------------------------------------------------
5547 subroutine etor(etors,edihcnstr)
5548 implicit real*8 (a-h,o-z)
5549 include 'DIMENSIONS'
5550 include 'COMMON.VAR'
5551 include 'COMMON.GEO'
5552 include 'COMMON.LOCAL'
5553 include 'COMMON.TORSION'
5554 include 'COMMON.INTERACT'
5555 include 'COMMON.DERIV'
5556 include 'COMMON.CHAIN'
5557 include 'COMMON.NAMES'
5558 include 'COMMON.IOUNITS'
5559 include 'COMMON.FFIELD'
5560 include 'COMMON.TORCNSTR'
5561 include 'COMMON.CONTROL'
5563 C Set lprn=.true. for debugging
5567 do i=iphi_start,iphi_end
5568 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5569 & .or. itype(i).eq.ntyp1) cycle
5571 if (iabs(itype(i)).eq.20) then
5576 itori=itortyp(itype(i-2))
5577 itori1=itortyp(itype(i-1))
5580 C Regular cosine and sine terms
5581 do j=1,nterm(itori,itori1,iblock)
5582 v1ij=v1(j,itori,itori1,iblock)
5583 v2ij=v2(j,itori,itori1,iblock)
5586 etors=etors+v1ij*cosphi+v2ij*sinphi
5587 if (energy_dec) etors_ii=etors_ii+
5588 & v1ij*cosphi+v2ij*sinphi
5589 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5593 C E = SUM ----------------------------------- - v1
5594 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5596 cosphi=dcos(0.5d0*phii)
5597 sinphi=dsin(0.5d0*phii)
5598 do j=1,nlor(itori,itori1,iblock)
5599 vl1ij=vlor1(j,itori,itori1)
5600 vl2ij=vlor2(j,itori,itori1)
5601 vl3ij=vlor3(j,itori,itori1)
5602 pom=vl2ij*cosphi+vl3ij*sinphi
5603 pom1=1.0d0/(pom*pom+1.0d0)
5604 etors=etors+vl1ij*pom1
5605 if (energy_dec) etors_ii=etors_ii+
5608 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5610 C Subtract the constant term
5611 etors=etors-v0(itori,itori1,iblock)
5612 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5613 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5615 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5616 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5617 & (v1(j,itori,itori1,iblock),j=1,6),
5618 & (v2(j,itori,itori1,iblock),j=1,6)
5619 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5620 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5622 ! 6/20/98 - dihedral angle constraints
5624 c do i=1,ndih_constr
5625 do i=idihconstr_start,idihconstr_end
5626 itori=idih_constr(i)
5628 difi=pinorm(phii-phi0(i))
5629 if (difi.gt.drange(i)) then
5631 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5632 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5633 else if (difi.lt.-drange(i)) then
5635 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5636 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5640 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5641 cd & rad2deg*phi0(i), rad2deg*drange(i),
5642 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5644 cd write (iout,*) 'edihcnstr',edihcnstr
5647 c----------------------------------------------------------------------------
5648 subroutine etor_d(etors_d)
5649 C 6/23/01 Compute double torsional energy
5650 implicit real*8 (a-h,o-z)
5651 include 'DIMENSIONS'
5652 include 'COMMON.VAR'
5653 include 'COMMON.GEO'
5654 include 'COMMON.LOCAL'
5655 include 'COMMON.TORSION'
5656 include 'COMMON.INTERACT'
5657 include 'COMMON.DERIV'
5658 include 'COMMON.CHAIN'
5659 include 'COMMON.NAMES'
5660 include 'COMMON.IOUNITS'
5661 include 'COMMON.FFIELD'
5662 include 'COMMON.TORCNSTR'
5664 C Set lprn=.true. for debugging
5668 c write(iout,*) "a tu??"
5669 do i=iphid_start,iphid_end
5670 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5671 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5672 itori=itortyp(itype(i-2))
5673 itori1=itortyp(itype(i-1))
5674 itori2=itortyp(itype(i))
5680 if (iabs(itype(i+1)).eq.20) iblock=2
5682 C Regular cosine and sine terms
5683 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5684 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5685 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5686 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5687 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5688 cosphi1=dcos(j*phii)
5689 sinphi1=dsin(j*phii)
5690 cosphi2=dcos(j*phii1)
5691 sinphi2=dsin(j*phii1)
5692 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5693 & v2cij*cosphi2+v2sij*sinphi2
5694 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5695 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5697 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5699 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5700 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5701 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5702 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5703 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5704 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5705 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5706 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5707 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5708 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5709 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5710 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5711 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5712 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5715 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5716 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5721 c------------------------------------------------------------------------------
5722 subroutine eback_sc_corr(esccor)
5723 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5724 c conformational states; temporarily implemented as differences
5725 c between UNRES torsional potentials (dependent on three types of
5726 c residues) and the torsional potentials dependent on all 20 types
5727 c of residues computed from AM1 energy surfaces of terminally-blocked
5728 c amino-acid residues.
5729 implicit real*8 (a-h,o-z)
5730 include 'DIMENSIONS'
5731 include 'COMMON.VAR'
5732 include 'COMMON.GEO'
5733 include 'COMMON.LOCAL'
5734 include 'COMMON.TORSION'
5735 include 'COMMON.SCCOR'
5736 include 'COMMON.INTERACT'
5737 include 'COMMON.DERIV'
5738 include 'COMMON.CHAIN'
5739 include 'COMMON.NAMES'
5740 include 'COMMON.IOUNITS'
5741 include 'COMMON.FFIELD'
5742 include 'COMMON.CONTROL'
5744 C Set lprn=.true. for debugging
5747 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5749 do i=itau_start,itau_end
5750 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5752 isccori=isccortyp(itype(i-2))
5753 isccori1=isccortyp(itype(i-1))
5754 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5756 do intertyp=1,3 !intertyp
5757 cc Added 09 May 2012 (Adasko)
5758 cc Intertyp means interaction type of backbone mainchain correlation:
5759 c 1 = SC...Ca...Ca...Ca
5760 c 2 = Ca...Ca...Ca...SC
5761 c 3 = SC...Ca...Ca...SCi
5763 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5764 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5765 & (itype(i-1).eq.ntyp1)))
5766 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5767 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5768 & .or.(itype(i).eq.ntyp1)))
5769 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5770 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5771 & (itype(i-3).eq.ntyp1)))) cycle
5772 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5773 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5775 do j=1,nterm_sccor(isccori,isccori1)
5776 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5777 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5778 cosphi=dcos(j*tauangle(intertyp,i))
5779 sinphi=dsin(j*tauangle(intertyp,i))
5780 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5781 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5783 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5784 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5786 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5787 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5788 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5789 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5790 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5796 c----------------------------------------------------------------------------
5797 subroutine multibody(ecorr)
5798 C This subroutine calculates multi-body contributions to energy following
5799 C the idea of Skolnick et al. If side chains I and J make a contact and
5800 C at the same time side chains I+1 and J+1 make a contact, an extra
5801 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5802 implicit real*8 (a-h,o-z)
5803 include 'DIMENSIONS'
5804 include 'COMMON.IOUNITS'
5805 include 'COMMON.DERIV'
5806 include 'COMMON.INTERACT'
5807 include 'COMMON.CONTACTS'
5808 double precision gx(3),gx1(3)
5811 C Set lprn=.true. for debugging
5815 write (iout,'(a)') 'Contact function values:'
5817 write (iout,'(i2,20(1x,i2,f10.5))')
5818 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5833 num_conti=num_cont(i)
5834 num_conti1=num_cont(i1)
5839 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5840 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5841 cd & ' ishift=',ishift
5842 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5843 C The system gains extra energy.
5844 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5845 endif ! j1==j+-ishift
5854 c------------------------------------------------------------------------------
5855 double precision function esccorr(i,j,k,l,jj,kk)
5856 implicit real*8 (a-h,o-z)
5857 include 'DIMENSIONS'
5858 include 'COMMON.IOUNITS'
5859 include 'COMMON.DERIV'
5860 include 'COMMON.INTERACT'
5861 include 'COMMON.CONTACTS'
5862 double precision gx(3),gx1(3)
5867 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5868 C Calculate the multi-body contribution to energy.
5869 C Calculate multi-body contributions to the gradient.
5870 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5871 cd & k,l,(gacont(m,kk,k),m=1,3)
5873 gx(m) =ekl*gacont(m,jj,i)
5874 gx1(m)=eij*gacont(m,kk,k)
5875 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5876 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5877 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5878 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5882 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5887 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5893 c------------------------------------------------------------------------------
5894 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5895 C This subroutine calculates multi-body contributions to hydrogen-bonding
5896 implicit real*8 (a-h,o-z)
5897 include 'DIMENSIONS'
5898 include 'COMMON.IOUNITS'
5901 parameter (max_cont=maxconts)
5902 parameter (max_dim=26)
5903 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5904 double precision zapas(max_dim,maxconts,max_fg_procs),
5905 & zapas_recv(max_dim,maxconts,max_fg_procs)
5906 common /przechowalnia/ zapas
5907 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5908 & status_array(MPI_STATUS_SIZE,maxconts*2)
5910 include 'COMMON.SETUP'
5911 include 'COMMON.FFIELD'
5912 include 'COMMON.DERIV'
5913 include 'COMMON.INTERACT'
5914 include 'COMMON.CONTACTS'
5915 include 'COMMON.CONTROL'
5916 include 'COMMON.LOCAL'
5917 double precision gx(3),gx1(3),time00
5920 C Set lprn=.true. for debugging
5925 if (nfgtasks.le.1) goto 30
5927 write (iout,'(a)') 'Contact function values before RECEIVE:'
5929 write (iout,'(2i3,50(1x,i2,f5.2))')
5930 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5931 & j=1,num_cont_hb(i))
5935 do i=1,ntask_cont_from
5938 do i=1,ntask_cont_to
5941 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5943 C Make the list of contacts to send to send to other procesors
5944 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5946 do i=iturn3_start,iturn3_end
5947 c write (iout,*) "make contact list turn3",i," num_cont",
5949 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5951 do i=iturn4_start,iturn4_end
5952 c write (iout,*) "make contact list turn4",i," num_cont",
5954 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5958 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5960 do j=1,num_cont_hb(i)
5963 iproc=iint_sent_local(k,jjc,ii)
5964 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5965 if (iproc.gt.0) then
5966 ncont_sent(iproc)=ncont_sent(iproc)+1
5967 nn=ncont_sent(iproc)
5969 zapas(2,nn,iproc)=jjc
5970 zapas(3,nn,iproc)=facont_hb(j,i)
5971 zapas(4,nn,iproc)=ees0p(j,i)
5972 zapas(5,nn,iproc)=ees0m(j,i)
5973 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5974 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5975 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5976 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5977 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5978 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5979 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5980 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5981 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5982 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5983 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5984 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5985 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5986 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5987 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5988 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5989 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5990 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5991 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5992 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5993 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6000 & "Numbers of contacts to be sent to other processors",
6001 & (ncont_sent(i),i=1,ntask_cont_to)
6002 write (iout,*) "Contacts sent"
6003 do ii=1,ntask_cont_to
6005 iproc=itask_cont_to(ii)
6006 write (iout,*) nn," contacts to processor",iproc,
6007 & " of CONT_TO_COMM group"
6009 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6017 CorrelID1=nfgtasks+fg_rank+1
6019 C Receive the numbers of needed contacts from other processors
6020 do ii=1,ntask_cont_from
6021 iproc=itask_cont_from(ii)
6023 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6024 & FG_COMM,req(ireq),IERR)
6026 c write (iout,*) "IRECV ended"
6028 C Send the number of contacts needed by other processors
6029 do ii=1,ntask_cont_to
6030 iproc=itask_cont_to(ii)
6032 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6033 & FG_COMM,req(ireq),IERR)
6035 c write (iout,*) "ISEND ended"
6036 c write (iout,*) "number of requests (nn)",ireq
6039 & call MPI_Waitall(ireq,req,status_array,ierr)
6041 c & "Numbers of contacts to be received from other processors",
6042 c & (ncont_recv(i),i=1,ntask_cont_from)
6046 do ii=1,ntask_cont_from
6047 iproc=itask_cont_from(ii)
6049 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6050 c & " of CONT_TO_COMM group"
6054 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6055 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6056 c write (iout,*) "ireq,req",ireq,req(ireq)
6059 C Send the contacts to processors that need them
6060 do ii=1,ntask_cont_to
6061 iproc=itask_cont_to(ii)
6063 c write (iout,*) nn," contacts to processor",iproc,
6064 c & " of CONT_TO_COMM group"
6067 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6068 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6069 c write (iout,*) "ireq,req",ireq,req(ireq)
6071 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6075 c write (iout,*) "number of requests (contacts)",ireq
6076 c write (iout,*) "req",(req(i),i=1,4)
6079 & call MPI_Waitall(ireq,req,status_array,ierr)
6080 do iii=1,ntask_cont_from
6081 iproc=itask_cont_from(iii)
6084 write (iout,*) "Received",nn," contacts from processor",iproc,
6085 & " of CONT_FROM_COMM group"
6088 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6093 ii=zapas_recv(1,i,iii)
6094 c Flag the received contacts to prevent double-counting
6095 jj=-zapas_recv(2,i,iii)
6096 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6098 nnn=num_cont_hb(ii)+1
6101 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6102 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6103 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6104 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6105 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6106 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6107 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6108 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6109 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6110 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6111 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6112 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6113 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6114 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6115 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6116 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6117 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6118 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6119 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6120 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6121 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6122 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6123 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6124 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6129 write (iout,'(a)') 'Contact function values after receive:'
6131 write (iout,'(2i3,50(1x,i3,f5.2))')
6132 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6133 & j=1,num_cont_hb(i))
6140 write (iout,'(a)') 'Contact function values:'
6142 write (iout,'(2i3,50(1x,i3,f5.2))')
6143 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6144 & j=1,num_cont_hb(i))
6148 C Remove the loop below after debugging !!!
6155 C Calculate the local-electrostatic correlation terms
6156 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6158 num_conti=num_cont_hb(i)
6159 num_conti1=num_cont_hb(i+1)
6166 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6167 c & ' jj=',jj,' kk=',kk
6168 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6169 & .or. j.lt.0 .and. j1.gt.0) .and.
6170 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6171 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6172 C The system gains extra energy.
6173 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6174 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6175 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6177 else if (j1.eq.j) then
6178 C Contacts I-J and I-(J+1) occur simultaneously.
6179 C The system loses extra energy.
6180 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6185 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6186 c & ' jj=',jj,' kk=',kk
6188 C Contacts I-J and (I+1)-J occur simultaneously.
6189 C The system loses extra energy.
6190 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6197 c------------------------------------------------------------------------------
6198 subroutine add_hb_contact(ii,jj,itask)
6199 implicit real*8 (a-h,o-z)
6200 include "DIMENSIONS"
6201 include "COMMON.IOUNITS"
6204 parameter (max_cont=maxconts)
6205 parameter (max_dim=26)
6206 include "COMMON.CONTACTS"
6207 double precision zapas(max_dim,maxconts,max_fg_procs),
6208 & zapas_recv(max_dim,maxconts,max_fg_procs)
6209 common /przechowalnia/ zapas
6210 integer i,j,ii,jj,iproc,itask(4),nn
6211 c write (iout,*) "itask",itask
6214 if (iproc.gt.0) then
6215 do j=1,num_cont_hb(ii)
6217 c write (iout,*) "i",ii," j",jj," jjc",jjc
6219 ncont_sent(iproc)=ncont_sent(iproc)+1
6220 nn=ncont_sent(iproc)
6221 zapas(1,nn,iproc)=ii
6222 zapas(2,nn,iproc)=jjc
6223 zapas(3,nn,iproc)=facont_hb(j,ii)
6224 zapas(4,nn,iproc)=ees0p(j,ii)
6225 zapas(5,nn,iproc)=ees0m(j,ii)
6226 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6227 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6228 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6229 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6230 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6231 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6232 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6233 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6234 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6235 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6236 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6237 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6238 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6239 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6240 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6241 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6242 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6243 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6244 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6245 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6246 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6254 c------------------------------------------------------------------------------
6255 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6257 C This subroutine calculates multi-body contributions to hydrogen-bonding
6258 implicit real*8 (a-h,o-z)
6259 include 'DIMENSIONS'
6260 include 'COMMON.IOUNITS'
6263 parameter (max_cont=maxconts)
6264 parameter (max_dim=70)
6265 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6266 double precision zapas(max_dim,maxconts,max_fg_procs),
6267 & zapas_recv(max_dim,maxconts,max_fg_procs)
6268 common /przechowalnia/ zapas
6269 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6270 & status_array(MPI_STATUS_SIZE,maxconts*2)
6272 include 'COMMON.SETUP'
6273 include 'COMMON.FFIELD'
6274 include 'COMMON.DERIV'
6275 include 'COMMON.LOCAL'
6276 include 'COMMON.INTERACT'
6277 include 'COMMON.CONTACTS'
6278 include 'COMMON.CHAIN'
6279 include 'COMMON.CONTROL'
6280 double precision gx(3),gx1(3)
6281 integer num_cont_hb_old(maxres)
6283 double precision eello4,eello5,eelo6,eello_turn6
6284 external eello4,eello5,eello6,eello_turn6
6285 C Set lprn=.true. for debugging
6290 num_cont_hb_old(i)=num_cont_hb(i)
6294 if (nfgtasks.le.1) goto 30
6296 write (iout,'(a)') 'Contact function values before RECEIVE:'
6298 write (iout,'(2i3,50(1x,i2,f5.2))')
6299 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6300 & j=1,num_cont_hb(i))
6304 do i=1,ntask_cont_from
6307 do i=1,ntask_cont_to
6310 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6312 C Make the list of contacts to send to send to other procesors
6313 do i=iturn3_start,iturn3_end
6314 c write (iout,*) "make contact list turn3",i," num_cont",
6316 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6318 do i=iturn4_start,iturn4_end
6319 c write (iout,*) "make contact list turn4",i," num_cont",
6321 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6325 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6327 do j=1,num_cont_hb(i)
6330 iproc=iint_sent_local(k,jjc,ii)
6331 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6332 if (iproc.ne.0) then
6333 ncont_sent(iproc)=ncont_sent(iproc)+1
6334 nn=ncont_sent(iproc)
6336 zapas(2,nn,iproc)=jjc
6337 zapas(3,nn,iproc)=d_cont(j,i)
6341 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6346 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6354 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6365 & "Numbers of contacts to be sent to other processors",
6366 & (ncont_sent(i),i=1,ntask_cont_to)
6367 write (iout,*) "Contacts sent"
6368 do ii=1,ntask_cont_to
6370 iproc=itask_cont_to(ii)
6371 write (iout,*) nn," contacts to processor",iproc,
6372 & " of CONT_TO_COMM group"
6374 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6382 CorrelID1=nfgtasks+fg_rank+1
6384 C Receive the numbers of needed contacts from other processors
6385 do ii=1,ntask_cont_from
6386 iproc=itask_cont_from(ii)
6388 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6389 & FG_COMM,req(ireq),IERR)
6391 c write (iout,*) "IRECV ended"
6393 C Send the number of contacts needed by other processors
6394 do ii=1,ntask_cont_to
6395 iproc=itask_cont_to(ii)
6397 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6398 & FG_COMM,req(ireq),IERR)
6400 c write (iout,*) "ISEND ended"
6401 c write (iout,*) "number of requests (nn)",ireq
6404 & call MPI_Waitall(ireq,req,status_array,ierr)
6406 c & "Numbers of contacts to be received from other processors",
6407 c & (ncont_recv(i),i=1,ntask_cont_from)
6411 do ii=1,ntask_cont_from
6412 iproc=itask_cont_from(ii)
6414 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6415 c & " of CONT_TO_COMM group"
6419 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6420 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6421 c write (iout,*) "ireq,req",ireq,req(ireq)
6424 C Send the contacts to processors that need them
6425 do ii=1,ntask_cont_to
6426 iproc=itask_cont_to(ii)
6428 c write (iout,*) nn," contacts to processor",iproc,
6429 c & " of CONT_TO_COMM group"
6432 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6433 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6434 c write (iout,*) "ireq,req",ireq,req(ireq)
6436 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6440 c write (iout,*) "number of requests (contacts)",ireq
6441 c write (iout,*) "req",(req(i),i=1,4)
6444 & call MPI_Waitall(ireq,req,status_array,ierr)
6445 do iii=1,ntask_cont_from
6446 iproc=itask_cont_from(iii)
6449 write (iout,*) "Received",nn," contacts from processor",iproc,
6450 & " of CONT_FROM_COMM group"
6453 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6458 ii=zapas_recv(1,i,iii)
6459 c Flag the received contacts to prevent double-counting
6460 jj=-zapas_recv(2,i,iii)
6461 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6463 nnn=num_cont_hb(ii)+1
6466 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6470 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6475 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6483 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6492 write (iout,'(a)') 'Contact function values after receive:'
6494 write (iout,'(2i3,50(1x,i3,5f6.3))')
6495 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6496 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6503 write (iout,'(a)') 'Contact function values:'
6505 write (iout,'(2i3,50(1x,i2,5f6.3))')
6506 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6507 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6513 C Remove the loop below after debugging !!!
6520 C Calculate the dipole-dipole interaction energies
6521 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6522 do i=iatel_s,iatel_e+1
6523 num_conti=num_cont_hb(i)
6532 C Calculate the local-electrostatic correlation terms
6533 c write (iout,*) "gradcorr5 in eello5 before loop"
6535 c write (iout,'(i5,3f10.5)')
6536 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6538 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6539 c write (iout,*) "corr loop i",i
6541 num_conti=num_cont_hb(i)
6542 num_conti1=num_cont_hb(i+1)
6549 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6550 c & ' jj=',jj,' kk=',kk
6551 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6552 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6553 & .or. j.lt.0 .and. j1.gt.0) .and.
6554 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6555 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6556 C The system gains extra energy.
6558 sqd1=dsqrt(d_cont(jj,i))
6559 sqd2=dsqrt(d_cont(kk,i1))
6560 sred_geom = sqd1*sqd2
6561 IF (sred_geom.lt.cutoff_corr) THEN
6562 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6564 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6565 cd & ' jj=',jj,' kk=',kk
6566 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6567 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6569 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6570 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6573 cd write (iout,*) 'sred_geom=',sred_geom,
6574 cd & ' ekont=',ekont,' fprim=',fprimcont,
6575 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6576 cd write (iout,*) "g_contij",g_contij
6577 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6578 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6579 call calc_eello(i,jp,i+1,jp1,jj,kk)
6580 if (wcorr4.gt.0.0d0)
6581 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6582 if (energy_dec.and.wcorr4.gt.0.0d0)
6583 1 write (iout,'(a6,4i5,0pf7.3)')
6584 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6585 c write (iout,*) "gradcorr5 before eello5"
6587 c write (iout,'(i5,3f10.5)')
6588 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6590 if (wcorr5.gt.0.0d0)
6591 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6592 c write (iout,*) "gradcorr5 after eello5"
6594 c write (iout,'(i5,3f10.5)')
6595 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6597 if (energy_dec.and.wcorr5.gt.0.0d0)
6598 1 write (iout,'(a6,4i5,0pf7.3)')
6599 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6600 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6601 cd write(2,*)'ijkl',i,jp,i+1,jp1
6602 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6603 & .or. wturn6.eq.0.0d0))then
6604 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6605 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6606 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6607 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6608 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6609 cd & 'ecorr6=',ecorr6
6610 cd write (iout,'(4e15.5)') sred_geom,
6611 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6612 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6613 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6614 else if (wturn6.gt.0.0d0
6615 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6616 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6617 eturn6=eturn6+eello_turn6(i,jj,kk)
6618 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6619 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6620 cd write (2,*) 'multibody_eello:eturn6',eturn6
6629 num_cont_hb(i)=num_cont_hb_old(i)
6631 c write (iout,*) "gradcorr5 in eello5"
6633 c write (iout,'(i5,3f10.5)')
6634 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6638 c------------------------------------------------------------------------------
6639 subroutine add_hb_contact_eello(ii,jj,itask)
6640 implicit real*8 (a-h,o-z)
6641 include "DIMENSIONS"
6642 include "COMMON.IOUNITS"
6645 parameter (max_cont=maxconts)
6646 parameter (max_dim=70)
6647 include "COMMON.CONTACTS"
6648 double precision zapas(max_dim,maxconts,max_fg_procs),
6649 & zapas_recv(max_dim,maxconts,max_fg_procs)
6650 common /przechowalnia/ zapas
6651 integer i,j,ii,jj,iproc,itask(4),nn
6652 c write (iout,*) "itask",itask
6655 if (iproc.gt.0) then
6656 do j=1,num_cont_hb(ii)
6658 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6660 ncont_sent(iproc)=ncont_sent(iproc)+1
6661 nn=ncont_sent(iproc)
6662 zapas(1,nn,iproc)=ii
6663 zapas(2,nn,iproc)=jjc
6664 zapas(3,nn,iproc)=d_cont(j,ii)
6668 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6673 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6681 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6693 c------------------------------------------------------------------------------
6694 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6695 implicit real*8 (a-h,o-z)
6696 include 'DIMENSIONS'
6697 include 'COMMON.IOUNITS'
6698 include 'COMMON.DERIV'
6699 include 'COMMON.INTERACT'
6700 include 'COMMON.CONTACTS'
6701 double precision gx(3),gx1(3)
6711 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6712 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6713 C Following 4 lines for diagnostics.
6718 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6719 c & 'Contacts ',i,j,
6720 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6721 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6723 C Calculate the multi-body contribution to energy.
6724 c ecorr=ecorr+ekont*ees
6725 C Calculate multi-body contributions to the gradient.
6726 coeffpees0pij=coeffp*ees0pij
6727 coeffmees0mij=coeffm*ees0mij
6728 coeffpees0pkl=coeffp*ees0pkl
6729 coeffmees0mkl=coeffm*ees0mkl
6731 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6732 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6733 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6734 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6735 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6736 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6737 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6738 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6739 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6740 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6741 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6742 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6743 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6744 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6745 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6746 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6747 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6748 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6749 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6750 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6751 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6752 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6753 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6754 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6755 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6760 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6761 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6762 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6763 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6768 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6769 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6770 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6771 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6774 c write (iout,*) "ehbcorr",ekont*ees
6779 C---------------------------------------------------------------------------
6780 subroutine dipole(i,j,jj)
6781 implicit real*8 (a-h,o-z)
6782 include 'DIMENSIONS'
6783 include 'COMMON.IOUNITS'
6784 include 'COMMON.CHAIN'
6785 include 'COMMON.FFIELD'
6786 include 'COMMON.DERIV'
6787 include 'COMMON.INTERACT'
6788 include 'COMMON.CONTACTS'
6789 include 'COMMON.TORSION'
6790 include 'COMMON.VAR'
6791 include 'COMMON.GEO'
6792 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6794 iti1 = itortyp(itype(i+1))
6795 if (j.lt.nres-1) then
6796 itj1 = itortyp(itype(j+1))
6801 dipi(iii,1)=Ub2(iii,i)
6802 dipderi(iii)=Ub2der(iii,i)
6803 dipi(iii,2)=b1(iii,iti1)
6804 dipj(iii,1)=Ub2(iii,j)
6805 dipderj(iii)=Ub2der(iii,j)
6806 dipj(iii,2)=b1(iii,itj1)
6810 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6813 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6820 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6824 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6829 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6830 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6832 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6834 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6836 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6841 C---------------------------------------------------------------------------
6842 subroutine calc_eello(i,j,k,l,jj,kk)
6844 C This subroutine computes matrices and vectors needed to calculate
6845 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6847 implicit real*8 (a-h,o-z)
6848 include 'DIMENSIONS'
6849 include 'COMMON.IOUNITS'
6850 include 'COMMON.CHAIN'
6851 include 'COMMON.DERIV'
6852 include 'COMMON.INTERACT'
6853 include 'COMMON.CONTACTS'
6854 include 'COMMON.TORSION'
6855 include 'COMMON.VAR'
6856 include 'COMMON.GEO'
6857 include 'COMMON.FFIELD'
6858 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6859 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6862 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6863 cd & ' jj=',jj,' kk=',kk
6864 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6865 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6866 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6869 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6870 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6873 call transpose2(aa1(1,1),aa1t(1,1))
6874 call transpose2(aa2(1,1),aa2t(1,1))
6877 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6878 & aa1tder(1,1,lll,kkk))
6879 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6880 & aa2tder(1,1,lll,kkk))
6884 C parallel orientation of the two CA-CA-CA frames.
6886 iti=itortyp(itype(i))
6890 itk1=itortyp(itype(k+1))
6891 itj=itortyp(itype(j))
6892 if (l.lt.nres-1) then
6893 itl1=itortyp(itype(l+1))
6897 C A1 kernel(j+1) A2T
6899 cd write (iout,'(3f10.5,5x,3f10.5)')
6900 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6902 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6903 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6904 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6905 C Following matrices are needed only for 6-th order cumulants
6906 IF (wcorr6.gt.0.0d0) THEN
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.,EUgC(1,1,l),EUgCder(1,1,l),
6909 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6910 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6911 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6912 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6913 & ADtEAderx(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.,DtUg2EUg(1,1,l),
6917 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6918 & ADtEA1derx(1,1,1,1,1,1))
6920 C End 6-th order cumulants
6923 cd write (2,*) 'In calc_eello6'
6925 cd write (2,*) 'iii=',iii
6927 cd write (2,*) 'kkk=',kkk
6929 cd write (2,'(3(2f10.5),5x)')
6930 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6935 call transpose2(EUgder(1,1,k),auxmat(1,1))
6936 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6937 call transpose2(EUg(1,1,k),auxmat(1,1))
6938 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6939 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6943 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6944 & EAEAderx(1,1,lll,kkk,iii,1))
6948 C A1T kernel(i+1) A2
6949 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6950 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6951 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6952 C Following matrices are needed only for 6-th order cumulants
6953 IF (wcorr6.gt.0.0d0) THEN
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.,EUgC(1,1,k),EUgCder(1,1,k),
6956 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6957 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6958 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6959 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6960 & ADtEAderx(1,1,1,1,1,2))
6961 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6962 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6963 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6964 & ADtEA1derx(1,1,1,1,1,2))
6966 C End 6-th order cumulants
6967 call transpose2(EUgder(1,1,l),auxmat(1,1))
6968 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6969 call transpose2(EUg(1,1,l),auxmat(1,1))
6970 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6971 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6975 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6976 & EAEAderx(1,1,lll,kkk,iii,2))
6981 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6982 C They are needed only when the fifth- or the sixth-order cumulants are
6984 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6985 call transpose2(AEA(1,1,1),auxmat(1,1))
6986 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6987 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6988 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6989 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6990 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6991 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6992 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6993 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6994 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6995 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6996 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6997 call transpose2(AEA(1,1,2),auxmat(1,1))
6998 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6999 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7000 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7001 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7002 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7003 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7004 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7005 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7006 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7007 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7008 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7009 C Calculate the Cartesian derivatives of the vectors.
7013 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7014 call matvec2(auxmat(1,1),b1(1,iti),
7015 & AEAb1derx(1,lll,kkk,iii,1,1))
7016 call matvec2(auxmat(1,1),Ub2(1,i),
7017 & AEAb2derx(1,lll,kkk,iii,1,1))
7018 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7019 & AEAb1derx(1,lll,kkk,iii,2,1))
7020 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7021 & AEAb2derx(1,lll,kkk,iii,2,1))
7022 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7023 call matvec2(auxmat(1,1),b1(1,itj),
7024 & AEAb1derx(1,lll,kkk,iii,1,2))
7025 call matvec2(auxmat(1,1),Ub2(1,j),
7026 & AEAb2derx(1,lll,kkk,iii,1,2))
7027 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7028 & AEAb1derx(1,lll,kkk,iii,2,2))
7029 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7030 & AEAb2derx(1,lll,kkk,iii,2,2))
7037 C Antiparallel orientation of the two CA-CA-CA frames.
7039 iti=itortyp(itype(i))
7043 itk1=itortyp(itype(k+1))
7044 itl=itortyp(itype(l))
7045 itj=itortyp(itype(j))
7046 if (j.lt.nres-1) then
7047 itj1=itortyp(itype(j+1))
7051 C A2 kernel(j-1)T A1T
7052 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7053 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7054 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7055 C Following matrices are needed only for 6-th order cumulants
7056 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7057 & j.eq.i+4 .and. l.eq.i+3)) THEN
7058 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7059 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7060 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7061 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7062 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7063 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7064 & ADtEAderx(1,1,1,1,1,1))
7065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7066 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7067 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7068 & ADtEA1derx(1,1,1,1,1,1))
7070 C End 6-th order cumulants
7071 call transpose2(EUgder(1,1,k),auxmat(1,1))
7072 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7073 call transpose2(EUg(1,1,k),auxmat(1,1))
7074 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7075 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7079 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7080 & EAEAderx(1,1,lll,kkk,iii,1))
7084 C A2T kernel(i+1)T A1
7085 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7086 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7087 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7088 C Following matrices are needed only for 6-th order cumulants
7089 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7090 & j.eq.i+4 .and. l.eq.i+3)) THEN
7091 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7092 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7093 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7094 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7095 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7096 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7097 & ADtEAderx(1,1,1,1,1,2))
7098 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7099 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7100 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7101 & ADtEA1derx(1,1,1,1,1,2))
7103 C End 6-th order cumulants
7104 call transpose2(EUgder(1,1,j),auxmat(1,1))
7105 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7106 call transpose2(EUg(1,1,j),auxmat(1,1))
7107 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7108 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7112 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7113 & EAEAderx(1,1,lll,kkk,iii,2))
7118 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7119 C They are needed only when the fifth- or the sixth-order cumulants are
7121 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7122 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7123 call transpose2(AEA(1,1,1),auxmat(1,1))
7124 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7125 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7126 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7127 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7128 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7129 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7130 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7131 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7132 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7133 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7134 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7135 call transpose2(AEA(1,1,2),auxmat(1,1))
7136 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7137 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7138 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7139 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7140 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7141 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7142 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7143 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7144 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7145 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7146 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7147 C Calculate the Cartesian derivatives of the vectors.
7151 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7152 call matvec2(auxmat(1,1),b1(1,iti),
7153 & AEAb1derx(1,lll,kkk,iii,1,1))
7154 call matvec2(auxmat(1,1),Ub2(1,i),
7155 & AEAb2derx(1,lll,kkk,iii,1,1))
7156 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7157 & AEAb1derx(1,lll,kkk,iii,2,1))
7158 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7159 & AEAb2derx(1,lll,kkk,iii,2,1))
7160 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7161 call matvec2(auxmat(1,1),b1(1,itl),
7162 & AEAb1derx(1,lll,kkk,iii,1,2))
7163 call matvec2(auxmat(1,1),Ub2(1,l),
7164 & AEAb2derx(1,lll,kkk,iii,1,2))
7165 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7166 & AEAb1derx(1,lll,kkk,iii,2,2))
7167 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7168 & AEAb2derx(1,lll,kkk,iii,2,2))
7177 C---------------------------------------------------------------------------
7178 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7179 & KK,KKderg,AKA,AKAderg,AKAderx)
7183 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7184 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7185 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7190 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7192 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7195 cd if (lprn) write (2,*) 'In kernel'
7197 cd if (lprn) write (2,*) 'kkk=',kkk
7199 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7200 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7202 cd write (2,*) 'lll=',lll
7203 cd write (2,*) 'iii=1'
7205 cd write (2,'(3(2f10.5),5x)')
7206 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7209 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7210 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7212 cd write (2,*) 'lll=',lll
7213 cd write (2,*) 'iii=2'
7215 cd write (2,'(3(2f10.5),5x)')
7216 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7223 C---------------------------------------------------------------------------
7224 double precision function eello4(i,j,k,l,jj,kk)
7225 implicit real*8 (a-h,o-z)
7226 include 'DIMENSIONS'
7227 include 'COMMON.IOUNITS'
7228 include 'COMMON.CHAIN'
7229 include 'COMMON.DERIV'
7230 include 'COMMON.INTERACT'
7231 include 'COMMON.CONTACTS'
7232 include 'COMMON.TORSION'
7233 include 'COMMON.VAR'
7234 include 'COMMON.GEO'
7235 double precision pizda(2,2),ggg1(3),ggg2(3)
7236 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7240 cd print *,'eello4:',i,j,k,l,jj,kk
7241 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7242 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7243 cold eij=facont_hb(jj,i)
7244 cold ekl=facont_hb(kk,k)
7246 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7247 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7248 gcorr_loc(k-1)=gcorr_loc(k-1)
7249 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7251 gcorr_loc(l-1)=gcorr_loc(l-1)
7252 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7254 gcorr_loc(j-1)=gcorr_loc(j-1)
7255 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7260 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7261 & -EAEAderx(2,2,lll,kkk,iii,1)
7262 cd derx(lll,kkk,iii)=0.0d0
7266 cd gcorr_loc(l-1)=0.0d0
7267 cd gcorr_loc(j-1)=0.0d0
7268 cd gcorr_loc(k-1)=0.0d0
7270 cd write (iout,*)'Contacts have occurred for peptide groups',
7271 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7272 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7273 if (j.lt.nres-1) then
7280 if (l.lt.nres-1) then
7288 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7289 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7290 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7291 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7292 cgrad ghalf=0.5d0*ggg1(ll)
7293 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7294 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7295 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7296 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7297 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7298 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7299 cgrad ghalf=0.5d0*ggg2(ll)
7300 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7301 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7302 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7303 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7304 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7305 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7309 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7314 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7319 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7324 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7328 cd write (2,*) iii,gcorr_loc(iii)
7331 cd write (2,*) 'ekont',ekont
7332 cd write (iout,*) 'eello4',ekont*eel4
7335 C---------------------------------------------------------------------------
7336 double precision function eello5(i,j,k,l,jj,kk)
7337 implicit real*8 (a-h,o-z)
7338 include 'DIMENSIONS'
7339 include 'COMMON.IOUNITS'
7340 include 'COMMON.CHAIN'
7341 include 'COMMON.DERIV'
7342 include 'COMMON.INTERACT'
7343 include 'COMMON.CONTACTS'
7344 include 'COMMON.TORSION'
7345 include 'COMMON.VAR'
7346 include 'COMMON.GEO'
7347 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7348 double precision ggg1(3),ggg2(3)
7349 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7354 C /l\ / \ \ / \ / \ / C
7355 C / \ / \ \ / \ / \ / C
7356 C j| o |l1 | o | o| o | | o |o C
7357 C \ |/k\| |/ \| / |/ \| |/ \| C
7358 C \i/ \ / \ / / \ / \ C
7360 C (I) (II) (III) (IV) C
7362 C eello5_1 eello5_2 eello5_3 eello5_4 C
7364 C Antiparallel chains C
7367 C /j\ / \ \ / \ / \ / C
7368 C / \ / \ \ / \ / \ / C
7369 C j1| o |l | o | o| o | | o |o C
7370 C \ |/k\| |/ \| / |/ \| |/ \| C
7371 C \i/ \ / \ / / \ / \ C
7373 C (I) (II) (III) (IV) C
7375 C eello5_1 eello5_2 eello5_3 eello5_4 C
7377 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7379 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7380 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7385 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7387 itk=itortyp(itype(k))
7388 itl=itortyp(itype(l))
7389 itj=itortyp(itype(j))
7394 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7395 cd & eel5_3_num,eel5_4_num)
7399 derx(lll,kkk,iii)=0.0d0
7403 cd eij=facont_hb(jj,i)
7404 cd ekl=facont_hb(kk,k)
7406 cd write (iout,*)'Contacts have occurred for peptide groups',
7407 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7409 C Contribution from the graph I.
7410 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7411 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7412 call transpose2(EUg(1,1,k),auxmat(1,1))
7413 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7414 vv(1)=pizda(1,1)-pizda(2,2)
7415 vv(2)=pizda(1,2)+pizda(2,1)
7416 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7417 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7418 C Explicit gradient in virtual-dihedral angles.
7419 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7420 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7421 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7422 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7423 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7424 vv(1)=pizda(1,1)-pizda(2,2)
7425 vv(2)=pizda(1,2)+pizda(2,1)
7426 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7427 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7428 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7429 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7430 vv(1)=pizda(1,1)-pizda(2,2)
7431 vv(2)=pizda(1,2)+pizda(2,1)
7433 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7434 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7435 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7437 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7438 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7439 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7441 C Cartesian gradient
7445 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7447 vv(1)=pizda(1,1)-pizda(2,2)
7448 vv(2)=pizda(1,2)+pizda(2,1)
7449 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7450 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7451 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7457 C Contribution from graph II
7458 call transpose2(EE(1,1,itk),auxmat(1,1))
7459 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7460 vv(1)=pizda(1,1)+pizda(2,2)
7461 vv(2)=pizda(2,1)-pizda(1,2)
7462 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7463 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7464 C Explicit gradient in virtual-dihedral angles.
7465 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7466 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7467 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7468 vv(1)=pizda(1,1)+pizda(2,2)
7469 vv(2)=pizda(2,1)-pizda(1,2)
7471 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7472 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7473 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7475 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7476 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7477 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7479 C Cartesian gradient
7483 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7485 vv(1)=pizda(1,1)+pizda(2,2)
7486 vv(2)=pizda(2,1)-pizda(1,2)
7487 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7488 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7489 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7497 C Parallel orientation
7498 C Contribution from graph III
7499 call transpose2(EUg(1,1,l),auxmat(1,1))
7500 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7501 vv(1)=pizda(1,1)-pizda(2,2)
7502 vv(2)=pizda(1,2)+pizda(2,1)
7503 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7504 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7505 C Explicit gradient in virtual-dihedral angles.
7506 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7507 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7508 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7509 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7510 vv(1)=pizda(1,1)-pizda(2,2)
7511 vv(2)=pizda(1,2)+pizda(2,1)
7512 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7513 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7514 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7515 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7516 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7517 vv(1)=pizda(1,1)-pizda(2,2)
7518 vv(2)=pizda(1,2)+pizda(2,1)
7519 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7520 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7521 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7522 C Cartesian gradient
7526 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7528 vv(1)=pizda(1,1)-pizda(2,2)
7529 vv(2)=pizda(1,2)+pizda(2,1)
7530 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7531 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7532 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7537 C Contribution from graph IV
7539 call transpose2(EE(1,1,itl),auxmat(1,1))
7540 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7541 vv(1)=pizda(1,1)+pizda(2,2)
7542 vv(2)=pizda(2,1)-pizda(1,2)
7543 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7544 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7545 C Explicit gradient in virtual-dihedral angles.
7546 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7547 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7548 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7549 vv(1)=pizda(1,1)+pizda(2,2)
7550 vv(2)=pizda(2,1)-pizda(1,2)
7551 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7552 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7553 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7554 C Cartesian gradient
7558 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7560 vv(1)=pizda(1,1)+pizda(2,2)
7561 vv(2)=pizda(2,1)-pizda(1,2)
7562 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7563 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7564 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7569 C Antiparallel orientation
7570 C Contribution from graph III
7572 call transpose2(EUg(1,1,j),auxmat(1,1))
7573 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7574 vv(1)=pizda(1,1)-pizda(2,2)
7575 vv(2)=pizda(1,2)+pizda(2,1)
7576 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7577 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7578 C Explicit gradient in virtual-dihedral angles.
7579 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7580 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7581 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7582 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7583 vv(1)=pizda(1,1)-pizda(2,2)
7584 vv(2)=pizda(1,2)+pizda(2,1)
7585 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7586 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7587 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7588 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7589 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7590 vv(1)=pizda(1,1)-pizda(2,2)
7591 vv(2)=pizda(1,2)+pizda(2,1)
7592 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7593 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7594 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7595 C Cartesian gradient
7599 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7601 vv(1)=pizda(1,1)-pizda(2,2)
7602 vv(2)=pizda(1,2)+pizda(2,1)
7603 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7604 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7605 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7610 C Contribution from graph IV
7612 call transpose2(EE(1,1,itj),auxmat(1,1))
7613 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7614 vv(1)=pizda(1,1)+pizda(2,2)
7615 vv(2)=pizda(2,1)-pizda(1,2)
7616 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7617 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7618 C Explicit gradient in virtual-dihedral angles.
7619 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7620 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7621 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7622 vv(1)=pizda(1,1)+pizda(2,2)
7623 vv(2)=pizda(2,1)-pizda(1,2)
7624 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7625 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7626 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7627 C Cartesian gradient
7631 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7633 vv(1)=pizda(1,1)+pizda(2,2)
7634 vv(2)=pizda(2,1)-pizda(1,2)
7635 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7636 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7637 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7643 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7644 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7645 cd write (2,*) 'ijkl',i,j,k,l
7646 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7647 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7649 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7650 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7651 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7652 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7653 if (j.lt.nres-1) then
7660 if (l.lt.nres-1) then
7670 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7671 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7672 C summed up outside the subrouine as for the other subroutines
7673 C handling long-range interactions. The old code is commented out
7674 C with "cgrad" to keep track of changes.
7676 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7677 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7678 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7679 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7680 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7681 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7682 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7683 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7684 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7685 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7687 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7688 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7689 cgrad ghalf=0.5d0*ggg1(ll)
7691 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7692 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7693 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7694 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7695 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7696 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7697 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7698 cgrad ghalf=0.5d0*ggg2(ll)
7700 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7701 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7702 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7703 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7704 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7705 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7710 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7711 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7716 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7717 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7723 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7728 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7732 cd write (2,*) iii,g_corr5_loc(iii)
7735 cd write (2,*) 'ekont',ekont
7736 cd write (iout,*) 'eello5',ekont*eel5
7739 c--------------------------------------------------------------------------
7740 double precision function eello6(i,j,k,l,jj,kk)
7741 implicit real*8 (a-h,o-z)
7742 include 'DIMENSIONS'
7743 include 'COMMON.IOUNITS'
7744 include 'COMMON.CHAIN'
7745 include 'COMMON.DERIV'
7746 include 'COMMON.INTERACT'
7747 include 'COMMON.CONTACTS'
7748 include 'COMMON.TORSION'
7749 include 'COMMON.VAR'
7750 include 'COMMON.GEO'
7751 include 'COMMON.FFIELD'
7752 double precision ggg1(3),ggg2(3)
7753 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7758 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7766 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7767 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7771 derx(lll,kkk,iii)=0.0d0
7775 cd eij=facont_hb(jj,i)
7776 cd ekl=facont_hb(kk,k)
7782 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7783 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7784 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7785 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7786 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7787 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7789 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7790 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7791 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7792 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7793 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7794 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7798 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7800 C If turn contributions are considered, they will be handled separately.
7801 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7802 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7803 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7804 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7805 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7806 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7807 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7809 if (j.lt.nres-1) then
7816 if (l.lt.nres-1) then
7824 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7825 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7826 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7827 cgrad ghalf=0.5d0*ggg1(ll)
7829 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7830 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7831 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7832 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7833 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7834 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7835 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7836 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7837 cgrad ghalf=0.5d0*ggg2(ll)
7838 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7840 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7841 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7842 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7843 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7844 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7845 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7850 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7851 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7856 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7857 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7863 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7868 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7872 cd write (2,*) iii,g_corr6_loc(iii)
7875 cd write (2,*) 'ekont',ekont
7876 cd write (iout,*) 'eello6',ekont*eel6
7879 c--------------------------------------------------------------------------
7880 double precision function eello6_graph1(i,j,k,l,imat,swap)
7881 implicit real*8 (a-h,o-z)
7882 include 'DIMENSIONS'
7883 include 'COMMON.IOUNITS'
7884 include 'COMMON.CHAIN'
7885 include 'COMMON.DERIV'
7886 include 'COMMON.INTERACT'
7887 include 'COMMON.CONTACTS'
7888 include 'COMMON.TORSION'
7889 include 'COMMON.VAR'
7890 include 'COMMON.GEO'
7891 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7895 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7897 C Parallel Antiparallel C
7903 C \ j|/k\| / \ |/k\|l / C
7908 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7909 itk=itortyp(itype(k))
7910 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7911 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7912 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7913 call transpose2(EUgC(1,1,k),auxmat(1,1))
7914 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7915 vv1(1)=pizda1(1,1)-pizda1(2,2)
7916 vv1(2)=pizda1(1,2)+pizda1(2,1)
7917 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7918 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7919 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7920 s5=scalar2(vv(1),Dtobr2(1,i))
7921 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7922 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7923 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7924 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7925 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7926 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7927 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7928 & +scalar2(vv(1),Dtobr2der(1,i)))
7929 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7930 vv1(1)=pizda1(1,1)-pizda1(2,2)
7931 vv1(2)=pizda1(1,2)+pizda1(2,1)
7932 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7933 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7935 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7936 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7937 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7938 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7939 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7941 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7942 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7943 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7944 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7945 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7947 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7948 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7949 vv1(1)=pizda1(1,1)-pizda1(2,2)
7950 vv1(2)=pizda1(1,2)+pizda1(2,1)
7951 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7952 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7953 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7954 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7963 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7964 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7965 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7966 call transpose2(EUgC(1,1,k),auxmat(1,1))
7967 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7969 vv1(1)=pizda1(1,1)-pizda1(2,2)
7970 vv1(2)=pizda1(1,2)+pizda1(2,1)
7971 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7972 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7973 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7974 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7975 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7976 s5=scalar2(vv(1),Dtobr2(1,i))
7977 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7983 c----------------------------------------------------------------------------
7984 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7985 implicit real*8 (a-h,o-z)
7986 include 'DIMENSIONS'
7987 include 'COMMON.IOUNITS'
7988 include 'COMMON.CHAIN'
7989 include 'COMMON.DERIV'
7990 include 'COMMON.INTERACT'
7991 include 'COMMON.CONTACTS'
7992 include 'COMMON.TORSION'
7993 include 'COMMON.VAR'
7994 include 'COMMON.GEO'
7996 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7997 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8002 C Parallel Antiparallel C
8008 C \ j|/k\| \ |/k\|l C
8013 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8014 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8015 C AL 7/4/01 s1 would occur in the sixth-order moment,
8016 C but not in a cluster cumulant
8018 s1=dip(1,jj,i)*dip(1,kk,k)
8020 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8021 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8022 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8023 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8024 call transpose2(EUg(1,1,k),auxmat(1,1))
8025 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8026 vv(1)=pizda(1,1)-pizda(2,2)
8027 vv(2)=pizda(1,2)+pizda(2,1)
8028 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8029 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8031 eello6_graph2=-(s1+s2+s3+s4)
8033 eello6_graph2=-(s2+s3+s4)
8036 C Derivatives in gamma(i-1)
8039 s1=dipderg(1,jj,i)*dip(1,kk,k)
8041 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8042 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8043 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8044 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8046 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8048 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8050 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8052 C Derivatives in gamma(k-1)
8054 s1=dip(1,jj,i)*dipderg(1,kk,k)
8056 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8057 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8058 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8059 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8060 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8061 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8062 vv(1)=pizda(1,1)-pizda(2,2)
8063 vv(2)=pizda(1,2)+pizda(2,1)
8064 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8066 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8068 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8070 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8071 C Derivatives in gamma(j-1) or gamma(l-1)
8074 s1=dipderg(3,jj,i)*dip(1,kk,k)
8076 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8077 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8078 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8079 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8080 vv(1)=pizda(1,1)-pizda(2,2)
8081 vv(2)=pizda(1,2)+pizda(2,1)
8082 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8085 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8087 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8090 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8091 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8093 C Derivatives in gamma(l-1) or gamma(j-1)
8096 s1=dip(1,jj,i)*dipderg(3,kk,k)
8098 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8099 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8100 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8101 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8102 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8103 vv(1)=pizda(1,1)-pizda(2,2)
8104 vv(2)=pizda(1,2)+pizda(2,1)
8105 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8108 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8110 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8113 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8114 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8116 C Cartesian derivatives.
8118 write (2,*) 'In eello6_graph2'
8120 write (2,*) 'iii=',iii
8122 write (2,*) 'kkk=',kkk
8124 write (2,'(3(2f10.5),5x)')
8125 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8135 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8137 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8140 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8142 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8143 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8145 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8146 call transpose2(EUg(1,1,k),auxmat(1,1))
8147 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8149 vv(1)=pizda(1,1)-pizda(2,2)
8150 vv(2)=pizda(1,2)+pizda(2,1)
8151 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8152 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8154 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8156 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8159 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8161 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8168 c----------------------------------------------------------------------------
8169 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8170 implicit real*8 (a-h,o-z)
8171 include 'DIMENSIONS'
8172 include 'COMMON.IOUNITS'
8173 include 'COMMON.CHAIN'
8174 include 'COMMON.DERIV'
8175 include 'COMMON.INTERACT'
8176 include 'COMMON.CONTACTS'
8177 include 'COMMON.TORSION'
8178 include 'COMMON.VAR'
8179 include 'COMMON.GEO'
8180 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8182 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8184 C Parallel Antiparallel C
8190 C j|/k\| / |/k\|l / C
8195 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8197 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8198 C energy moment and not to the cluster cumulant.
8199 iti=itortyp(itype(i))
8200 if (j.lt.nres-1) then
8201 itj1=itortyp(itype(j+1))
8205 itk=itortyp(itype(k))
8206 itk1=itortyp(itype(k+1))
8207 if (l.lt.nres-1) then
8208 itl1=itortyp(itype(l+1))
8213 s1=dip(4,jj,i)*dip(4,kk,k)
8215 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8216 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8217 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8218 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8219 call transpose2(EE(1,1,itk),auxmat(1,1))
8220 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8221 vv(1)=pizda(1,1)+pizda(2,2)
8222 vv(2)=pizda(2,1)-pizda(1,2)
8223 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8224 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8225 cd & "sum",-(s2+s3+s4)
8227 eello6_graph3=-(s1+s2+s3+s4)
8229 eello6_graph3=-(s2+s3+s4)
8232 C Derivatives in gamma(k-1)
8233 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8234 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8235 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8236 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8237 C Derivatives in gamma(l-1)
8238 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8239 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8240 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8241 vv(1)=pizda(1,1)+pizda(2,2)
8242 vv(2)=pizda(2,1)-pizda(1,2)
8243 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8244 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8245 C Cartesian derivatives.
8251 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8253 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8256 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8258 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8259 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8261 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8262 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8264 vv(1)=pizda(1,1)+pizda(2,2)
8265 vv(2)=pizda(2,1)-pizda(1,2)
8266 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8268 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8270 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8273 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8275 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8277 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8283 c----------------------------------------------------------------------------
8284 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8285 implicit real*8 (a-h,o-z)
8286 include 'DIMENSIONS'
8287 include 'COMMON.IOUNITS'
8288 include 'COMMON.CHAIN'
8289 include 'COMMON.DERIV'
8290 include 'COMMON.INTERACT'
8291 include 'COMMON.CONTACTS'
8292 include 'COMMON.TORSION'
8293 include 'COMMON.VAR'
8294 include 'COMMON.GEO'
8295 include 'COMMON.FFIELD'
8296 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8297 & auxvec1(2),auxmat1(2,2)
8299 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8301 C Parallel Antiparallel C
8307 C \ j|/k\| \ |/k\|l C
8312 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8314 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8315 C energy moment and not to the cluster cumulant.
8316 cd write (2,*) 'eello_graph4: wturn6',wturn6
8317 iti=itortyp(itype(i))
8318 itj=itortyp(itype(j))
8319 if (j.lt.nres-1) then
8320 itj1=itortyp(itype(j+1))
8324 itk=itortyp(itype(k))
8325 if (k.lt.nres-1) then
8326 itk1=itortyp(itype(k+1))
8330 itl=itortyp(itype(l))
8331 if (l.lt.nres-1) then
8332 itl1=itortyp(itype(l+1))
8336 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8337 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8338 cd & ' itl',itl,' itl1',itl1
8341 s1=dip(3,jj,i)*dip(3,kk,k)
8343 s1=dip(2,jj,j)*dip(2,kk,l)
8346 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8347 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8349 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8350 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8352 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8353 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8355 call transpose2(EUg(1,1,k),auxmat(1,1))
8356 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8357 vv(1)=pizda(1,1)-pizda(2,2)
8358 vv(2)=pizda(2,1)+pizda(1,2)
8359 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8360 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8362 eello6_graph4=-(s1+s2+s3+s4)
8364 eello6_graph4=-(s2+s3+s4)
8366 C Derivatives in gamma(i-1)
8370 s1=dipderg(2,jj,i)*dip(3,kk,k)
8372 s1=dipderg(4,jj,j)*dip(2,kk,l)
8375 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8377 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8378 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8380 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8381 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8383 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8384 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8385 cd write (2,*) 'turn6 derivatives'
8387 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8389 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8393 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8395 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8399 C Derivatives in gamma(k-1)
8402 s1=dip(3,jj,i)*dipderg(2,kk,k)
8404 s1=dip(2,jj,j)*dipderg(4,kk,l)
8407 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8408 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8410 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8411 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8413 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8414 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8416 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8417 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8418 vv(1)=pizda(1,1)-pizda(2,2)
8419 vv(2)=pizda(2,1)+pizda(1,2)
8420 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8421 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8423 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8425 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8429 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8431 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8434 C Derivatives in gamma(j-1) or gamma(l-1)
8435 if (l.eq.j+1 .and. l.gt.1) then
8436 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8437 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8438 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8439 vv(1)=pizda(1,1)-pizda(2,2)
8440 vv(2)=pizda(2,1)+pizda(1,2)
8441 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8442 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8443 else if (j.gt.1) then
8444 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8445 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8446 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8447 vv(1)=pizda(1,1)-pizda(2,2)
8448 vv(2)=pizda(2,1)+pizda(1,2)
8449 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8450 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8451 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8453 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8456 C Cartesian derivatives.
8463 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8465 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8469 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8471 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8475 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8477 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8479 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8480 & b1(1,itj1),auxvec(1))
8481 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8483 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8484 & b1(1,itl1),auxvec(1))
8485 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8487 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8489 vv(1)=pizda(1,1)-pizda(2,2)
8490 vv(2)=pizda(2,1)+pizda(1,2)
8491 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8493 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8495 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8498 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8501 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8504 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8506 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8508 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8512 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8514 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8517 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8519 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8527 c----------------------------------------------------------------------------
8528 double precision function eello_turn6(i,jj,kk)
8529 implicit real*8 (a-h,o-z)
8530 include 'DIMENSIONS'
8531 include 'COMMON.IOUNITS'
8532 include 'COMMON.CHAIN'
8533 include 'COMMON.DERIV'
8534 include 'COMMON.INTERACT'
8535 include 'COMMON.CONTACTS'
8536 include 'COMMON.TORSION'
8537 include 'COMMON.VAR'
8538 include 'COMMON.GEO'
8539 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8540 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8542 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8543 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8544 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8545 C the respective energy moment and not to the cluster cumulant.
8554 iti=itortyp(itype(i))
8555 itk=itortyp(itype(k))
8556 itk1=itortyp(itype(k+1))
8557 itl=itortyp(itype(l))
8558 itj=itortyp(itype(j))
8559 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8560 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8561 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8566 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8568 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8572 derx_turn(lll,kkk,iii)=0.0d0
8579 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8581 cd write (2,*) 'eello6_5',eello6_5
8583 call transpose2(AEA(1,1,1),auxmat(1,1))
8584 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8585 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8586 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8588 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8589 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8590 s2 = scalar2(b1(1,itk),vtemp1(1))
8592 call transpose2(AEA(1,1,2),atemp(1,1))
8593 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8594 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8595 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8597 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8598 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8599 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8601 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8602 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8603 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8604 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8605 ss13 = scalar2(b1(1,itk),vtemp4(1))
8606 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8608 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8614 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8615 C Derivatives in gamma(i+2)
8619 call transpose2(AEA(1,1,1),auxmatd(1,1))
8620 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8621 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8622 call transpose2(AEAderg(1,1,2),atempd(1,1))
8623 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8624 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8626 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8627 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8628 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8634 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8635 C Derivatives in gamma(i+3)
8637 call transpose2(AEA(1,1,1),auxmatd(1,1))
8638 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8639 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8640 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8642 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8643 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8644 s2d = scalar2(b1(1,itk),vtemp1d(1))
8646 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8647 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8649 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8651 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8652 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8653 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8661 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8662 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8664 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8665 & -0.5d0*ekont*(s2d+s12d)
8667 C Derivatives in gamma(i+4)
8668 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8669 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8670 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8672 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8673 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8674 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8682 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8684 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8686 C Derivatives in gamma(i+5)
8688 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8689 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8690 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8692 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8693 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8694 s2d = scalar2(b1(1,itk),vtemp1d(1))
8696 call transpose2(AEA(1,1,2),atempd(1,1))
8697 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8698 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8700 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8701 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8703 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8704 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8705 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8713 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8714 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8716 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8717 & -0.5d0*ekont*(s2d+s12d)
8719 C Cartesian derivatives
8724 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8725 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8726 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8728 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8729 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8731 s2d = scalar2(b1(1,itk),vtemp1d(1))
8733 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8734 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8735 s8d = -(atempd(1,1)+atempd(2,2))*
8736 & scalar2(cc(1,1,itl),vtemp2(1))
8738 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8740 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8741 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8748 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8751 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8755 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8756 & - 0.5d0*(s8d+s12d)
8758 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8767 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8769 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8770 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8771 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8772 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8773 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8775 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8776 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8777 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8781 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8782 cd & 16*eel_turn6_num
8784 if (j.lt.nres-1) then
8791 if (l.lt.nres-1) then
8799 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8800 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8801 cgrad ghalf=0.5d0*ggg1(ll)
8803 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8804 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8805 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8806 & +ekont*derx_turn(ll,2,1)
8807 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8808 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8809 & +ekont*derx_turn(ll,4,1)
8810 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8811 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8812 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8813 cgrad ghalf=0.5d0*ggg2(ll)
8815 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8816 & +ekont*derx_turn(ll,2,2)
8817 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8818 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8819 & +ekont*derx_turn(ll,4,2)
8820 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8821 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8822 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8827 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8832 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8838 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8843 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8847 cd write (2,*) iii,g_corr6_loc(iii)
8849 eello_turn6=ekont*eel_turn6
8850 cd write (2,*) 'ekont',ekont
8851 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8855 C-----------------------------------------------------------------------------
8856 double precision function scalar(u,v)
8857 !DIR$ INLINEALWAYS scalar
8859 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8862 double precision u(3),v(3)
8863 cd double precision sc
8871 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8874 crc-------------------------------------------------
8875 SUBROUTINE MATVEC2(A1,V1,V2)
8876 !DIR$ INLINEALWAYS MATVEC2
8878 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8880 implicit real*8 (a-h,o-z)
8881 include 'DIMENSIONS'
8882 DIMENSION A1(2,2),V1(2),V2(2)
8886 c 3 VI=VI+A1(I,K)*V1(K)
8890 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8891 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8896 C---------------------------------------
8897 SUBROUTINE MATMAT2(A1,A2,A3)
8899 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8901 implicit real*8 (a-h,o-z)
8902 include 'DIMENSIONS'
8903 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8904 c DIMENSION AI3(2,2)
8908 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8914 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8915 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8916 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8917 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8925 c-------------------------------------------------------------------------
8926 double precision function scalar2(u,v)
8927 !DIR$ INLINEALWAYS scalar2
8929 double precision u(2),v(2)
8932 scalar2=u(1)*v(1)+u(2)*v(2)
8936 C-----------------------------------------------------------------------------
8938 subroutine transpose2(a,at)
8939 !DIR$ INLINEALWAYS transpose2
8941 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8944 double precision a(2,2),at(2,2)
8951 c--------------------------------------------------------------------------
8952 subroutine transpose(n,a,at)
8955 double precision a(n,n),at(n,n)
8963 C---------------------------------------------------------------------------
8964 subroutine prodmat3(a1,a2,kk,transp,prod)
8965 !DIR$ INLINEALWAYS prodmat3
8967 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8971 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8973 crc double precision auxmat(2,2),prod_(2,2)
8976 crc call transpose2(kk(1,1),auxmat(1,1))
8977 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8978 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8980 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8981 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8982 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8983 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8984 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8985 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8986 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8987 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8990 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8991 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8993 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8994 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8995 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8996 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8997 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8998 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8999 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9000 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9003 c call transpose2(a2(1,1),a2t(1,1))
9006 crc print *,((prod_(i,j),i=1,2),j=1,2)
9007 crc print *,((prod(i,j),i=1,2),j=1,2)