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 Here are the energies showed per procesor if the are more processors
300 c per molecule then we sum it up in sum_energy subroutine
301 c print *," Processor",myrank," calls SUM_ENERGY"
302 call sum_energy(energia,.true.)
303 c print *," Processor",myrank," left SUM_ENERGY"
305 time_sumene=time_sumene+MPI_Wtime()-time00
309 c-------------------------------------------------------------------------------
310 subroutine sum_energy(energia,reduce)
311 implicit real*8 (a-h,o-z)
316 cMS$ATTRIBUTES C :: proc_proc
322 include 'COMMON.SETUP'
323 include 'COMMON.IOUNITS'
324 double precision energia(0:n_ene),enebuff(0:n_ene+1)
325 include 'COMMON.FFIELD'
326 include 'COMMON.DERIV'
327 include 'COMMON.INTERACT'
328 include 'COMMON.SBRIDGE'
329 include 'COMMON.CHAIN'
331 include 'COMMON.CONTROL'
332 include 'COMMON.TIME1'
335 if (nfgtasks.gt.1 .and. reduce) then
337 write (iout,*) "energies before REDUCE"
338 call enerprint(energia)
342 enebuff(i)=energia(i)
345 call MPI_Barrier(FG_COMM,IERR)
346 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
348 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
349 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
351 write (iout,*) "energies after REDUCE"
352 call enerprint(energia)
355 time_Reduce=time_Reduce+MPI_Wtime()-time00
357 if (fg_rank.eq.0) then
361 evdw2=energia(2)+energia(18)
377 eello_turn3=energia(8)
378 eello_turn4=energia(9)
385 edihcnstr=energia(19)
390 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
391 & +wang*ebe+wtor*etors+wscloc*escloc
392 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
393 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
394 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
395 & +wbond*estr+Uconst+wsccor*esccor
397 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
408 if (isnan(etot).ne.0) energia(0)=1.0d+99
410 if (isnan(etot)) energia(0)=1.0d+99
415 idumm=proc_proc(etot,i)
417 call proc_proc(etot,i)
419 if(i.eq.1)energia(0)=1.0d+99
426 c-------------------------------------------------------------------------------
427 subroutine sum_gradient
428 implicit real*8 (a-h,o-z)
433 cMS$ATTRIBUTES C :: proc_proc
438 double precision gradbufc(3,maxres),gradbufx(3,maxres),
439 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
441 include 'COMMON.SETUP'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.FFIELD'
444 include 'COMMON.DERIV'
445 include 'COMMON.INTERACT'
446 include 'COMMON.SBRIDGE'
447 include 'COMMON.CHAIN'
449 include 'COMMON.CONTROL'
450 include 'COMMON.TIME1'
451 include 'COMMON.MAXGRAD'
452 include 'COMMON.SCCOR'
457 write (iout,*) "sum_gradient gvdwc, gvdwx"
459 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
460 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
465 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
466 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
467 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
470 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
471 C in virtual-bond-vector coordinates
474 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
476 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
477 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
479 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
481 c write (iout,'(i5,3f10.5,2x,f10.5)')
482 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
484 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
486 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
487 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
495 gradbufc(j,i)=wsc*gvdwc(j,i)+
496 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
497 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
498 & wel_loc*gel_loc_long(j,i)+
499 & wcorr*gradcorr_long(j,i)+
500 & wcorr5*gradcorr5_long(j,i)+
501 & wcorr6*gradcorr6_long(j,i)+
502 & wturn6*gcorr6_turn_long(j,i)+
509 gradbufc(j,i)=wsc*gvdwc(j,i)+
510 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
511 & welec*gelc_long(j,i)+
513 & wel_loc*gel_loc_long(j,i)+
514 & wcorr*gradcorr_long(j,i)+
515 & wcorr5*gradcorr5_long(j,i)+
516 & wcorr6*gradcorr6_long(j,i)+
517 & wturn6*gcorr6_turn_long(j,i)+
523 if (nfgtasks.gt.1) then
526 write (iout,*) "gradbufc before allreduce"
528 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
534 gradbufc_sum(j,i)=gradbufc(j,i)
537 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
538 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
539 c time_reduce=time_reduce+MPI_Wtime()-time00
541 c write (iout,*) "gradbufc_sum after allreduce"
543 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
548 c time_allreduce=time_allreduce+MPI_Wtime()-time00
556 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
557 write (iout,*) (i," jgrad_start",jgrad_start(i),
558 & " jgrad_end ",jgrad_end(i),
559 & i=igrad_start,igrad_end)
562 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
563 c do not parallelize this part.
565 c do i=igrad_start,igrad_end
566 c do j=jgrad_start(i),jgrad_end(i)
568 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
573 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
577 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
581 write (iout,*) "gradbufc after summing"
583 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
590 write (iout,*) "gradbufc"
592 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
598 gradbufc_sum(j,i)=gradbufc(j,i)
603 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
607 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
612 c gradbufc(k,i)=0.0d0
616 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
621 write (iout,*) "gradbufc after summing"
623 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
631 gradbufc(k,nres)=0.0d0
636 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
637 & wel_loc*gel_loc(j,i)+
638 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
639 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
640 & wel_loc*gel_loc_long(j,i)+
641 & wcorr*gradcorr_long(j,i)+
642 & wcorr5*gradcorr5_long(j,i)+
643 & wcorr6*gradcorr6_long(j,i)+
644 & wturn6*gcorr6_turn_long(j,i))+
646 & wcorr*gradcorr(j,i)+
647 & wturn3*gcorr3_turn(j,i)+
648 & wturn4*gcorr4_turn(j,i)+
649 & wcorr5*gradcorr5(j,i)+
650 & wcorr6*gradcorr6(j,i)+
651 & wturn6*gcorr6_turn(j,i)+
652 & wsccor*gsccorc(j,i)
653 & +wscloc*gscloc(j,i)
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
676 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
677 & wsccor*gsccorx(j,i)
678 & +wscloc*gsclocx(j,i)
682 write (iout,*) "gloc before adding corr"
684 write (iout,*) i,gloc(i,icg)
688 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
689 & +wcorr5*g_corr5_loc(i)
690 & +wcorr6*g_corr6_loc(i)
691 & +wturn4*gel_loc_turn4(i)
692 & +wturn3*gel_loc_turn3(i)
693 & +wturn6*gel_loc_turn6(i)
694 & +wel_loc*gel_loc_loc(i)
697 write (iout,*) "gloc after adding corr"
699 write (iout,*) i,gloc(i,icg)
703 if (nfgtasks.gt.1) then
706 gradbufc(j,i)=gradc(j,i,icg)
707 gradbufx(j,i)=gradx(j,i,icg)
711 glocbuf(i)=gloc(i,icg)
715 write (iout,*) "gloc_sc before reduce"
718 write (iout,*) i,j,gloc_sc(j,i,icg)
725 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
729 call MPI_Barrier(FG_COMM,IERR)
730 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
732 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
734 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
736 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
737 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
738 time_reduce=time_reduce+MPI_Wtime()-time00
739 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 time_reduce=time_reduce+MPI_Wtime()-time00
744 write (iout,*) "gloc_sc after reduce"
747 write (iout,*) i,j,gloc_sc(j,i,icg)
753 write (iout,*) "gloc after reduce"
755 write (iout,*) i,gloc(i,icg)
760 if (gnorm_check) then
762 c Compute the maximum elements of the gradient
772 gcorr3_turn_max=0.0d0
773 gcorr4_turn_max=0.0d0
776 gcorr6_turn_max=0.0d0
786 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
787 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
788 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
789 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
790 & gvdwc_scp_max=gvdwc_scp_norm
791 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
792 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
793 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
794 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
795 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
796 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
797 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
798 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
799 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
800 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
801 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
802 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
803 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
805 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
806 & gcorr3_turn_max=gcorr3_turn_norm
807 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
809 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
810 & gcorr4_turn_max=gcorr4_turn_norm
811 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
812 if (gradcorr5_norm.gt.gradcorr5_max)
813 & gradcorr5_max=gradcorr5_norm
814 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
815 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
816 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
818 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
819 & gcorr6_turn_max=gcorr6_turn_norm
820 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
821 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
822 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
823 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
824 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
825 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
826 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
827 if (gradx_scp_norm.gt.gradx_scp_max)
828 & gradx_scp_max=gradx_scp_norm
829 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
830 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
831 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
832 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
833 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
834 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
835 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
836 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
840 open(istat,file=statname,position="append")
842 open(istat,file=statname,access="append")
844 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
845 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
846 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
847 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
848 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
849 & gsccorx_max,gsclocx_max
851 if (gvdwc_max.gt.1.0d4) then
852 write (iout,*) "gvdwc gvdwx gradb gradbx"
854 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
855 & gradb(j,i),gradbx(j,i),j=1,3)
857 call pdbout(0.0d0,'cipiszcze',iout)
863 write (iout,*) "gradc gradx gloc"
865 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
866 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
870 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
874 c-------------------------------------------------------------------------------
875 subroutine rescale_weights(t_bath)
876 implicit real*8 (a-h,o-z)
878 include 'COMMON.IOUNITS'
879 include 'COMMON.FFIELD'
880 include 'COMMON.SBRIDGE'
881 double precision kfac /2.4d0/
882 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
884 c facT=2*temp0/(t_bath+temp0)
885 if (rescale_mode.eq.0) then
891 else if (rescale_mode.eq.1) then
892 facT=kfac/(kfac-1.0d0+t_bath/temp0)
893 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
894 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
895 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
896 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
897 else if (rescale_mode.eq.2) then
903 facT=licznik/dlog(dexp(x)+dexp(-x))
904 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
905 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
906 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
907 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
909 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
910 write (*,*) "Wrong RESCALE_MODE",rescale_mode
912 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
916 welec=weights(3)*fact
917 wcorr=weights(4)*fact3
918 wcorr5=weights(5)*fact4
919 wcorr6=weights(6)*fact5
920 wel_loc=weights(7)*fact2
921 wturn3=weights(8)*fact2
922 wturn4=weights(9)*fact3
923 wturn6=weights(10)*fact5
924 wtor=weights(13)*fact
925 wtor_d=weights(14)*fact2
926 wsccor=weights(21)*fact
930 C------------------------------------------------------------------------
931 subroutine enerprint(energia)
932 implicit real*8 (a-h,o-z)
934 include 'COMMON.IOUNITS'
935 include 'COMMON.FFIELD'
936 include 'COMMON.SBRIDGE'
938 double precision energia(0:n_ene)
943 evdw2=energia(2)+energia(18)
955 eello_turn3=energia(8)
956 eello_turn4=energia(9)
957 eello_turn6=energia(10)
963 edihcnstr=energia(19)
968 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
969 & estr,wbond,ebe,wang,
970 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
972 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
973 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
976 10 format (/'Virtual-chain energies:'//
977 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
978 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
979 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
980 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
981 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
982 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
983 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
984 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
985 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
986 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
987 & ' (SS bridges & dist. cnstr.)'/
988 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
989 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
992 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
993 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
994 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
995 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
996 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
997 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
998 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
999 & 'ETOT= ',1pE16.6,' (total)')
1001 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1002 & estr,wbond,ebe,wang,
1003 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1005 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1006 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1007 & ebr*nss,Uconst,etot
1008 10 format (/'Virtual-chain energies:'//
1009 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1010 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1011 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1012 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1013 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1014 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1015 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1016 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1017 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1018 & ' (SS bridges & dist. cnstr.)'/
1019 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1021 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1022 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1023 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1024 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1025 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1026 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1027 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1028 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1029 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1030 & 'ETOT= ',1pE16.6,' (total)')
1034 C-----------------------------------------------------------------------
1035 subroutine elj(evdw)
1037 C This subroutine calculates the interaction energy of nonbonded side chains
1038 C assuming the LJ potential of interaction.
1040 implicit real*8 (a-h,o-z)
1041 include 'DIMENSIONS'
1042 parameter (accur=1.0d-10)
1043 include 'COMMON.GEO'
1044 include 'COMMON.VAR'
1045 include 'COMMON.LOCAL'
1046 include 'COMMON.CHAIN'
1047 include 'COMMON.DERIV'
1048 include 'COMMON.INTERACT'
1049 include 'COMMON.TORSION'
1050 include 'COMMON.SBRIDGE'
1051 include 'COMMON.NAMES'
1052 include 'COMMON.IOUNITS'
1053 include 'COMMON.CONTACTS'
1055 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1057 do i=iatsc_s,iatsc_e
1058 itypi=iabs(itype(i))
1059 if (itypi.eq.ntyp1) cycle
1060 itypi1=iabs(itype(i+1))
1067 C Calculate SC interaction energy.
1069 do iint=1,nint_gr(i)
1070 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1071 cd & 'iend=',iend(i,iint)
1072 do j=istart(i,iint),iend(i,iint)
1073 itypj=iabs(itype(j))
1074 if (itypj.eq.ntyp1) cycle
1078 C Change 12/1/95 to calculate four-body interactions
1079 rij=xj*xj+yj*yj+zj*zj
1081 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1082 eps0ij=eps(itypi,itypj)
1084 e1=fac*fac*aa(itypi,itypj)
1085 e2=fac*bb(itypi,itypj)
1087 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1088 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1089 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1090 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1091 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1092 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1095 C Calculate the components of the gradient in DC and X
1097 fac=-rrij*(e1+evdwij)
1102 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1103 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1104 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1105 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1109 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1113 C 12/1/95, revised on 5/20/97
1115 C Calculate the contact function. The ith column of the array JCONT will
1116 C contain the numbers of atoms that make contacts with the atom I (of numbers
1117 C greater than I). The arrays FACONT and GACONT will contain the values of
1118 C the contact function and its derivative.
1120 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1121 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1122 C Uncomment next line, if the correlation interactions are contact function only
1123 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1125 sigij=sigma(itypi,itypj)
1126 r0ij=rs0(itypi,itypj)
1128 C Check whether the SC's are not too far to make a contact.
1131 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1132 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1134 if (fcont.gt.0.0D0) then
1135 C If the SC-SC distance if close to sigma, apply spline.
1136 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1137 cAdam & fcont1,fprimcont1)
1138 cAdam fcont1=1.0d0-fcont1
1139 cAdam if (fcont1.gt.0.0d0) then
1140 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1141 cAdam fcont=fcont*fcont1
1143 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1144 cga eps0ij=1.0d0/dsqrt(eps0ij)
1146 cga gg(k)=gg(k)*eps0ij
1148 cga eps0ij=-evdwij*eps0ij
1149 C Uncomment for AL's type of SC correlation interactions.
1150 cadam eps0ij=-evdwij
1151 num_conti=num_conti+1
1152 jcont(num_conti,i)=j
1153 facont(num_conti,i)=fcont*eps0ij
1154 fprimcont=eps0ij*fprimcont/rij
1156 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1157 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1158 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1159 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1160 gacont(1,num_conti,i)=-fprimcont*xj
1161 gacont(2,num_conti,i)=-fprimcont*yj
1162 gacont(3,num_conti,i)=-fprimcont*zj
1163 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1164 cd write (iout,'(2i3,3f10.5)')
1165 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1171 num_cont(i)=num_conti
1175 gvdwc(j,i)=expon*gvdwc(j,i)
1176 gvdwx(j,i)=expon*gvdwx(j,i)
1179 C******************************************************************************
1183 C To save time, the factor of EXPON has been extracted from ALL components
1184 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1187 C******************************************************************************
1190 C-----------------------------------------------------------------------------
1191 subroutine eljk(evdw)
1193 C This subroutine calculates the interaction energy of nonbonded side chains
1194 C assuming the LJK potential of interaction.
1196 implicit real*8 (a-h,o-z)
1197 include 'DIMENSIONS'
1198 include 'COMMON.GEO'
1199 include 'COMMON.VAR'
1200 include 'COMMON.LOCAL'
1201 include 'COMMON.CHAIN'
1202 include 'COMMON.DERIV'
1203 include 'COMMON.INTERACT'
1204 include 'COMMON.IOUNITS'
1205 include 'COMMON.NAMES'
1208 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1210 do i=iatsc_s,iatsc_e
1211 itypi=iabs(itype(i))
1212 if (itypi.eq.ntyp1) cycle
1213 itypi1=iabs(itype(i+1))
1218 C Calculate SC interaction energy.
1220 do iint=1,nint_gr(i)
1221 do j=istart(i,iint),iend(i,iint)
1222 itypj=iabs(itype(j))
1223 if (itypj.eq.ntyp1) cycle
1227 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1228 fac_augm=rrij**expon
1229 e_augm=augm(itypi,itypj)*fac_augm
1230 r_inv_ij=dsqrt(rrij)
1232 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1233 fac=r_shift_inv**expon
1234 e1=fac*fac*aa(itypi,itypj)
1235 e2=fac*bb(itypi,itypj)
1237 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1238 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1239 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1240 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1241 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1242 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1243 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1246 C Calculate the components of the gradient in DC and X
1248 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1253 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1254 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1255 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1256 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1260 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1268 gvdwc(j,i)=expon*gvdwc(j,i)
1269 gvdwx(j,i)=expon*gvdwx(j,i)
1274 C-----------------------------------------------------------------------------
1275 subroutine ebp(evdw)
1277 C This subroutine calculates the interaction energy of nonbonded side chains
1278 C assuming the Berne-Pechukas potential of interaction.
1280 implicit real*8 (a-h,o-z)
1281 include 'DIMENSIONS'
1282 include 'COMMON.GEO'
1283 include 'COMMON.VAR'
1284 include 'COMMON.LOCAL'
1285 include 'COMMON.CHAIN'
1286 include 'COMMON.DERIV'
1287 include 'COMMON.NAMES'
1288 include 'COMMON.INTERACT'
1289 include 'COMMON.IOUNITS'
1290 include 'COMMON.CALC'
1291 common /srutu/ icall
1292 c double precision rrsave(maxdim)
1295 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1297 c if (icall.eq.0) then
1303 do i=iatsc_s,iatsc_e
1304 itypi=iabs(itype(i))
1305 if (itypi.eq.ntyp1) cycle
1306 itypi1=iabs(itype(i+1))
1310 dxi=dc_norm(1,nres+i)
1311 dyi=dc_norm(2,nres+i)
1312 dzi=dc_norm(3,nres+i)
1313 c dsci_inv=dsc_inv(itypi)
1314 dsci_inv=vbld_inv(i+nres)
1316 C Calculate SC interaction energy.
1318 do iint=1,nint_gr(i)
1319 do j=istart(i,iint),iend(i,iint)
1321 itypj=iabs(itype(j))
1322 if (itypj.eq.ntyp1) cycle
1323 c dscj_inv=dsc_inv(itypj)
1324 dscj_inv=vbld_inv(j+nres)
1325 chi1=chi(itypi,itypj)
1326 chi2=chi(itypj,itypi)
1333 alf12=0.5D0*(alf1+alf2)
1334 C For diagnostics only!!!
1347 dxj=dc_norm(1,nres+j)
1348 dyj=dc_norm(2,nres+j)
1349 dzj=dc_norm(3,nres+j)
1350 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1351 cd if (icall.eq.0) then
1357 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1359 C Calculate whole angle-dependent part of epsilon and contributions
1360 C to its derivatives
1361 fac=(rrij*sigsq)**expon2
1362 e1=fac*fac*aa(itypi,itypj)
1363 e2=fac*bb(itypi,itypj)
1364 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1365 eps2der=evdwij*eps3rt
1366 eps3der=evdwij*eps2rt
1367 evdwij=evdwij*eps2rt*eps3rt
1370 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1371 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1372 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1373 cd & restyp(itypi),i,restyp(itypj),j,
1374 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1375 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1376 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1379 C Calculate gradient components.
1380 e1=e1*eps1*eps2rt**2*eps3rt**2
1381 fac=-expon*(e1+evdwij)
1384 C Calculate radial part of the gradient
1388 C Calculate the angular part of the gradient and sum add the contributions
1389 C to the appropriate components of the Cartesian gradient.
1397 C-----------------------------------------------------------------------------
1398 subroutine egb(evdw)
1400 C This subroutine calculates the interaction energy of nonbonded side chains
1401 C assuming the Gay-Berne potential of interaction.
1403 implicit real*8 (a-h,o-z)
1404 include 'DIMENSIONS'
1405 include 'COMMON.GEO'
1406 include 'COMMON.VAR'
1407 include 'COMMON.LOCAL'
1408 include 'COMMON.CHAIN'
1409 include 'COMMON.DERIV'
1410 include 'COMMON.NAMES'
1411 include 'COMMON.INTERACT'
1412 include 'COMMON.IOUNITS'
1413 include 'COMMON.CALC'
1414 include 'COMMON.CONTROL'
1417 ccccc energy_dec=.false.
1418 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1421 c if (icall.eq.0) lprn=.false.
1423 do i=iatsc_s,iatsc_e
1424 itypi=iabs(itype(i))
1425 if (itypi.eq.ntyp1) cycle
1426 itypi1=iabs(itype(i+1))
1430 dxi=dc_norm(1,nres+i)
1431 dyi=dc_norm(2,nres+i)
1432 dzi=dc_norm(3,nres+i)
1433 c dsci_inv=dsc_inv(itypi)
1434 dsci_inv=vbld_inv(i+nres)
1435 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1436 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1438 C Calculate SC interaction energy.
1440 do iint=1,nint_gr(i)
1441 do j=istart(i,iint),iend(i,iint)
1443 itypj=iabs(itype(j))
1444 if (itypj.eq.ntyp1) cycle
1445 c dscj_inv=dsc_inv(itypj)
1446 dscj_inv=vbld_inv(j+nres)
1447 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1448 c & 1.0d0/vbld(j+nres)
1449 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1450 sig0ij=sigma(itypi,itypj)
1451 chi1=chi(itypi,itypj)
1452 chi2=chi(itypj,itypi)
1459 alf12=0.5D0*(alf1+alf2)
1460 C For diagnostics only!!!
1473 dxj=dc_norm(1,nres+j)
1474 dyj=dc_norm(2,nres+j)
1475 dzj=dc_norm(3,nres+j)
1476 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1477 c write (iout,*) "j",j," dc_norm",
1478 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1479 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1481 C Calculate angle-dependent terms of energy and contributions to their
1485 sig=sig0ij*dsqrt(sigsq)
1486 rij_shift=1.0D0/rij-sig+sig0ij
1487 c for diagnostics; uncomment
1488 c rij_shift=1.2*sig0ij
1489 C I hate to put IF's in the loops, but here don't have another choice!!!!
1490 if (rij_shift.le.0.0D0) then
1492 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1493 cd & restyp(itypi),i,restyp(itypj),j,
1494 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1498 c---------------------------------------------------------------
1499 rij_shift=1.0D0/rij_shift
1500 fac=rij_shift**expon
1501 e1=fac*fac*aa(itypi,itypj)
1502 e2=fac*bb(itypi,itypj)
1503 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1504 eps2der=evdwij*eps3rt
1505 eps3der=evdwij*eps2rt
1506 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1507 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1508 evdwij=evdwij*eps2rt*eps3rt
1511 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1512 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1513 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1514 & restyp(itypi),i,restyp(itypj),j,
1515 & epsi,sigm,chi1,chi2,chip1,chip2,
1516 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1517 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1521 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1524 C Calculate gradient components.
1525 e1=e1*eps1*eps2rt**2*eps3rt**2
1526 fac=-expon*(e1+evdwij)*rij_shift
1530 C Calculate the radial part of the gradient
1534 C Calculate angular part of the gradient.
1539 c write (iout,*) "Number of loop steps in EGB:",ind
1540 cccc energy_dec=.false.
1543 C-----------------------------------------------------------------------------
1544 subroutine egbv(evdw)
1546 C This subroutine calculates the interaction energy of nonbonded side chains
1547 C assuming the Gay-Berne-Vorobjev potential of interaction.
1549 implicit real*8 (a-h,o-z)
1550 include 'DIMENSIONS'
1551 include 'COMMON.GEO'
1552 include 'COMMON.VAR'
1553 include 'COMMON.LOCAL'
1554 include 'COMMON.CHAIN'
1555 include 'COMMON.DERIV'
1556 include 'COMMON.NAMES'
1557 include 'COMMON.INTERACT'
1558 include 'COMMON.IOUNITS'
1559 include 'COMMON.CALC'
1560 common /srutu/ icall
1563 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1566 c if (icall.eq.0) lprn=.true.
1568 do i=iatsc_s,iatsc_e
1569 itypi=iabs(itype(i))
1570 if (itypi.eq.ntyp1) cycle
1571 itypi1=iabs(itype(i+1))
1575 dxi=dc_norm(1,nres+i)
1576 dyi=dc_norm(2,nres+i)
1577 dzi=dc_norm(3,nres+i)
1578 c dsci_inv=dsc_inv(itypi)
1579 dsci_inv=vbld_inv(i+nres)
1581 C Calculate SC interaction energy.
1583 do iint=1,nint_gr(i)
1584 do j=istart(i,iint),iend(i,iint)
1586 itypj=iabs(itype(j))
1587 if (itypj.eq.ntyp1) cycle
1588 c dscj_inv=dsc_inv(itypj)
1589 dscj_inv=vbld_inv(j+nres)
1590 sig0ij=sigma(itypi,itypj)
1591 r0ij=r0(itypi,itypj)
1592 chi1=chi(itypi,itypj)
1593 chi2=chi(itypj,itypi)
1600 alf12=0.5D0*(alf1+alf2)
1601 C For diagnostics only!!!
1614 dxj=dc_norm(1,nres+j)
1615 dyj=dc_norm(2,nres+j)
1616 dzj=dc_norm(3,nres+j)
1617 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1619 C Calculate angle-dependent terms of energy and contributions to their
1623 sig=sig0ij*dsqrt(sigsq)
1624 rij_shift=1.0D0/rij-sig+r0ij
1625 C I hate to put IF's in the loops, but here don't have another choice!!!!
1626 if (rij_shift.le.0.0D0) then
1631 c---------------------------------------------------------------
1632 rij_shift=1.0D0/rij_shift
1633 fac=rij_shift**expon
1634 e1=fac*fac*aa(itypi,itypj)
1635 e2=fac*bb(itypi,itypj)
1636 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1637 eps2der=evdwij*eps3rt
1638 eps3der=evdwij*eps2rt
1639 fac_augm=rrij**expon
1640 e_augm=augm(itypi,itypj)*fac_augm
1641 evdwij=evdwij*eps2rt*eps3rt
1642 evdw=evdw+evdwij+e_augm
1644 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1645 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1646 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1647 & restyp(itypi),i,restyp(itypj),j,
1648 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1649 & chi1,chi2,chip1,chip2,
1650 & eps1,eps2rt**2,eps3rt**2,
1651 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1654 C Calculate gradient components.
1655 e1=e1*eps1*eps2rt**2*eps3rt**2
1656 fac=-expon*(e1+evdwij)*rij_shift
1658 fac=rij*fac-2*expon*rrij*e_augm
1659 C Calculate the radial part of the gradient
1663 C Calculate angular part of the gradient.
1669 C-----------------------------------------------------------------------------
1670 subroutine sc_angular
1671 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1672 C om12. Called by ebp, egb, and egbv.
1674 include 'COMMON.CALC'
1675 include 'COMMON.IOUNITS'
1679 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1680 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1681 om12=dxi*dxj+dyi*dyj+dzi*dzj
1683 C Calculate eps1(om12) and its derivative in om12
1684 faceps1=1.0D0-om12*chiom12
1685 faceps1_inv=1.0D0/faceps1
1686 eps1=dsqrt(faceps1_inv)
1687 C Following variable is eps1*deps1/dom12
1688 eps1_om12=faceps1_inv*chiom12
1693 c write (iout,*) "om12",om12," eps1",eps1
1694 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1699 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1700 sigsq=1.0D0-facsig*faceps1_inv
1701 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1702 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1703 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1709 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1710 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1712 C Calculate eps2 and its derivatives in om1, om2, and om12.
1715 chipom12=chip12*om12
1716 facp=1.0D0-om12*chipom12
1718 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1719 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1720 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1721 C Following variable is the square root of eps2
1722 eps2rt=1.0D0-facp1*facp_inv
1723 C Following three variables are the derivatives of the square root of eps
1724 C in om1, om2, and om12.
1725 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1726 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1727 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1728 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1729 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1730 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1731 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1732 c & " eps2rt_om12",eps2rt_om12
1733 C Calculate whole angle-dependent part of epsilon and contributions
1734 C to its derivatives
1737 C----------------------------------------------------------------------------
1739 implicit real*8 (a-h,o-z)
1740 include 'DIMENSIONS'
1741 include 'COMMON.CHAIN'
1742 include 'COMMON.DERIV'
1743 include 'COMMON.CALC'
1744 include 'COMMON.IOUNITS'
1745 double precision dcosom1(3),dcosom2(3)
1746 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1747 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1748 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1749 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1753 c eom12=evdwij*eps1_om12
1755 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1756 c & " sigder",sigder
1757 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1758 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1760 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1761 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1764 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1766 c write (iout,*) "gg",(gg(k),k=1,3)
1768 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1769 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1770 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1771 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1772 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1773 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1774 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1775 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1776 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1777 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1780 C Calculate the components of the gradient in DC and X
1784 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1788 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1789 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1793 C-----------------------------------------------------------------------
1794 subroutine e_softsphere(evdw)
1796 C This subroutine calculates the interaction energy of nonbonded side chains
1797 C assuming the LJ potential of interaction.
1799 implicit real*8 (a-h,o-z)
1800 include 'DIMENSIONS'
1801 parameter (accur=1.0d-10)
1802 include 'COMMON.GEO'
1803 include 'COMMON.VAR'
1804 include 'COMMON.LOCAL'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.INTERACT'
1808 include 'COMMON.TORSION'
1809 include 'COMMON.SBRIDGE'
1810 include 'COMMON.NAMES'
1811 include 'COMMON.IOUNITS'
1812 include 'COMMON.CONTACTS'
1814 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1816 do i=iatsc_s,iatsc_e
1817 itypi=iabs(itype(i))
1818 if (itypi.eq.ntyp1) cycle
1819 itypi1=iabs(itype(i+1))
1824 C Calculate SC interaction energy.
1826 do iint=1,nint_gr(i)
1827 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1828 cd & 'iend=',iend(i,iint)
1829 do j=istart(i,iint),iend(i,iint)
1830 itypj=iabs(itype(j))
1831 if (itypj.eq.ntyp1) cycle
1835 rij=xj*xj+yj*yj+zj*zj
1836 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1837 r0ij=r0(itypi,itypj)
1839 c print *,i,j,r0ij,dsqrt(rij)
1840 if (rij.lt.r0ijsq) then
1841 evdwij=0.25d0*(rij-r0ijsq)**2
1849 C Calculate the components of the gradient in DC and X
1855 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1856 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1857 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1858 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1862 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1870 C--------------------------------------------------------------------------
1871 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1874 C Soft-sphere potential of p-p interaction
1876 implicit real*8 (a-h,o-z)
1877 include 'DIMENSIONS'
1878 include 'COMMON.CONTROL'
1879 include 'COMMON.IOUNITS'
1880 include 'COMMON.GEO'
1881 include 'COMMON.VAR'
1882 include 'COMMON.LOCAL'
1883 include 'COMMON.CHAIN'
1884 include 'COMMON.DERIV'
1885 include 'COMMON.INTERACT'
1886 include 'COMMON.CONTACTS'
1887 include 'COMMON.TORSION'
1888 include 'COMMON.VECTORS'
1889 include 'COMMON.FFIELD'
1891 cd write(iout,*) 'In EELEC_soft_sphere'
1898 do i=iatel_s,iatel_e
1899 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1903 xmedi=c(1,i)+0.5d0*dxi
1904 ymedi=c(2,i)+0.5d0*dyi
1905 zmedi=c(3,i)+0.5d0*dzi
1907 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1908 do j=ielstart(i),ielend(i)
1909 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1913 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1914 r0ij=rpp(iteli,itelj)
1919 xj=c(1,j)+0.5D0*dxj-xmedi
1920 yj=c(2,j)+0.5D0*dyj-ymedi
1921 zj=c(3,j)+0.5D0*dzj-zmedi
1922 rij=xj*xj+yj*yj+zj*zj
1923 if (rij.lt.r0ijsq) then
1924 evdw1ij=0.25d0*(rij-r0ijsq)**2
1932 C Calculate contributions to the Cartesian gradient.
1938 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1939 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1942 * Loop over residues i+1 thru j-1.
1946 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1951 cgrad do i=nnt,nct-1
1953 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1955 cgrad do j=i+1,nct-1
1957 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1963 c------------------------------------------------------------------------------
1964 subroutine vec_and_deriv
1965 implicit real*8 (a-h,o-z)
1966 include 'DIMENSIONS'
1970 include 'COMMON.IOUNITS'
1971 include 'COMMON.GEO'
1972 include 'COMMON.VAR'
1973 include 'COMMON.LOCAL'
1974 include 'COMMON.CHAIN'
1975 include 'COMMON.VECTORS'
1976 include 'COMMON.SETUP'
1977 include 'COMMON.TIME1'
1978 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1979 C Compute the local reference systems. For reference system (i), the
1980 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1981 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1983 do i=ivec_start,ivec_end
1987 if (i.eq.nres-1) then
1988 C Case of the last full residue
1989 C Compute the Z-axis
1990 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1991 costh=dcos(pi-theta(nres))
1992 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1996 C Compute the derivatives of uz
1998 uzder(2,1,1)=-dc_norm(3,i-1)
1999 uzder(3,1,1)= dc_norm(2,i-1)
2000 uzder(1,2,1)= dc_norm(3,i-1)
2002 uzder(3,2,1)=-dc_norm(1,i-1)
2003 uzder(1,3,1)=-dc_norm(2,i-1)
2004 uzder(2,3,1)= dc_norm(1,i-1)
2007 uzder(2,1,2)= dc_norm(3,i)
2008 uzder(3,1,2)=-dc_norm(2,i)
2009 uzder(1,2,2)=-dc_norm(3,i)
2011 uzder(3,2,2)= dc_norm(1,i)
2012 uzder(1,3,2)= dc_norm(2,i)
2013 uzder(2,3,2)=-dc_norm(1,i)
2015 C Compute the Y-axis
2018 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2020 C Compute the derivatives of uy
2023 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2024 & -dc_norm(k,i)*dc_norm(j,i-1)
2025 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2027 uyder(j,j,1)=uyder(j,j,1)-costh
2028 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2033 uygrad(l,k,j,i)=uyder(l,k,j)
2034 uzgrad(l,k,j,i)=uzder(l,k,j)
2038 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2039 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2040 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2041 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2044 C Compute the Z-axis
2045 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2046 costh=dcos(pi-theta(i+2))
2047 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2051 C Compute the derivatives of uz
2053 uzder(2,1,1)=-dc_norm(3,i+1)
2054 uzder(3,1,1)= dc_norm(2,i+1)
2055 uzder(1,2,1)= dc_norm(3,i+1)
2057 uzder(3,2,1)=-dc_norm(1,i+1)
2058 uzder(1,3,1)=-dc_norm(2,i+1)
2059 uzder(2,3,1)= dc_norm(1,i+1)
2062 uzder(2,1,2)= dc_norm(3,i)
2063 uzder(3,1,2)=-dc_norm(2,i)
2064 uzder(1,2,2)=-dc_norm(3,i)
2066 uzder(3,2,2)= dc_norm(1,i)
2067 uzder(1,3,2)= dc_norm(2,i)
2068 uzder(2,3,2)=-dc_norm(1,i)
2070 C Compute the Y-axis
2073 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2075 C Compute the derivatives of uy
2078 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2079 & -dc_norm(k,i)*dc_norm(j,i+1)
2080 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2082 uyder(j,j,1)=uyder(j,j,1)-costh
2083 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2088 uygrad(l,k,j,i)=uyder(l,k,j)
2089 uzgrad(l,k,j,i)=uzder(l,k,j)
2093 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2094 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2095 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2096 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2100 vbld_inv_temp(1)=vbld_inv(i+1)
2101 if (i.lt.nres-1) then
2102 vbld_inv_temp(2)=vbld_inv(i+2)
2104 vbld_inv_temp(2)=vbld_inv(i)
2109 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2110 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2115 #if defined(PARVEC) && defined(MPI)
2116 if (nfgtasks1.gt.1) then
2118 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2119 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2120 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2121 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2122 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2124 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2125 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2127 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2128 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2129 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2130 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2131 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2132 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2133 time_gather=time_gather+MPI_Wtime()-time00
2135 c if (fg_rank.eq.0) then
2136 c write (iout,*) "Arrays UY and UZ"
2138 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2145 C-----------------------------------------------------------------------------
2146 subroutine check_vecgrad
2147 implicit real*8 (a-h,o-z)
2148 include 'DIMENSIONS'
2149 include 'COMMON.IOUNITS'
2150 include 'COMMON.GEO'
2151 include 'COMMON.VAR'
2152 include 'COMMON.LOCAL'
2153 include 'COMMON.CHAIN'
2154 include 'COMMON.VECTORS'
2155 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2156 dimension uyt(3,maxres),uzt(3,maxres)
2157 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2158 double precision delta /1.0d-7/
2161 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2162 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2163 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2164 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2165 cd & (dc_norm(if90,i),if90=1,3)
2166 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2167 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2168 cd write(iout,'(a)')
2174 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2175 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2188 cd write (iout,*) 'i=',i
2190 erij(k)=dc_norm(k,i)
2194 dc_norm(k,i)=erij(k)
2196 dc_norm(j,i)=dc_norm(j,i)+delta
2197 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2199 c dc_norm(k,i)=dc_norm(k,i)/fac
2201 c write (iout,*) (dc_norm(k,i),k=1,3)
2202 c write (iout,*) (erij(k),k=1,3)
2205 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2206 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2207 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2208 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2210 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2211 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2212 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2215 dc_norm(k,i)=erij(k)
2218 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2219 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2220 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2221 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2222 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2223 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2224 cd write (iout,'(a)')
2229 C--------------------------------------------------------------------------
2230 subroutine set_matrices
2231 implicit real*8 (a-h,o-z)
2232 include 'DIMENSIONS'
2235 include "COMMON.SETUP"
2237 integer status(MPI_STATUS_SIZE)
2239 include 'COMMON.IOUNITS'
2240 include 'COMMON.GEO'
2241 include 'COMMON.VAR'
2242 include 'COMMON.LOCAL'
2243 include 'COMMON.CHAIN'
2244 include 'COMMON.DERIV'
2245 include 'COMMON.INTERACT'
2246 include 'COMMON.CONTACTS'
2247 include 'COMMON.TORSION'
2248 include 'COMMON.VECTORS'
2249 include 'COMMON.FFIELD'
2250 double precision auxvec(2),auxmat(2,2)
2252 C Compute the virtual-bond-torsional-angle dependent quantities needed
2253 C to calculate the el-loc multibody terms of various order.
2255 c write(iout,*) 'nphi=',nphi,nres
2257 do i=ivec_start+2,ivec_end+2
2262 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2263 iti = itortyp(itype(i-2))
2267 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2268 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2269 iti1 = itortyp(itype(i-1))
2274 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2275 & +bnew1(2,1,iti)*dsin(theta(i-1))
2276 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2277 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2278 & +bnew1(2,1,iti)*dcos(theta(i-1))
2279 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2280 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2281 c &*(cos(theta(i)/2.0)
2282 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2283 & +bnew2(2,1,iti)*dsin(theta(i-1))
2284 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2285 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2286 c &*(cos(theta(i)/2.0)
2287 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2288 & +bnew2(2,1,iti)*dcos(theta(i-1))
2289 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2290 c if (ggb1(1,i).eq.0.0d0) then
2291 c write(iout,*) 'i=',i,ggb1(1,i),
2292 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2293 c &bnew1(2,1,iti)*cos(theta(i)),
2294 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2296 b1(2,i-2)=bnew1(1,2,iti)
2298 b2(2,i-2)=bnew2(1,2,iti)
2302 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2303 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2304 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2305 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2306 b1tilde(1,i-2)=b1(1,i-2)
2307 b1tilde(2,i-2)=-b1(2,i-2)
2308 b2tilde(1,i-2)=b2(1,i-2)
2309 b2tilde(2,i-2)=-b2(2,i-2)
2310 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2311 c write(iout,*) 'b1=',b1(1,i-2)
2312 c write (iout,*) 'theta=', theta(i-1)
2315 do i=ivec_start+2,ivec_end+2
2320 if (i .lt. nres+1) then
2357 if (i .gt. 3 .and. i .lt. nres+1) then
2358 obrot_der(1,i-2)=-sin1
2359 obrot_der(2,i-2)= cos1
2360 Ugder(1,1,i-2)= sin1
2361 Ugder(1,2,i-2)=-cos1
2362 Ugder(2,1,i-2)=-cos1
2363 Ugder(2,2,i-2)=-sin1
2366 obrot2_der(1,i-2)=-dwasin2
2367 obrot2_der(2,i-2)= dwacos2
2368 Ug2der(1,1,i-2)= dwasin2
2369 Ug2der(1,2,i-2)=-dwacos2
2370 Ug2der(2,1,i-2)=-dwacos2
2371 Ug2der(2,2,i-2)=-dwasin2
2373 obrot_der(1,i-2)=0.0d0
2374 obrot_der(2,i-2)=0.0d0
2375 Ugder(1,1,i-2)=0.0d0
2376 Ugder(1,2,i-2)=0.0d0
2377 Ugder(2,1,i-2)=0.0d0
2378 Ugder(2,2,i-2)=0.0d0
2379 obrot2_der(1,i-2)=0.0d0
2380 obrot2_der(2,i-2)=0.0d0
2381 Ug2der(1,1,i-2)=0.0d0
2382 Ug2der(1,2,i-2)=0.0d0
2383 Ug2der(2,1,i-2)=0.0d0
2384 Ug2der(2,2,i-2)=0.0d0
2386 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2388 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2389 iti = itortyp(itype(i-2))
2393 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2394 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2395 iti1 = itortyp(itype(i-1))
2400 cd write (iout,*) '*******i',i,' iti1',iti
2401 cd write (iout,*) 'b1',b1(:,iti)
2402 cd write (iout,*) 'b2',b2(:,iti)
2403 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2404 c if (i .gt. iatel_s+2) then
2405 if (i .gt. nnt+2) then
2406 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2408 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2409 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2411 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2412 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2414 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2415 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2416 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2417 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2418 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2429 DtUg2(l,k,i-2)=0.0d0
2433 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2434 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2436 muder(k,i-2)=Ub2der(k,i-2)
2438 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2439 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2440 if (itype(i-1).le.ntyp) then
2441 iti1 = itortyp(itype(i-1))
2449 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2451 c write (iout,*) 'mu ',mu(:,i-2),i-2
2452 cd write (iout,*) 'mu1',mu1(:,i-2)
2453 cd write (iout,*) 'mu2',mu2(:,i-2)
2454 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2456 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2457 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2458 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2459 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2460 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2461 C Vectors and matrices dependent on a single virtual-bond dihedral.
2462 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2463 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2464 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2465 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2466 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2467 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2468 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2469 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2470 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2473 C Matrices dependent on two consecutive virtual-bond dihedrals.
2474 C The order of matrices is from left to right.
2475 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2477 c do i=max0(ivec_start,2),ivec_end
2479 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2480 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2481 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2482 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2483 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2484 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2485 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2486 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2489 #if defined(MPI) && defined(PARMAT)
2491 c if (fg_rank.eq.0) then
2492 write (iout,*) "Arrays UG and UGDER before GATHER"
2494 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2495 & ((ug(l,k,i),l=1,2),k=1,2),
2496 & ((ugder(l,k,i),l=1,2),k=1,2)
2498 write (iout,*) "Arrays UG2 and UG2DER"
2500 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2501 & ((ug2(l,k,i),l=1,2),k=1,2),
2502 & ((ug2der(l,k,i),l=1,2),k=1,2)
2504 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2506 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2507 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2508 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2510 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2512 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2513 & costab(i),sintab(i),costab2(i),sintab2(i)
2515 write (iout,*) "Array MUDER"
2517 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2521 if (nfgtasks.gt.1) then
2523 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2524 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2525 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2527 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2528 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2530 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2531 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2533 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2534 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2536 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2537 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2539 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2540 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2542 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2543 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2545 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2546 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2547 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2548 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2549 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2550 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2551 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2552 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2553 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2554 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2555 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2556 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2557 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2559 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2560 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2562 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2563 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2565 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2566 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2568 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2569 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2571 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2572 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2574 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2575 & ivec_count(fg_rank1),
2576 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2578 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2579 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2581 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2582 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2584 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2585 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2587 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2588 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2590 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2591 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2593 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2594 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2596 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2597 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2599 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2600 & ivec_count(fg_rank1),
2601 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2603 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2604 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2606 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2607 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2609 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2610 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2612 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2613 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2615 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2616 & ivec_count(fg_rank1),
2617 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2619 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2620 & ivec_count(fg_rank1),
2621 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2623 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2624 & ivec_count(fg_rank1),
2625 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2626 & MPI_MAT2,FG_COMM1,IERR)
2627 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2628 & ivec_count(fg_rank1),
2629 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2630 & MPI_MAT2,FG_COMM1,IERR)
2633 c Passes matrix info through the ring
2636 if (irecv.lt.0) irecv=nfgtasks1-1
2639 if (inext.ge.nfgtasks1) inext=0
2641 c write (iout,*) "isend",isend," irecv",irecv
2643 lensend=lentyp(isend)
2644 lenrecv=lentyp(irecv)
2645 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2646 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2647 c & MPI_ROTAT1(lensend),inext,2200+isend,
2648 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2649 c & iprev,2200+irecv,FG_COMM,status,IERR)
2650 c write (iout,*) "Gather ROTAT1"
2652 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2653 c & MPI_ROTAT2(lensend),inext,3300+isend,
2654 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2655 c & iprev,3300+irecv,FG_COMM,status,IERR)
2656 c write (iout,*) "Gather ROTAT2"
2658 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2659 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2660 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2661 & iprev,4400+irecv,FG_COMM,status,IERR)
2662 c write (iout,*) "Gather ROTAT_OLD"
2664 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2665 & MPI_PRECOMP11(lensend),inext,5500+isend,
2666 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2667 & iprev,5500+irecv,FG_COMM,status,IERR)
2668 c write (iout,*) "Gather PRECOMP11"
2670 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2671 & MPI_PRECOMP12(lensend),inext,6600+isend,
2672 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2673 & iprev,6600+irecv,FG_COMM,status,IERR)
2674 c write (iout,*) "Gather PRECOMP12"
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2678 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2679 & MPI_ROTAT2(lensend),inext,7700+isend,
2680 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2681 & iprev,7700+irecv,FG_COMM,status,IERR)
2682 c write (iout,*) "Gather PRECOMP21"
2684 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2685 & MPI_PRECOMP22(lensend),inext,8800+isend,
2686 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2687 & iprev,8800+irecv,FG_COMM,status,IERR)
2688 c write (iout,*) "Gather PRECOMP22"
2690 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2691 & MPI_PRECOMP23(lensend),inext,9900+isend,
2692 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2693 & MPI_PRECOMP23(lenrecv),
2694 & iprev,9900+irecv,FG_COMM,status,IERR)
2695 c write (iout,*) "Gather PRECOMP23"
2700 if (irecv.lt.0) irecv=nfgtasks1-1
2703 time_gather=time_gather+MPI_Wtime()-time00
2706 c if (fg_rank.eq.0) then
2707 write (iout,*) "Arrays UG and UGDER"
2709 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2710 & ((ug(l,k,i),l=1,2),k=1,2),
2711 & ((ugder(l,k,i),l=1,2),k=1,2)
2713 write (iout,*) "Arrays UG2 and UG2DER"
2715 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2716 & ((ug2(l,k,i),l=1,2),k=1,2),
2717 & ((ug2der(l,k,i),l=1,2),k=1,2)
2719 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2721 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2722 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2723 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2725 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2727 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2728 & costab(i),sintab(i),costab2(i),sintab2(i)
2730 write (iout,*) "Array MUDER"
2732 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2738 cd iti = itortyp(itype(i))
2741 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2742 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2747 C--------------------------------------------------------------------------
2748 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2750 C This subroutine calculates the average interaction energy and its gradient
2751 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2752 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2753 C The potential depends both on the distance of peptide-group centers and on
2754 C the orientation of the CA-CA virtual bonds.
2756 implicit real*8 (a-h,o-z)
2760 include 'DIMENSIONS'
2761 include 'COMMON.CONTROL'
2762 include 'COMMON.SETUP'
2763 include 'COMMON.IOUNITS'
2764 include 'COMMON.GEO'
2765 include 'COMMON.VAR'
2766 include 'COMMON.LOCAL'
2767 include 'COMMON.CHAIN'
2768 include 'COMMON.DERIV'
2769 include 'COMMON.INTERACT'
2770 include 'COMMON.CONTACTS'
2771 include 'COMMON.TORSION'
2772 include 'COMMON.VECTORS'
2773 include 'COMMON.FFIELD'
2774 include 'COMMON.TIME1'
2775 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2776 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2777 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2778 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2779 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2780 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2782 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2784 double precision scal_el /1.0d0/
2786 double precision scal_el /0.5d0/
2789 C 13-go grudnia roku pamietnego...
2790 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2791 & 0.0d0,1.0d0,0.0d0,
2792 & 0.0d0,0.0d0,1.0d0/
2793 cd write(iout,*) 'In EELEC'
2795 cd write(iout,*) 'Type',i
2796 cd write(iout,*) 'B1',B1(:,i)
2797 cd write(iout,*) 'B2',B2(:,i)
2798 cd write(iout,*) 'CC',CC(:,:,i)
2799 cd write(iout,*) 'DD',DD(:,:,i)
2800 cd write(iout,*) 'EE',EE(:,:,i)
2802 cd call check_vecgrad
2804 if (icheckgrad.eq.1) then
2806 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2808 dc_norm(k,i)=dc(k,i)*fac
2810 c write (iout,*) 'i',i,' fac',fac
2813 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2814 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2815 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2816 c call vec_and_deriv
2822 time_mat=time_mat+MPI_Wtime()-time01
2826 cd write (iout,*) 'i=',i
2828 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2831 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2832 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2845 cd print '(a)','Enter EELEC'
2846 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2848 gel_loc_loc(i)=0.0d0
2853 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2855 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2857 do i=iturn3_start,iturn3_end
2858 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2859 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2863 dx_normi=dc_norm(1,i)
2864 dy_normi=dc_norm(2,i)
2865 dz_normi=dc_norm(3,i)
2866 xmedi=c(1,i)+0.5d0*dxi
2867 ymedi=c(2,i)+0.5d0*dyi
2868 zmedi=c(3,i)+0.5d0*dzi
2871 c call eelecij(i,i+2,ees,evdw1,eel_loc)
2872 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2873 num_cont_hb(i)=num_conti
2875 do i=iturn4_start,iturn4_end
2876 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2877 & .or. itype(i+3).eq.ntyp1
2878 & .or. itype(i+4).eq.ntyp1) cycle
2882 dx_normi=dc_norm(1,i)
2883 dy_normi=dc_norm(2,i)
2884 dz_normi=dc_norm(3,i)
2885 xmedi=c(1,i)+0.5d0*dxi
2886 ymedi=c(2,i)+0.5d0*dyi
2887 zmedi=c(3,i)+0.5d0*dzi
2888 num_conti=num_cont_hb(i)
2890 c call eelecij(i,i+3,ees,evdw1,eel_loc)
2891 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2892 & call eturn4(i,eello_turn4)
2893 num_cont_hb(i)=num_conti
2896 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2898 c do i=iatel_s,iatel_e
2900 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2904 dx_normi=dc_norm(1,i)
2905 dy_normi=dc_norm(2,i)
2906 dz_normi=dc_norm(3,i)
2907 xmedi=c(1,i)+0.5d0*dxi
2908 ymedi=c(2,i)+0.5d0*dyi
2909 zmedi=c(3,i)+0.5d0*dzi
2910 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2911 num_conti=num_cont_hb(i)
2912 c do j=ielstart(i),ielend(i)
2914 c write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
2915 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2916 call eelecij(i,j,ees,evdw1,eel_loc)
2918 num_cont_hb(i)=num_conti
2920 c write (iout,*) "Number of loop steps in EELEC:",ind
2922 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2923 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2925 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2926 ccc eel_loc=eel_loc+eello_turn3
2927 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2930 C-------------------------------------------------------------------------------
2931 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2932 implicit real*8 (a-h,o-z)
2933 include 'DIMENSIONS'
2937 include 'COMMON.CONTROL'
2938 include 'COMMON.IOUNITS'
2939 include 'COMMON.GEO'
2940 include 'COMMON.VAR'
2941 include 'COMMON.LOCAL'
2942 include 'COMMON.CHAIN'
2943 include 'COMMON.DERIV'
2944 include 'COMMON.INTERACT'
2945 include 'COMMON.CONTACTS'
2946 include 'COMMON.TORSION'
2947 include 'COMMON.VECTORS'
2948 include 'COMMON.FFIELD'
2949 include 'COMMON.TIME1'
2950 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2951 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2952 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2953 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2954 & gmuij2(4),gmuji2(4)
2955 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2956 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2958 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2960 double precision scal_el /1.0d0/
2962 double precision scal_el /0.5d0/
2965 C 13-go grudnia roku pamietnego...
2966 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2967 & 0.0d0,1.0d0,0.0d0,
2968 & 0.0d0,0.0d0,1.0d0/
2969 c time00=MPI_Wtime()
2970 cd write (iout,*) "eelecij",i,j
2974 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2975 aaa=app(iteli,itelj)
2976 bbb=bpp(iteli,itelj)
2977 ael6i=ael6(iteli,itelj)
2978 ael3i=ael3(iteli,itelj)
2982 dx_normj=dc_norm(1,j)
2983 dy_normj=dc_norm(2,j)
2984 dz_normj=dc_norm(3,j)
2985 xj=c(1,j)+0.5D0*dxj-xmedi
2986 yj=c(2,j)+0.5D0*dyj-ymedi
2987 zj=c(3,j)+0.5D0*dzj-zmedi
2988 rij=xj*xj+yj*yj+zj*zj
2994 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2995 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2996 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2997 fac=cosa-3.0D0*cosb*cosg
2999 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3000 if (j.eq.i+2) ev1=scal_el*ev1
3005 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3008 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3009 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3012 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3013 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3014 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3015 cd & xmedi,ymedi,zmedi,xj,yj,zj
3017 if (energy_dec) then
3018 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3020 &,iteli,itelj,aaa,evdw1
3021 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3025 C Calculate contributions to the Cartesian gradient.
3028 facvdw=-6*rrmij*(ev1+evdwij)
3029 facel=-3*rrmij*(el1+eesij)
3035 * Radial derivatives. First process both termini of the fragment (i,j)
3041 c ghalf=0.5D0*ggg(k)
3042 c gelc(k,i)=gelc(k,i)+ghalf
3043 c gelc(k,j)=gelc(k,j)+ghalf
3045 c 9/28/08 AL Gradient compotents will be summed only at the end
3047 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3048 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3051 * Loop over residues i+1 thru j-1.
3055 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3062 c ghalf=0.5D0*ggg(k)
3063 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3064 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3066 c 9/28/08 AL Gradient compotents will be summed only at the end
3068 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3069 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3072 * Loop over residues i+1 thru j-1.
3076 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3083 fac=-3*rrmij*(facvdw+facvdw+facel)
3088 * Radial derivatives. First process both termini of the fragment (i,j)
3094 c ghalf=0.5D0*ggg(k)
3095 c gelc(k,i)=gelc(k,i)+ghalf
3096 c gelc(k,j)=gelc(k,j)+ghalf
3098 c 9/28/08 AL Gradient compotents will be summed only at the end
3100 gelc_long(k,j)=gelc(k,j)+ggg(k)
3101 gelc_long(k,i)=gelc(k,i)-ggg(k)
3104 * Loop over residues i+1 thru j-1.
3108 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3111 c 9/28/08 AL Gradient compotents will be summed only at the end
3116 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3117 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3123 ecosa=2.0D0*fac3*fac1+fac4
3126 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3127 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3129 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3130 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3132 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3133 cd & (dcosg(k),k=1,3)
3135 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3138 c ghalf=0.5D0*ggg(k)
3139 c gelc(k,i)=gelc(k,i)+ghalf
3140 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3141 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3142 c gelc(k,j)=gelc(k,j)+ghalf
3143 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3144 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3148 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3153 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3154 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3156 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3157 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3158 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3159 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3161 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3162 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3163 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3165 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3166 C energy of a peptide unit is assumed in the form of a second-order
3167 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3168 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3169 C are computed for EVERY pair of non-contiguous peptide groups.
3172 if (j.lt.nres-1) then
3184 muij(kkk)=mu(k,i)*mu(l,j)
3185 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3187 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3188 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3189 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3190 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3191 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3192 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3196 cd write (iout,*) 'EELEC: i',i,' j',j
3197 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3198 cd write(iout,*) 'muij',muij
3199 ury=scalar(uy(1,i),erij)
3200 urz=scalar(uz(1,i),erij)
3201 vry=scalar(uy(1,j),erij)
3202 vrz=scalar(uz(1,j),erij)
3203 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3204 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3205 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3206 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3207 fac=dsqrt(-ael6i)*r3ij
3212 cd write (iout,'(4i5,4f10.5)')
3213 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3214 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3215 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3216 cd & uy(:,j),uz(:,j)
3217 cd write (iout,'(4f10.5)')
3218 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3219 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3220 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3221 cd write (iout,'(9f10.5/)')
3222 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3223 C Derivatives of the elements of A in virtual-bond vectors
3224 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3226 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3227 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3228 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3229 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3230 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3231 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3232 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3233 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3234 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3235 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3236 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3237 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3239 C Compute radial contributions to the gradient
3257 C Add the contributions coming from er
3260 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3261 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3262 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3263 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3266 C Derivatives in DC(i)
3267 cgrad ghalf1=0.5d0*agg(k,1)
3268 cgrad ghalf2=0.5d0*agg(k,2)
3269 cgrad ghalf3=0.5d0*agg(k,3)
3270 cgrad ghalf4=0.5d0*agg(k,4)
3271 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3272 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3273 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3274 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3275 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3276 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3277 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3278 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3279 C Derivatives in DC(i+1)
3280 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3281 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3282 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3283 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3284 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3285 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3286 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3287 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3288 C Derivatives in DC(j)
3289 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3290 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3291 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3292 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3293 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3294 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3295 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3296 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3297 C Derivatives in DC(j+1) or DC(nres-1)
3298 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3299 & -3.0d0*vryg(k,3)*ury)
3300 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3301 & -3.0d0*vrzg(k,3)*ury)
3302 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3303 & -3.0d0*vryg(k,3)*urz)
3304 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3305 & -3.0d0*vrzg(k,3)*urz)
3306 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3308 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3321 aggi(k,l)=-aggi(k,l)
3322 aggi1(k,l)=-aggi1(k,l)
3323 aggj(k,l)=-aggj(k,l)
3324 aggj1(k,l)=-aggj1(k,l)
3327 if (j.lt.nres-1) then
3333 aggi(k,l)=-aggi(k,l)
3334 aggi1(k,l)=-aggi1(k,l)
3335 aggj(k,l)=-aggj(k,l)
3336 aggj1(k,l)=-aggj1(k,l)
3347 aggi(k,l)=-aggi(k,l)
3348 aggi1(k,l)=-aggi1(k,l)
3349 aggj(k,l)=-aggj(k,l)
3350 aggj1(k,l)=-aggj1(k,l)
3355 IF (wel_loc.gt.0.0d0) THEN
3356 C Contribution to the local-electrostatic energy coming from the i-j pair
3357 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3359 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3360 C Calculate patrial derivative for theta angle
3362 geel_loc_ij=a22*gmuij1(1)
3366 c write(iout,*) "derivative over thatai"
3367 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3369 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3370 & geel_loc_ij*wel_loc
3371 c write(iout,*) "derivative over thatai-1"
3372 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3379 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3380 & geel_loc_ij*wel_loc
3381 c Derivative over j residue
3382 geel_loc_ji=a22*gmuji1(1)
3386 c write(iout,*) "derivative over thataj"
3387 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3390 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3391 & geel_loc_ji*wel_loc
3397 c write(iout,*) "derivative over thataj-1"
3398 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3400 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3401 & geel_loc_ji*wel_loc
3403 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3405 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3406 & 'eelloc',i,j,eel_loc_ij
3407 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3409 eel_loc=eel_loc+eel_loc_ij
3410 C Partial derivatives in virtual-bond dihedral angles gamma
3412 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3413 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3414 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3415 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3416 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3417 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3418 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3420 ggg(l)=agg(l,1)*muij(1)+
3421 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3422 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3423 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3424 cgrad ghalf=0.5d0*ggg(l)
3425 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3426 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3430 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3433 C Remaining derivatives of eello
3435 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3436 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3437 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3438 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3439 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3440 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3441 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3442 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3445 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3446 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3447 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3448 & .and. num_conti.le.maxconts) then
3449 c write (iout,*) i,j," entered corr"
3451 C Calculate the contact function. The ith column of the array JCONT will
3452 C contain the numbers of atoms that make contacts with the atom I (of numbers
3453 C greater than I). The arrays FACONT and GACONT will contain the values of
3454 C the contact function and its derivative.
3455 c r0ij=1.02D0*rpp(iteli,itelj)
3456 c r0ij=1.11D0*rpp(iteli,itelj)
3457 r0ij=2.20D0*rpp(iteli,itelj)
3458 c r0ij=1.55D0*rpp(iteli,itelj)
3459 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3460 if (fcont.gt.0.0D0) then
3461 num_conti=num_conti+1
3462 if (num_conti.gt.maxconts) then
3463 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3464 & ' will skip next contacts for this conf.'
3466 jcont_hb(num_conti,i)=j
3467 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3468 cd & " jcont_hb",jcont_hb(num_conti,i)
3469 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3470 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3471 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3473 d_cont(num_conti,i)=rij
3474 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3475 C --- Electrostatic-interaction matrix ---
3476 a_chuj(1,1,num_conti,i)=a22
3477 a_chuj(1,2,num_conti,i)=a23
3478 a_chuj(2,1,num_conti,i)=a32
3479 a_chuj(2,2,num_conti,i)=a33
3480 C --- Gradient of rij
3482 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3489 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3490 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3491 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3492 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3493 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3498 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3499 C Calculate contact energies
3501 wij=cosa-3.0D0*cosb*cosg
3504 c fac3=dsqrt(-ael6i)/r0ij**3
3505 fac3=dsqrt(-ael6i)*r3ij
3506 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3507 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3508 if (ees0tmp.gt.0) then
3509 ees0pij=dsqrt(ees0tmp)
3513 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3514 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3515 if (ees0tmp.gt.0) then
3516 ees0mij=dsqrt(ees0tmp)
3521 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3522 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3523 C Diagnostics. Comment out or remove after debugging!
3524 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3525 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3526 c ees0m(num_conti,i)=0.0D0
3528 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3529 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3530 C Angular derivatives of the contact function
3531 ees0pij1=fac3/ees0pij
3532 ees0mij1=fac3/ees0mij
3533 fac3p=-3.0D0*fac3*rrmij
3534 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3535 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3537 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3538 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3539 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3540 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3541 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3542 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3543 ecosap=ecosa1+ecosa2
3544 ecosbp=ecosb1+ecosb2
3545 ecosgp=ecosg1+ecosg2
3546 ecosam=ecosa1-ecosa2
3547 ecosbm=ecosb1-ecosb2
3548 ecosgm=ecosg1-ecosg2
3557 facont_hb(num_conti,i)=fcont
3558 fprimcont=fprimcont/rij
3559 cd facont_hb(num_conti,i)=1.0D0
3560 C Following line is for diagnostics.
3563 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3564 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3567 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3568 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3570 gggp(1)=gggp(1)+ees0pijp*xj
3571 gggp(2)=gggp(2)+ees0pijp*yj
3572 gggp(3)=gggp(3)+ees0pijp*zj
3573 gggm(1)=gggm(1)+ees0mijp*xj
3574 gggm(2)=gggm(2)+ees0mijp*yj
3575 gggm(3)=gggm(3)+ees0mijp*zj
3576 C Derivatives due to the contact function
3577 gacont_hbr(1,num_conti,i)=fprimcont*xj
3578 gacont_hbr(2,num_conti,i)=fprimcont*yj
3579 gacont_hbr(3,num_conti,i)=fprimcont*zj
3582 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3583 c following the change of gradient-summation algorithm.
3585 cgrad ghalfp=0.5D0*gggp(k)
3586 cgrad ghalfm=0.5D0*gggm(k)
3587 gacontp_hb1(k,num_conti,i)=!ghalfp
3588 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3589 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3590 gacontp_hb2(k,num_conti,i)=!ghalfp
3591 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3592 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3593 gacontp_hb3(k,num_conti,i)=gggp(k)
3594 gacontm_hb1(k,num_conti,i)=!ghalfm
3595 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3596 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3597 gacontm_hb2(k,num_conti,i)=!ghalfm
3598 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3599 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3600 gacontm_hb3(k,num_conti,i)=gggm(k)
3602 C Diagnostics. Comment out or remove after debugging!
3604 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3605 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3606 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3607 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3608 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3609 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3612 endif ! num_conti.le.maxconts
3615 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3618 ghalf=0.5d0*agg(l,k)
3619 aggi(l,k)=aggi(l,k)+ghalf
3620 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3621 aggj(l,k)=aggj(l,k)+ghalf
3624 if (j.eq.nres-1 .and. i.lt.j-2) then
3627 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3632 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3635 C-----------------------------------------------------------------------------
3636 subroutine eturn3(i,eello_turn3)
3637 C Third- and fourth-order contributions from turns
3638 implicit real*8 (a-h,o-z)
3639 include 'DIMENSIONS'
3640 include 'COMMON.IOUNITS'
3641 include 'COMMON.GEO'
3642 include 'COMMON.VAR'
3643 include 'COMMON.LOCAL'
3644 include 'COMMON.CHAIN'
3645 include 'COMMON.DERIV'
3646 include 'COMMON.INTERACT'
3647 include 'COMMON.CONTACTS'
3648 include 'COMMON.TORSION'
3649 include 'COMMON.VECTORS'
3650 include 'COMMON.FFIELD'
3651 include 'COMMON.CONTROL'
3653 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3654 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3655 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3656 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3657 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3658 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3659 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3662 c write (iout,*) "eturn3",i,j,j1,j2
3667 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3669 C Third-order contributions
3676 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3677 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3678 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3679 call transpose2(auxmat(1,1),auxmat1(1,1))
3680 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3681 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3682 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3683 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3684 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3685 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3686 cd & ' eello_turn3_num',4*eello_turn3_num
3687 C Derivatives in gamma(i)
3688 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3689 call transpose2(auxmat2(1,1),auxmat3(1,1))
3690 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3691 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3692 C Derivatives in gamma(i+1)
3693 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3694 call transpose2(auxmat2(1,1),auxmat3(1,1))
3695 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3696 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3697 & +0.5d0*(pizda(1,1)+pizda(2,2))
3698 C Cartesian derivatives
3700 c ghalf1=0.5d0*agg(l,1)
3701 c ghalf2=0.5d0*agg(l,2)
3702 c ghalf3=0.5d0*agg(l,3)
3703 c ghalf4=0.5d0*agg(l,4)
3704 a_temp(1,1)=aggi(l,1)!+ghalf1
3705 a_temp(1,2)=aggi(l,2)!+ghalf2
3706 a_temp(2,1)=aggi(l,3)!+ghalf3
3707 a_temp(2,2)=aggi(l,4)!+ghalf4
3708 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3709 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3710 & +0.5d0*(pizda(1,1)+pizda(2,2))
3711 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3712 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3713 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3714 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3715 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3716 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3717 & +0.5d0*(pizda(1,1)+pizda(2,2))
3718 a_temp(1,1)=aggj(l,1)!+ghalf1
3719 a_temp(1,2)=aggj(l,2)!+ghalf2
3720 a_temp(2,1)=aggj(l,3)!+ghalf3
3721 a_temp(2,2)=aggj(l,4)!+ghalf4
3722 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3723 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3724 & +0.5d0*(pizda(1,1)+pizda(2,2))
3725 a_temp(1,1)=aggj1(l,1)
3726 a_temp(1,2)=aggj1(l,2)
3727 a_temp(2,1)=aggj1(l,3)
3728 a_temp(2,2)=aggj1(l,4)
3729 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3730 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3731 & +0.5d0*(pizda(1,1)+pizda(2,2))
3735 C-------------------------------------------------------------------------------
3736 subroutine eturn4(i,eello_turn4)
3737 C Third- and fourth-order contributions from turns
3738 implicit real*8 (a-h,o-z)
3739 include 'DIMENSIONS'
3740 include 'COMMON.IOUNITS'
3741 include 'COMMON.GEO'
3742 include 'COMMON.VAR'
3743 include 'COMMON.LOCAL'
3744 include 'COMMON.CHAIN'
3745 include 'COMMON.DERIV'
3746 include 'COMMON.INTERACT'
3747 include 'COMMON.CONTACTS'
3748 include 'COMMON.TORSION'
3749 include 'COMMON.VECTORS'
3750 include 'COMMON.FFIELD'
3751 include 'COMMON.CONTROL'
3753 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3754 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3755 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2)
3756 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3757 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3758 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3759 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3762 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3764 C Fourth-order contributions
3772 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3773 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3774 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3779 iti1=itortyp(itype(i+1))
3780 iti2=itortyp(itype(i+2))
3781 iti3=itortyp(itype(i+3))
3782 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3783 call transpose2(EUg(1,1,i+1),e1t(1,1))
3784 call transpose2(Eug(1,1,i+2),e2t(1,1))
3785 call transpose2(Eug(1,1,i+3),e3t(1,1))
3786 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3787 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3788 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3791 s1=scalar2(b1(1,i+2),auxvec(1))
3792 c gs1=scalar2(gtb1(1,i+2),auxgvec(1))
3793 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3794 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3795 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3798 s2=scalar2(b1(1,i+1),auxvec(1))
3799 c gs2=scalar2(gtb1(1,i+1),auxgvec(1))
3800 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),ggb1(1,i+2),
3802 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3803 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3804 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3805 eello_turn4=eello_turn4-(s1+s2+s3)
3807 c geel_loc_ij=-(gs1+gs2)
3808 c gloc(nphi+i,icg)=gloc(nphi+i,icg)-
3810 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3813 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3814 & 'eturn4',i,j,-(s1+s2+s3)
3815 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3816 cd & ' eello_turn4_num',8*eello_turn4_num
3817 C Derivatives in gamma(i)
3818 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3819 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3820 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3821 s1=scalar2(b1(1,i+2),auxvec(1))
3822 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3823 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3824 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3825 C Derivatives in gamma(i+1)
3826 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3827 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3828 s2=scalar2(b1(1,i+1),auxvec(1))
3829 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3830 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3831 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3832 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3833 C Derivatives in gamma(i+2)
3834 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3835 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3836 s1=scalar2(b1(1,i+2),auxvec(1))
3837 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3838 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3839 s2=scalar2(b1(1,i+1),auxvec(1))
3840 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3841 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3842 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3843 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3844 C Cartesian derivatives
3845 C Derivatives of this turn contributions in DC(i+2)
3846 if (j.lt.nres-1) then
3848 a_temp(1,1)=agg(l,1)
3849 a_temp(1,2)=agg(l,2)
3850 a_temp(2,1)=agg(l,3)
3851 a_temp(2,2)=agg(l,4)
3852 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3853 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3854 s1=scalar2(b1(1,i+2),auxvec(1))
3855 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3856 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3857 s2=scalar2(b1(1,i+1),auxvec(1))
3858 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3859 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3860 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3862 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3865 C Remaining derivatives of this turn contribution
3867 a_temp(1,1)=aggi(l,1)
3868 a_temp(1,2)=aggi(l,2)
3869 a_temp(2,1)=aggi(l,3)
3870 a_temp(2,2)=aggi(l,4)
3871 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3872 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3873 s1=scalar2(b1(1,i+2),auxvec(1))
3874 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3875 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3876 s2=scalar2(b1(1,i+1),auxvec(1))
3877 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3878 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3879 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3880 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3881 a_temp(1,1)=aggi1(l,1)
3882 a_temp(1,2)=aggi1(l,2)
3883 a_temp(2,1)=aggi1(l,3)
3884 a_temp(2,2)=aggi1(l,4)
3885 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3886 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3887 s1=scalar2(b1(1,i+2),auxvec(1))
3888 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3889 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3890 s2=scalar2(b1(1,i+1),auxvec(1))
3891 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3892 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3893 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3894 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3895 a_temp(1,1)=aggj(l,1)
3896 a_temp(1,2)=aggj(l,2)
3897 a_temp(2,1)=aggj(l,3)
3898 a_temp(2,2)=aggj(l,4)
3899 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3900 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3901 s1=scalar2(b1(1,i+2),auxvec(1))
3902 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3903 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3904 s2=scalar2(b1(1,i+1),auxvec(1))
3905 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3906 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3907 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3908 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3909 a_temp(1,1)=aggj1(l,1)
3910 a_temp(1,2)=aggj1(l,2)
3911 a_temp(2,1)=aggj1(l,3)
3912 a_temp(2,2)=aggj1(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,i+2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,i+1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3923 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3927 C-----------------------------------------------------------------------------
3928 subroutine vecpr(u,v,w)
3929 implicit real*8(a-h,o-z)
3930 dimension u(3),v(3),w(3)
3931 w(1)=u(2)*v(3)-u(3)*v(2)
3932 w(2)=-u(1)*v(3)+u(3)*v(1)
3933 w(3)=u(1)*v(2)-u(2)*v(1)
3936 C-----------------------------------------------------------------------------
3937 subroutine unormderiv(u,ugrad,unorm,ungrad)
3938 C This subroutine computes the derivatives of a normalized vector u, given
3939 C the derivatives computed without normalization conditions, ugrad. Returns
3942 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3943 double precision vec(3)
3944 double precision scalar
3946 c write (2,*) 'ugrad',ugrad
3949 vec(i)=scalar(ugrad(1,i),u(1))
3951 c write (2,*) 'vec',vec
3954 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3957 c write (2,*) 'ungrad',ungrad
3960 C-----------------------------------------------------------------------------
3961 subroutine escp_soft_sphere(evdw2,evdw2_14)
3963 C This subroutine calculates the excluded-volume interaction energy between
3964 C peptide-group centers and side chains and its gradient in virtual-bond and
3965 C side-chain vectors.
3967 implicit real*8 (a-h,o-z)
3968 include 'DIMENSIONS'
3969 include 'COMMON.GEO'
3970 include 'COMMON.VAR'
3971 include 'COMMON.LOCAL'
3972 include 'COMMON.CHAIN'
3973 include 'COMMON.DERIV'
3974 include 'COMMON.INTERACT'
3975 include 'COMMON.FFIELD'
3976 include 'COMMON.IOUNITS'
3977 include 'COMMON.CONTROL'
3982 cd print '(a)','Enter ESCP'
3983 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3984 do i=iatscp_s,iatscp_e
3985 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3987 xi=0.5D0*(c(1,i)+c(1,i+1))
3988 yi=0.5D0*(c(2,i)+c(2,i+1))
3989 zi=0.5D0*(c(3,i)+c(3,i+1))
3991 do iint=1,nscp_gr(i)
3993 do j=iscpstart(i,iint),iscpend(i,iint)
3994 if (itype(j).eq.ntyp1) cycle
3995 itypj=iabs(itype(j))
3996 C Uncomment following three lines for SC-p interactions
4000 C Uncomment following three lines for Ca-p interactions
4004 rij=xj*xj+yj*yj+zj*zj
4007 if (rij.lt.r0ijsq) then
4008 evdwij=0.25d0*(rij-r0ijsq)**2
4016 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4021 cgrad if (j.lt.i) then
4022 cd write (iout,*) 'j<i'
4023 C Uncomment following three lines for SC-p interactions
4025 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4028 cd write (iout,*) 'j>i'
4030 cgrad ggg(k)=-ggg(k)
4031 C Uncomment following line for SC-p interactions
4032 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4036 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4038 cgrad kstart=min0(i+1,j)
4039 cgrad kend=max0(i-1,j-1)
4040 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4041 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4042 cgrad do k=kstart,kend
4044 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4048 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4049 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4057 C-----------------------------------------------------------------------------
4058 subroutine escp(evdw2,evdw2_14)
4060 C This subroutine calculates the excluded-volume interaction energy between
4061 C peptide-group centers and side chains and its gradient in virtual-bond and
4062 C side-chain vectors.
4064 implicit real*8 (a-h,o-z)
4065 include 'DIMENSIONS'
4066 include 'COMMON.GEO'
4067 include 'COMMON.VAR'
4068 include 'COMMON.LOCAL'
4069 include 'COMMON.CHAIN'
4070 include 'COMMON.DERIV'
4071 include 'COMMON.INTERACT'
4072 include 'COMMON.FFIELD'
4073 include 'COMMON.IOUNITS'
4074 include 'COMMON.CONTROL'
4078 cd print '(a)','Enter ESCP'
4079 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4080 do i=iatscp_s,iatscp_e
4081 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4083 xi=0.5D0*(c(1,i)+c(1,i+1))
4084 yi=0.5D0*(c(2,i)+c(2,i+1))
4085 zi=0.5D0*(c(3,i)+c(3,i+1))
4087 do iint=1,nscp_gr(i)
4089 do j=iscpstart(i,iint),iscpend(i,iint)
4090 itypj=iabs(itype(j))
4091 if (itypj.eq.ntyp1) cycle
4092 C Uncomment following three lines for SC-p interactions
4096 C Uncomment following three lines for Ca-p interactions
4100 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4102 e1=fac*fac*aad(itypj,iteli)
4103 e2=fac*bad(itypj,iteli)
4104 if (iabs(j-i) .le. 2) then
4107 evdw2_14=evdw2_14+e1+e2
4111 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4112 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4115 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4117 fac=-(evdwij+e1)*rrij
4121 cgrad if (j.lt.i) then
4122 cd write (iout,*) 'j<i'
4123 C Uncomment following three lines for SC-p interactions
4125 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4128 cd write (iout,*) 'j>i'
4130 cgrad ggg(k)=-ggg(k)
4131 C Uncomment following line for SC-p interactions
4132 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4133 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4137 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4139 cgrad kstart=min0(i+1,j)
4140 cgrad kend=max0(i-1,j-1)
4141 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4142 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4143 cgrad do k=kstart,kend
4145 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4149 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4150 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4158 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4159 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4160 gradx_scp(j,i)=expon*gradx_scp(j,i)
4163 C******************************************************************************
4167 C To save time the factor EXPON has been extracted from ALL components
4168 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4171 C******************************************************************************
4174 C--------------------------------------------------------------------------
4175 subroutine edis(ehpb)
4177 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4179 implicit real*8 (a-h,o-z)
4180 include 'DIMENSIONS'
4181 include 'COMMON.SBRIDGE'
4182 include 'COMMON.CHAIN'
4183 include 'COMMON.DERIV'
4184 include 'COMMON.VAR'
4185 include 'COMMON.INTERACT'
4186 include 'COMMON.IOUNITS'
4189 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4190 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4191 if (link_end.eq.0) return
4192 do i=link_start,link_end
4193 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4194 C CA-CA distance used in regularization of structure.
4197 C iii and jjj point to the residues for which the distance is assigned.
4198 if (ii.gt.nres) then
4205 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4206 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4207 C distance and angle dependent SS bond potential.
4208 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4209 & iabs(itype(jjj)).eq.1) then
4210 call ssbond_ene(iii,jjj,eij)
4212 cd write (iout,*) "eij",eij
4214 C Calculate the distance between the two points and its difference from the
4218 C Get the force constant corresponding to this distance.
4220 C Calculate the contribution to energy.
4221 ehpb=ehpb+waga*rdis*rdis
4223 C Evaluate gradient.
4226 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4227 cd & ' waga=',waga,' fac=',fac
4229 ggg(j)=fac*(c(j,jj)-c(j,ii))
4231 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4232 C If this is a SC-SC distance, we need to calculate the contributions to the
4233 C Cartesian gradient in the SC vectors (ghpbx).
4236 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4237 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4240 cgrad do j=iii,jjj-1
4242 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4246 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4247 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4254 C--------------------------------------------------------------------------
4255 subroutine ssbond_ene(i,j,eij)
4257 C Calculate the distance and angle dependent SS-bond potential energy
4258 C using a free-energy function derived based on RHF/6-31G** ab initio
4259 C calculations of diethyl disulfide.
4261 C A. Liwo and U. Kozlowska, 11/24/03
4263 implicit real*8 (a-h,o-z)
4264 include 'DIMENSIONS'
4265 include 'COMMON.SBRIDGE'
4266 include 'COMMON.CHAIN'
4267 include 'COMMON.DERIV'
4268 include 'COMMON.LOCAL'
4269 include 'COMMON.INTERACT'
4270 include 'COMMON.VAR'
4271 include 'COMMON.IOUNITS'
4272 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4273 itypi=iabs(itype(i))
4277 dxi=dc_norm(1,nres+i)
4278 dyi=dc_norm(2,nres+i)
4279 dzi=dc_norm(3,nres+i)
4280 c dsci_inv=dsc_inv(itypi)
4281 dsci_inv=vbld_inv(nres+i)
4282 itypj=iabs(itype(j))
4283 c dscj_inv=dsc_inv(itypj)
4284 dscj_inv=vbld_inv(nres+j)
4288 dxj=dc_norm(1,nres+j)
4289 dyj=dc_norm(2,nres+j)
4290 dzj=dc_norm(3,nres+j)
4291 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4296 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4297 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4298 om12=dxi*dxj+dyi*dyj+dzi*dzj
4300 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4301 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4307 deltat12=om2-om1+2.0d0
4309 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4310 & +akct*deltad*deltat12
4311 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4312 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4313 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4314 c & " deltat12",deltat12," eij",eij
4315 ed=2*akcm*deltad+akct*deltat12
4317 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4318 eom1=-2*akth*deltat1-pom1-om2*pom2
4319 eom2= 2*akth*deltat2+pom1-om1*pom2
4322 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4323 ghpbx(k,i)=ghpbx(k,i)-ggk
4324 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4325 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4326 ghpbx(k,j)=ghpbx(k,j)+ggk
4327 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4328 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4329 ghpbc(k,i)=ghpbc(k,i)-ggk
4330 ghpbc(k,j)=ghpbc(k,j)+ggk
4333 C Calculate the components of the gradient in DC and X
4337 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4342 C--------------------------------------------------------------------------
4343 subroutine ebond(estr)
4345 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4347 implicit real*8 (a-h,o-z)
4348 include 'DIMENSIONS'
4349 include 'COMMON.LOCAL'
4350 include 'COMMON.GEO'
4351 include 'COMMON.INTERACT'
4352 include 'COMMON.DERIV'
4353 include 'COMMON.VAR'
4354 include 'COMMON.CHAIN'
4355 include 'COMMON.IOUNITS'
4356 include 'COMMON.NAMES'
4357 include 'COMMON.FFIELD'
4358 include 'COMMON.CONTROL'
4359 include 'COMMON.SETUP'
4360 double precision u(3),ud(3)
4363 do i=ibondp_start,ibondp_end
4364 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4365 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4367 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4368 & *dc(j,i-1)/vbld(i)
4370 if (energy_dec) write(iout,*)
4371 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4373 diff = vbld(i)-vbldp0
4374 if (energy_dec) write (iout,*)
4375 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4378 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4380 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4383 estr=0.5d0*AKP*estr+estr1
4385 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4387 do i=ibond_start,ibond_end
4389 if (iti.ne.10 .and. iti.ne.ntyp1) then
4392 diff=vbld(i+nres)-vbldsc0(1,iti)
4393 if (energy_dec) write (iout,*)
4394 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4395 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4396 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4398 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4402 diff=vbld(i+nres)-vbldsc0(j,iti)
4403 ud(j)=aksc(j,iti)*diff
4404 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4418 uprod2=uprod2*u(k)*u(k)
4422 usumsqder=usumsqder+ud(j)*uprod2
4424 estr=estr+uprod/usum
4426 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4434 C--------------------------------------------------------------------------
4435 subroutine ebend(etheta)
4437 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4438 C angles gamma and its derivatives in consecutive thetas and gammas.
4440 implicit real*8 (a-h,o-z)
4441 include 'DIMENSIONS'
4442 include 'COMMON.LOCAL'
4443 include 'COMMON.GEO'
4444 include 'COMMON.INTERACT'
4445 include 'COMMON.DERIV'
4446 include 'COMMON.VAR'
4447 include 'COMMON.CHAIN'
4448 include 'COMMON.IOUNITS'
4449 include 'COMMON.NAMES'
4450 include 'COMMON.FFIELD'
4451 include 'COMMON.CONTROL'
4452 common /calcthet/ term1,term2,termm,diffak,ratak,
4453 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4454 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4455 double precision y(2),z(2)
4457 c time11=dexp(-2*time)
4460 c write (*,'(a,i2)') 'EBEND ICG=',icg
4461 do i=ithet_start,ithet_end
4462 if (itype(i-1).eq.ntyp1) cycle
4463 C Zero the energy function and its derivative at 0 or pi.
4464 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4466 ichir1=isign(1,itype(i-2))
4467 ichir2=isign(1,itype(i))
4468 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4469 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4470 if (itype(i-1).eq.10) then
4471 itype1=isign(10,itype(i-2))
4472 ichir11=isign(1,itype(i-2))
4473 ichir12=isign(1,itype(i-2))
4474 itype2=isign(10,itype(i))
4475 ichir21=isign(1,itype(i))
4476 ichir22=isign(1,itype(i))
4479 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4482 if (phii.ne.phii) phii=150.0
4492 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4495 if (phii1.ne.phii1) phii1=150.0
4507 C Calculate the "mean" value of theta from the part of the distribution
4508 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4509 C In following comments this theta will be referred to as t_c.
4510 thet_pred_mean=0.0d0
4512 athetk=athet(k,it,ichir1,ichir2)
4513 bthetk=bthet(k,it,ichir1,ichir2)
4515 athetk=athet(k,itype1,ichir11,ichir12)
4516 bthetk=bthet(k,itype2,ichir21,ichir22)
4518 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4520 dthett=thet_pred_mean*ssd
4521 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4522 C Derivatives of the "mean" values in gamma1 and gamma2.
4523 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4524 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4525 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4526 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4528 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4529 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4530 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4531 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4533 if (theta(i).gt.pi-delta) then
4534 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4536 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4537 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4538 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4540 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4542 else if (theta(i).lt.delta) then
4543 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4544 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4545 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4547 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4548 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4551 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4554 etheta=etheta+ethetai
4555 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4557 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4558 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4559 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4561 C Ufff.... We've done all this!!!
4564 C---------------------------------------------------------------------------
4565 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4567 implicit real*8 (a-h,o-z)
4568 include 'DIMENSIONS'
4569 include 'COMMON.LOCAL'
4570 include 'COMMON.IOUNITS'
4571 common /calcthet/ term1,term2,termm,diffak,ratak,
4572 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4573 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4574 C Calculate the contributions to both Gaussian lobes.
4575 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4576 C The "polynomial part" of the "standard deviation" of this part of
4580 sig=sig*thet_pred_mean+polthet(j,it)
4582 C Derivative of the "interior part" of the "standard deviation of the"
4583 C gamma-dependent Gaussian lobe in t_c.
4584 sigtc=3*polthet(3,it)
4586 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4589 C Set the parameters of both Gaussian lobes of the distribution.
4590 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4591 fac=sig*sig+sigc0(it)
4594 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4595 sigsqtc=-4.0D0*sigcsq*sigtc
4596 c print *,i,sig,sigtc,sigsqtc
4597 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4598 sigtc=-sigtc/(fac*fac)
4599 C Following variable is sigma(t_c)**(-2)
4600 sigcsq=sigcsq*sigcsq
4602 sig0inv=1.0D0/sig0i**2
4603 delthec=thetai-thet_pred_mean
4604 delthe0=thetai-theta0i
4605 term1=-0.5D0*sigcsq*delthec*delthec
4606 term2=-0.5D0*sig0inv*delthe0*delthe0
4607 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4608 C NaNs in taking the logarithm. We extract the largest exponent which is added
4609 C to the energy (this being the log of the distribution) at the end of energy
4610 C term evaluation for this virtual-bond angle.
4611 if (term1.gt.term2) then
4613 term2=dexp(term2-termm)
4617 term1=dexp(term1-termm)
4620 C The ratio between the gamma-independent and gamma-dependent lobes of
4621 C the distribution is a Gaussian function of thet_pred_mean too.
4622 diffak=gthet(2,it)-thet_pred_mean
4623 ratak=diffak/gthet(3,it)**2
4624 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4625 C Let's differentiate it in thet_pred_mean NOW.
4627 C Now put together the distribution terms to make complete distribution.
4628 termexp=term1+ak*term2
4629 termpre=sigc+ak*sig0i
4630 C Contribution of the bending energy from this theta is just the -log of
4631 C the sum of the contributions from the two lobes and the pre-exponential
4632 C factor. Simple enough, isn't it?
4633 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4634 C NOW the derivatives!!!
4635 C 6/6/97 Take into account the deformation.
4636 E_theta=(delthec*sigcsq*term1
4637 & +ak*delthe0*sig0inv*term2)/termexp
4638 E_tc=((sigtc+aktc*sig0i)/termpre
4639 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4640 & aktc*term2)/termexp)
4643 c-----------------------------------------------------------------------------
4644 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4645 implicit real*8 (a-h,o-z)
4646 include 'DIMENSIONS'
4647 include 'COMMON.LOCAL'
4648 include 'COMMON.IOUNITS'
4649 common /calcthet/ term1,term2,termm,diffak,ratak,
4650 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4651 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4652 delthec=thetai-thet_pred_mean
4653 delthe0=thetai-theta0i
4654 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4655 t3 = thetai-thet_pred_mean
4659 t14 = t12+t6*sigsqtc
4661 t21 = thetai-theta0i
4667 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4668 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4669 & *(-t12*t9-ak*sig0inv*t27)
4673 C--------------------------------------------------------------------------
4674 subroutine ebend(etheta)
4676 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4677 C angles gamma and its derivatives in consecutive thetas and gammas.
4678 C ab initio-derived potentials from
4679 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4681 implicit real*8 (a-h,o-z)
4682 include 'DIMENSIONS'
4683 include 'COMMON.LOCAL'
4684 include 'COMMON.GEO'
4685 include 'COMMON.INTERACT'
4686 include 'COMMON.DERIV'
4687 include 'COMMON.VAR'
4688 include 'COMMON.CHAIN'
4689 include 'COMMON.IOUNITS'
4690 include 'COMMON.NAMES'
4691 include 'COMMON.FFIELD'
4692 include 'COMMON.CONTROL'
4693 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4694 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4695 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4696 & sinph1ph2(maxdouble,maxdouble)
4697 logical lprn /.false./, lprn1 /.false./
4699 do i=ithet_start,ithet_end
4700 if (itype(i-1).eq.ntyp1) cycle
4701 if (iabs(itype(i+1)).eq.20) iblock=2
4702 if (iabs(itype(i+1)).ne.20) iblock=1
4706 theti2=0.5d0*theta(i)
4707 ityp2=ithetyp((itype(i-1)))
4709 coskt(k)=dcos(k*theti2)
4710 sinkt(k)=dsin(k*theti2)
4712 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4715 if (phii.ne.phii) phii=150.0
4719 ityp1=ithetyp((itype(i-2)))
4720 C propagation of chirality for glycine type
4722 cosph1(k)=dcos(k*phii)
4723 sinph1(k)=dsin(k*phii)
4733 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4736 if (phii1.ne.phii1) phii1=150.0
4741 ityp3=ithetyp((itype(i)))
4743 cosph2(k)=dcos(k*phii1)
4744 sinph2(k)=dsin(k*phii1)
4754 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4757 ccl=cosph1(l)*cosph2(k-l)
4758 ssl=sinph1(l)*sinph2(k-l)
4759 scl=sinph1(l)*cosph2(k-l)
4760 csl=cosph1(l)*sinph2(k-l)
4761 cosph1ph2(l,k)=ccl-ssl
4762 cosph1ph2(k,l)=ccl+ssl
4763 sinph1ph2(l,k)=scl+csl
4764 sinph1ph2(k,l)=scl-csl
4768 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4769 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4770 write (iout,*) "coskt and sinkt"
4772 write (iout,*) k,coskt(k),sinkt(k)
4776 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4777 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4780 & write (iout,*) "k",k,"
4781 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4782 & " ethetai",ethetai
4785 write (iout,*) "cosph and sinph"
4787 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4789 write (iout,*) "cosph1ph2 and sinph2ph2"
4792 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4793 & sinph1ph2(l,k),sinph1ph2(k,l)
4796 write(iout,*) "ethetai",ethetai
4800 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4801 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4802 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4803 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4804 ethetai=ethetai+sinkt(m)*aux
4805 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4806 dephii=dephii+k*sinkt(m)*(
4807 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4808 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4809 dephii1=dephii1+k*sinkt(m)*(
4810 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4811 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4813 & write (iout,*) "m",m," k",k," bbthet",
4814 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4815 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4816 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4817 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4821 & write(iout,*) "ethetai",ethetai
4825 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4826 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4827 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4828 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4829 ethetai=ethetai+sinkt(m)*aux
4830 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4831 dephii=dephii+l*sinkt(m)*(
4832 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4833 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4834 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4835 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4836 dephii1=dephii1+(k-l)*sinkt(m)*(
4837 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4838 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4839 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4840 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4842 write (iout,*) "m",m," k",k," l",l," ffthet",
4843 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4844 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4845 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4846 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4847 & " ethetai",ethetai
4848 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4849 & cosph1ph2(k,l)*sinkt(m),
4850 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4858 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4859 & i,theta(i)*rad2deg,phii*rad2deg,
4860 & phii1*rad2deg,ethetai
4862 etheta=etheta+ethetai
4863 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4864 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4865 gloc(nphi+i-2,icg)=wang*dethetai
4871 c-----------------------------------------------------------------------------
4872 subroutine esc(escloc)
4873 C Calculate the local energy of a side chain and its derivatives in the
4874 C corresponding virtual-bond valence angles THETA and the spherical angles
4876 implicit real*8 (a-h,o-z)
4877 include 'DIMENSIONS'
4878 include 'COMMON.GEO'
4879 include 'COMMON.LOCAL'
4880 include 'COMMON.VAR'
4881 include 'COMMON.INTERACT'
4882 include 'COMMON.DERIV'
4883 include 'COMMON.CHAIN'
4884 include 'COMMON.IOUNITS'
4885 include 'COMMON.NAMES'
4886 include 'COMMON.FFIELD'
4887 include 'COMMON.CONTROL'
4888 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4889 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4890 common /sccalc/ time11,time12,time112,theti,it,nlobit
4893 c write (iout,'(a)') 'ESC'
4894 do i=loc_start,loc_end
4896 if (it.eq.ntyp1) cycle
4897 if (it.eq.10) goto 1
4898 nlobit=nlob(iabs(it))
4899 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4900 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4901 theti=theta(i+1)-pipol
4906 if (x(2).gt.pi-delta) then
4910 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4912 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4913 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4915 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4916 & ddersc0(1),dersc(1))
4917 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4918 & ddersc0(3),dersc(3))
4920 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4922 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4923 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4924 & dersc0(2),esclocbi,dersc02)
4925 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4927 call splinthet(x(2),0.5d0*delta,ss,ssd)
4932 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4934 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4935 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4937 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4939 c write (iout,*) escloci
4940 else if (x(2).lt.delta) then
4944 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4946 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4947 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4949 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4950 & ddersc0(1),dersc(1))
4951 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4952 & ddersc0(3),dersc(3))
4954 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4956 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4957 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4958 & dersc0(2),esclocbi,dersc02)
4959 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4964 call splinthet(x(2),0.5d0*delta,ss,ssd)
4966 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4968 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4969 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4971 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4972 c write (iout,*) escloci
4974 call enesc(x,escloci,dersc,ddummy,.false.)
4977 escloc=escloc+escloci
4978 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4979 & 'escloc',i,escloci
4980 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4982 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4984 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4985 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4990 C---------------------------------------------------------------------------
4991 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4992 implicit real*8 (a-h,o-z)
4993 include 'DIMENSIONS'
4994 include 'COMMON.GEO'
4995 include 'COMMON.LOCAL'
4996 include 'COMMON.IOUNITS'
4997 common /sccalc/ time11,time12,time112,theti,it,nlobit
4998 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4999 double precision contr(maxlob,-1:1)
5001 c write (iout,*) 'it=',it,' nlobit=',nlobit
5005 if (mixed) ddersc(j)=0.0d0
5009 C Because of periodicity of the dependence of the SC energy in omega we have
5010 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5011 C To avoid underflows, first compute & store the exponents.
5019 z(k)=x(k)-censc(k,j,it)
5024 Axk=Axk+gaussc(l,k,j,it)*z(l)
5030 expfac=expfac+Ax(k,j,iii)*z(k)
5038 C As in the case of ebend, we want to avoid underflows in exponentiation and
5039 C subsequent NaNs and INFs in energy calculation.
5040 C Find the largest exponent
5044 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5048 cd print *,'it=',it,' emin=',emin
5050 C Compute the contribution to SC energy and derivatives
5055 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5056 if(adexp.ne.adexp) adexp=1.0
5059 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5061 cd print *,'j=',j,' expfac=',expfac
5062 escloc_i=escloc_i+expfac
5064 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5068 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5069 & +gaussc(k,2,j,it))*expfac
5076 dersc(1)=dersc(1)/cos(theti)**2
5077 ddersc(1)=ddersc(1)/cos(theti)**2
5080 escloci=-(dlog(escloc_i)-emin)
5082 dersc(j)=dersc(j)/escloc_i
5086 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5091 C------------------------------------------------------------------------------
5092 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5093 implicit real*8 (a-h,o-z)
5094 include 'DIMENSIONS'
5095 include 'COMMON.GEO'
5096 include 'COMMON.LOCAL'
5097 include 'COMMON.IOUNITS'
5098 common /sccalc/ time11,time12,time112,theti,it,nlobit
5099 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5100 double precision contr(maxlob)
5111 z(k)=x(k)-censc(k,j,it)
5117 Axk=Axk+gaussc(l,k,j,it)*z(l)
5123 expfac=expfac+Ax(k,j)*z(k)
5128 C As in the case of ebend, we want to avoid underflows in exponentiation and
5129 C subsequent NaNs and INFs in energy calculation.
5130 C Find the largest exponent
5133 if (emin.gt.contr(j)) emin=contr(j)
5137 C Compute the contribution to SC energy and derivatives
5141 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5142 escloc_i=escloc_i+expfac
5144 dersc(k)=dersc(k)+Ax(k,j)*expfac
5146 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5147 & +gaussc(1,2,j,it))*expfac
5151 dersc(1)=dersc(1)/cos(theti)**2
5152 dersc12=dersc12/cos(theti)**2
5153 escloci=-(dlog(escloc_i)-emin)
5155 dersc(j)=dersc(j)/escloc_i
5157 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5161 c----------------------------------------------------------------------------------
5162 subroutine esc(escloc)
5163 C Calculate the local energy of a side chain and its derivatives in the
5164 C corresponding virtual-bond valence angles THETA and the spherical angles
5165 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5166 C added by Urszula Kozlowska. 07/11/2007
5168 implicit real*8 (a-h,o-z)
5169 include 'DIMENSIONS'
5170 include 'COMMON.GEO'
5171 include 'COMMON.LOCAL'
5172 include 'COMMON.VAR'
5173 include 'COMMON.SCROT'
5174 include 'COMMON.INTERACT'
5175 include 'COMMON.DERIV'
5176 include 'COMMON.CHAIN'
5177 include 'COMMON.IOUNITS'
5178 include 'COMMON.NAMES'
5179 include 'COMMON.FFIELD'
5180 include 'COMMON.CONTROL'
5181 include 'COMMON.VECTORS'
5182 double precision x_prime(3),y_prime(3),z_prime(3)
5183 & , sumene,dsc_i,dp2_i,x(65),
5184 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5185 & de_dxx,de_dyy,de_dzz,de_dt
5186 double precision s1_t,s1_6_t,s2_t,s2_6_t
5188 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5189 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5190 & dt_dCi(3),dt_dCi1(3)
5191 common /sccalc/ time11,time12,time112,theti,it,nlobit
5194 do i=loc_start,loc_end
5195 if (itype(i).eq.ntyp1) cycle
5196 costtab(i+1) =dcos(theta(i+1))
5197 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5198 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5199 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5200 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5201 cosfac=dsqrt(cosfac2)
5202 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5203 sinfac=dsqrt(sinfac2)
5205 if (it.eq.10) goto 1
5207 C Compute the axes of tghe local cartesian coordinates system; store in
5208 c x_prime, y_prime and z_prime
5215 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5216 C & dc_norm(3,i+nres)
5218 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5219 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5222 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5225 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5226 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5227 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5228 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5229 c & " xy",scalar(x_prime(1),y_prime(1)),
5230 c & " xz",scalar(x_prime(1),z_prime(1)),
5231 c & " yy",scalar(y_prime(1),y_prime(1)),
5232 c & " yz",scalar(y_prime(1),z_prime(1)),
5233 c & " zz",scalar(z_prime(1),z_prime(1))
5235 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5236 C to local coordinate system. Store in xx, yy, zz.
5242 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5243 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5244 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5251 C Compute the energy of the ith side cbain
5253 c write (2,*) "xx",xx," yy",yy," zz",zz
5256 x(j) = sc_parmin(j,it)
5259 Cc diagnostics - remove later
5261 yy1 = dsin(alph(2))*dcos(omeg(2))
5262 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5263 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5264 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5266 C," --- ", xx_w,yy_w,zz_w
5269 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5270 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5272 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5273 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5275 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5276 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5277 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5278 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5279 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5281 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5282 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5283 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5284 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5285 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5287 dsc_i = 0.743d0+x(61)
5289 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5290 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5291 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5292 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5293 s1=(1+x(63))/(0.1d0 + dscp1)
5294 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5295 s2=(1+x(65))/(0.1d0 + dscp2)
5296 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5297 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5298 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5299 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5301 c & dscp1,dscp2,sumene
5302 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5303 escloc = escloc + sumene
5304 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5309 C This section to check the numerical derivatives of the energy of ith side
5310 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5311 C #define DEBUG in the code to turn it on.
5313 write (2,*) "sumene =",sumene
5317 write (2,*) xx,yy,zz
5318 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5319 de_dxx_num=(sumenep-sumene)/aincr
5321 write (2,*) "xx+ sumene from enesc=",sumenep
5324 write (2,*) xx,yy,zz
5325 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5326 de_dyy_num=(sumenep-sumene)/aincr
5328 write (2,*) "yy+ sumene from enesc=",sumenep
5331 write (2,*) xx,yy,zz
5332 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5333 de_dzz_num=(sumenep-sumene)/aincr
5335 write (2,*) "zz+ sumene from enesc=",sumenep
5336 costsave=cost2tab(i+1)
5337 sintsave=sint2tab(i+1)
5338 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5339 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5340 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5341 de_dt_num=(sumenep-sumene)/aincr
5342 write (2,*) " t+ sumene from enesc=",sumenep
5343 cost2tab(i+1)=costsave
5344 sint2tab(i+1)=sintsave
5345 C End of diagnostics section.
5348 C Compute the gradient of esc
5350 c zz=zz*dsign(1.0,dfloat(itype(i)))
5351 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5352 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5353 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5354 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5355 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5356 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5357 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5358 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5359 pom1=(sumene3*sint2tab(i+1)+sumene1)
5360 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5361 pom2=(sumene4*cost2tab(i+1)+sumene2)
5362 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5363 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5364 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5365 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5367 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5368 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5369 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5371 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5372 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5373 & +(pom1+pom2)*pom_dx
5375 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5378 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5379 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5380 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5382 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5383 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5384 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5385 & +x(59)*zz**2 +x(60)*xx*zz
5386 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5387 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5388 & +(pom1-pom2)*pom_dy
5390 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5393 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5394 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5395 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5396 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5397 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5398 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5399 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5400 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5402 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5405 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5406 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5407 & +pom1*pom_dt1+pom2*pom_dt2
5409 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5414 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5415 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5416 cosfac2xx=cosfac2*xx
5417 sinfac2yy=sinfac2*yy
5419 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5421 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5423 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5424 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5425 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5426 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5427 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5428 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5429 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5430 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5431 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5432 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5436 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5437 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5438 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5439 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5442 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5443 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5444 dZZ_XYZ(k)=vbld_inv(i+nres)*
5445 & (z_prime(k)-zz*dC_norm(k,i+nres))
5447 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5448 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5452 dXX_Ctab(k,i)=dXX_Ci(k)
5453 dXX_C1tab(k,i)=dXX_Ci1(k)
5454 dYY_Ctab(k,i)=dYY_Ci(k)
5455 dYY_C1tab(k,i)=dYY_Ci1(k)
5456 dZZ_Ctab(k,i)=dZZ_Ci(k)
5457 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5458 dXX_XYZtab(k,i)=dXX_XYZ(k)
5459 dYY_XYZtab(k,i)=dYY_XYZ(k)
5460 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5464 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5465 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5466 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5467 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5468 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5470 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5471 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5472 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5473 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5474 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5475 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5476 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5477 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5479 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5480 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5482 C to check gradient call subroutine check_grad
5488 c------------------------------------------------------------------------------
5489 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5491 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5492 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5493 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5494 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5496 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5497 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5499 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5500 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5501 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5502 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5503 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5505 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5506 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5507 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5508 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5509 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5511 dsc_i = 0.743d0+x(61)
5513 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5514 & *(xx*cost2+yy*sint2))
5515 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5516 & *(xx*cost2-yy*sint2))
5517 s1=(1+x(63))/(0.1d0 + dscp1)
5518 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5519 s2=(1+x(65))/(0.1d0 + dscp2)
5520 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5521 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5522 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5527 c------------------------------------------------------------------------------
5528 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5530 C This procedure calculates two-body contact function g(rij) and its derivative:
5533 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5536 C where x=(rij-r0ij)/delta
5538 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5541 double precision rij,r0ij,eps0ij,fcont,fprimcont
5542 double precision x,x2,x4,delta
5546 if (x.lt.-1.0D0) then
5549 else if (x.le.1.0D0) then
5552 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5553 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5560 c------------------------------------------------------------------------------
5561 subroutine splinthet(theti,delta,ss,ssder)
5562 implicit real*8 (a-h,o-z)
5563 include 'DIMENSIONS'
5564 include 'COMMON.VAR'
5565 include 'COMMON.GEO'
5568 if (theti.gt.pipol) then
5569 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5571 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5576 c------------------------------------------------------------------------------
5577 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5579 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5580 double precision ksi,ksi2,ksi3,a1,a2,a3
5581 a1=fprim0*delta/(f1-f0)
5587 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5588 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5591 c------------------------------------------------------------------------------
5592 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5594 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5595 double precision ksi,ksi2,ksi3,a1,a2,a3
5600 a2=3*(f1x-f0x)-2*fprim0x*delta
5601 a3=fprim0x*delta-2*(f1x-f0x)
5602 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5605 C-----------------------------------------------------------------------------
5607 C-----------------------------------------------------------------------------
5608 subroutine etor(etors,edihcnstr)
5609 implicit real*8 (a-h,o-z)
5610 include 'DIMENSIONS'
5611 include 'COMMON.VAR'
5612 include 'COMMON.GEO'
5613 include 'COMMON.LOCAL'
5614 include 'COMMON.TORSION'
5615 include 'COMMON.INTERACT'
5616 include 'COMMON.DERIV'
5617 include 'COMMON.CHAIN'
5618 include 'COMMON.NAMES'
5619 include 'COMMON.IOUNITS'
5620 include 'COMMON.FFIELD'
5621 include 'COMMON.TORCNSTR'
5622 include 'COMMON.CONTROL'
5624 C Set lprn=.true. for debugging
5628 do i=iphi_start,iphi_end
5630 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5631 & .or. itype(i).eq.ntyp1) cycle
5632 itori=itortyp(itype(i-2))
5633 itori1=itortyp(itype(i-1))
5636 C Proline-Proline pair is a special case...
5637 if (itori.eq.3 .and. itori1.eq.3) then
5638 if (phii.gt.-dwapi3) then
5640 fac=1.0D0/(1.0D0-cosphi)
5641 etorsi=v1(1,3,3)*fac
5642 etorsi=etorsi+etorsi
5643 etors=etors+etorsi-v1(1,3,3)
5644 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5645 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5648 v1ij=v1(j+1,itori,itori1)
5649 v2ij=v2(j+1,itori,itori1)
5652 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5653 if (energy_dec) etors_ii=etors_ii+
5654 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5655 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5659 v1ij=v1(j,itori,itori1)
5660 v2ij=v2(j,itori,itori1)
5663 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5664 if (energy_dec) etors_ii=etors_ii+
5665 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5666 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5669 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5672 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5673 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5674 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5675 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5676 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5678 ! 6/20/98 - dihedral angle constraints
5681 itori=idih_constr(i)
5684 if (difi.gt.drange(i)) then
5686 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5687 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5688 else if (difi.lt.-drange(i)) then
5690 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5691 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5693 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5694 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5696 ! write (iout,*) 'edihcnstr',edihcnstr
5699 c------------------------------------------------------------------------------
5700 subroutine etor_d(etors_d)
5704 c----------------------------------------------------------------------------
5706 subroutine etor(etors,edihcnstr)
5707 implicit real*8 (a-h,o-z)
5708 include 'DIMENSIONS'
5709 include 'COMMON.VAR'
5710 include 'COMMON.GEO'
5711 include 'COMMON.LOCAL'
5712 include 'COMMON.TORSION'
5713 include 'COMMON.INTERACT'
5714 include 'COMMON.DERIV'
5715 include 'COMMON.CHAIN'
5716 include 'COMMON.NAMES'
5717 include 'COMMON.IOUNITS'
5718 include 'COMMON.FFIELD'
5719 include 'COMMON.TORCNSTR'
5720 include 'COMMON.CONTROL'
5722 C Set lprn=.true. for debugging
5726 do i=iphi_start,iphi_end
5727 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5728 & .or. itype(i).eq.ntyp1) cycle
5730 if (iabs(itype(i)).eq.20) then
5735 itori=itortyp(itype(i-2))
5736 itori1=itortyp(itype(i-1))
5739 C Regular cosine and sine terms
5740 do j=1,nterm(itori,itori1,iblock)
5741 v1ij=v1(j,itori,itori1,iblock)
5742 v2ij=v2(j,itori,itori1,iblock)
5745 etors=etors+v1ij*cosphi+v2ij*sinphi
5746 if (energy_dec) etors_ii=etors_ii+
5747 & v1ij*cosphi+v2ij*sinphi
5748 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5752 C E = SUM ----------------------------------- - v1
5753 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5755 cosphi=dcos(0.5d0*phii)
5756 sinphi=dsin(0.5d0*phii)
5757 do j=1,nlor(itori,itori1,iblock)
5758 vl1ij=vlor1(j,itori,itori1)
5759 vl2ij=vlor2(j,itori,itori1)
5760 vl3ij=vlor3(j,itori,itori1)
5761 pom=vl2ij*cosphi+vl3ij*sinphi
5762 pom1=1.0d0/(pom*pom+1.0d0)
5763 etors=etors+vl1ij*pom1
5764 if (energy_dec) etors_ii=etors_ii+
5767 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5769 C Subtract the constant term
5770 etors=etors-v0(itori,itori1,iblock)
5771 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5772 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5774 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5775 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5776 & (v1(j,itori,itori1,iblock),j=1,6),
5777 & (v2(j,itori,itori1,iblock),j=1,6)
5778 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5779 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5781 ! 6/20/98 - dihedral angle constraints
5783 c do i=1,ndih_constr
5784 do i=idihconstr_start,idihconstr_end
5785 itori=idih_constr(i)
5787 difi=pinorm(phii-phi0(i))
5788 if (difi.gt.drange(i)) then
5790 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5791 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5792 else if (difi.lt.-drange(i)) then
5794 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5795 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5799 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5800 cd & rad2deg*phi0(i), rad2deg*drange(i),
5801 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5803 cd write (iout,*) 'edihcnstr',edihcnstr
5806 c----------------------------------------------------------------------------
5807 subroutine etor_d(etors_d)
5808 C 6/23/01 Compute double torsional energy
5809 implicit real*8 (a-h,o-z)
5810 include 'DIMENSIONS'
5811 include 'COMMON.VAR'
5812 include 'COMMON.GEO'
5813 include 'COMMON.LOCAL'
5814 include 'COMMON.TORSION'
5815 include 'COMMON.INTERACT'
5816 include 'COMMON.DERIV'
5817 include 'COMMON.CHAIN'
5818 include 'COMMON.NAMES'
5819 include 'COMMON.IOUNITS'
5820 include 'COMMON.FFIELD'
5821 include 'COMMON.TORCNSTR'
5823 C Set lprn=.true. for debugging
5827 c write(iout,*) "a tu??"
5828 do i=iphid_start,iphid_end
5829 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5830 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5831 itori=itortyp(itype(i-2))
5832 itori1=itortyp(itype(i-1))
5833 itori2=itortyp(itype(i))
5839 if (iabs(itype(i+1)).eq.20) iblock=2
5841 C Regular cosine and sine terms
5842 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5843 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5844 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5845 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5846 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5847 cosphi1=dcos(j*phii)
5848 sinphi1=dsin(j*phii)
5849 cosphi2=dcos(j*phii1)
5850 sinphi2=dsin(j*phii1)
5851 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5852 & v2cij*cosphi2+v2sij*sinphi2
5853 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5854 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5856 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5858 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5859 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5860 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5861 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5862 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5863 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5864 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5865 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5866 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5867 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5868 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5869 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5870 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5871 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5874 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5875 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5880 c------------------------------------------------------------------------------
5881 subroutine eback_sc_corr(esccor)
5882 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5883 c conformational states; temporarily implemented as differences
5884 c between UNRES torsional potentials (dependent on three types of
5885 c residues) and the torsional potentials dependent on all 20 types
5886 c of residues computed from AM1 energy surfaces of terminally-blocked
5887 c amino-acid residues.
5888 implicit real*8 (a-h,o-z)
5889 include 'DIMENSIONS'
5890 include 'COMMON.VAR'
5891 include 'COMMON.GEO'
5892 include 'COMMON.LOCAL'
5893 include 'COMMON.TORSION'
5894 include 'COMMON.SCCOR'
5895 include 'COMMON.INTERACT'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.CHAIN'
5898 include 'COMMON.NAMES'
5899 include 'COMMON.IOUNITS'
5900 include 'COMMON.FFIELD'
5901 include 'COMMON.CONTROL'
5903 C Set lprn=.true. for debugging
5906 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5908 do i=itau_start,itau_end
5909 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5911 isccori=isccortyp(itype(i-2))
5912 isccori1=isccortyp(itype(i-1))
5913 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5915 do intertyp=1,3 !intertyp
5916 cc Added 09 May 2012 (Adasko)
5917 cc Intertyp means interaction type of backbone mainchain correlation:
5918 c 1 = SC...Ca...Ca...Ca
5919 c 2 = Ca...Ca...Ca...SC
5920 c 3 = SC...Ca...Ca...SCi
5922 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5923 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5924 & (itype(i-1).eq.ntyp1)))
5925 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5926 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5927 & .or.(itype(i).eq.ntyp1)))
5928 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5929 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5930 & (itype(i-3).eq.ntyp1)))) cycle
5931 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5932 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5934 do j=1,nterm_sccor(isccori,isccori1)
5935 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5936 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5937 cosphi=dcos(j*tauangle(intertyp,i))
5938 sinphi=dsin(j*tauangle(intertyp,i))
5939 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5940 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5942 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5943 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5945 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5946 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5947 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5948 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5949 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5955 c----------------------------------------------------------------------------
5956 subroutine multibody(ecorr)
5957 C This subroutine calculates multi-body contributions to energy following
5958 C the idea of Skolnick et al. If side chains I and J make a contact and
5959 C at the same time side chains I+1 and J+1 make a contact, an extra
5960 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5961 implicit real*8 (a-h,o-z)
5962 include 'DIMENSIONS'
5963 include 'COMMON.IOUNITS'
5964 include 'COMMON.DERIV'
5965 include 'COMMON.INTERACT'
5966 include 'COMMON.CONTACTS'
5967 double precision gx(3),gx1(3)
5970 C Set lprn=.true. for debugging
5974 write (iout,'(a)') 'Contact function values:'
5976 write (iout,'(i2,20(1x,i2,f10.5))')
5977 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5992 num_conti=num_cont(i)
5993 num_conti1=num_cont(i1)
5998 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5999 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6000 cd & ' ishift=',ishift
6001 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6002 C The system gains extra energy.
6003 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6004 endif ! j1==j+-ishift
6013 c------------------------------------------------------------------------------
6014 double precision function esccorr(i,j,k,l,jj,kk)
6015 implicit real*8 (a-h,o-z)
6016 include 'DIMENSIONS'
6017 include 'COMMON.IOUNITS'
6018 include 'COMMON.DERIV'
6019 include 'COMMON.INTERACT'
6020 include 'COMMON.CONTACTS'
6021 double precision gx(3),gx1(3)
6026 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6027 C Calculate the multi-body contribution to energy.
6028 C Calculate multi-body contributions to the gradient.
6029 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6030 cd & k,l,(gacont(m,kk,k),m=1,3)
6032 gx(m) =ekl*gacont(m,jj,i)
6033 gx1(m)=eij*gacont(m,kk,k)
6034 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6035 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6036 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6037 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6041 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6046 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6052 c------------------------------------------------------------------------------
6053 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6054 C This subroutine calculates multi-body contributions to hydrogen-bonding
6055 implicit real*8 (a-h,o-z)
6056 include 'DIMENSIONS'
6057 include 'COMMON.IOUNITS'
6060 parameter (max_cont=maxconts)
6061 parameter (max_dim=26)
6062 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6063 double precision zapas(max_dim,maxconts,max_fg_procs),
6064 & zapas_recv(max_dim,maxconts,max_fg_procs)
6065 common /przechowalnia/ zapas
6066 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6067 & status_array(MPI_STATUS_SIZE,maxconts*2)
6069 include 'COMMON.SETUP'
6070 include 'COMMON.FFIELD'
6071 include 'COMMON.DERIV'
6072 include 'COMMON.INTERACT'
6073 include 'COMMON.CONTACTS'
6074 include 'COMMON.CONTROL'
6075 include 'COMMON.LOCAL'
6076 double precision gx(3),gx1(3),time00
6079 C Set lprn=.true. for debugging
6084 if (nfgtasks.le.1) goto 30
6086 write (iout,'(a)') 'Contact function values before RECEIVE:'
6088 write (iout,'(2i3,50(1x,i2,f5.2))')
6089 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6090 & j=1,num_cont_hb(i))
6094 do i=1,ntask_cont_from
6097 do i=1,ntask_cont_to
6100 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6102 C Make the list of contacts to send to send to other procesors
6103 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6105 do i=iturn3_start,iturn3_end
6106 c write (iout,*) "make contact list turn3",i," num_cont",
6108 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6110 do i=iturn4_start,iturn4_end
6111 c write (iout,*) "make contact list turn4",i," num_cont",
6113 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6117 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6119 do j=1,num_cont_hb(i)
6122 iproc=iint_sent_local(k,jjc,ii)
6123 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6124 if (iproc.gt.0) then
6125 ncont_sent(iproc)=ncont_sent(iproc)+1
6126 nn=ncont_sent(iproc)
6128 zapas(2,nn,iproc)=jjc
6129 zapas(3,nn,iproc)=facont_hb(j,i)
6130 zapas(4,nn,iproc)=ees0p(j,i)
6131 zapas(5,nn,iproc)=ees0m(j,i)
6132 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6133 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6134 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6135 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6136 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6137 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6138 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6139 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6140 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6141 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6142 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6143 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6144 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6145 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6146 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6147 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6148 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6149 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6150 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6151 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6152 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6159 & "Numbers of contacts to be sent to other processors",
6160 & (ncont_sent(i),i=1,ntask_cont_to)
6161 write (iout,*) "Contacts sent"
6162 do ii=1,ntask_cont_to
6164 iproc=itask_cont_to(ii)
6165 write (iout,*) nn," contacts to processor",iproc,
6166 & " of CONT_TO_COMM group"
6168 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6176 CorrelID1=nfgtasks+fg_rank+1
6178 C Receive the numbers of needed contacts from other processors
6179 do ii=1,ntask_cont_from
6180 iproc=itask_cont_from(ii)
6182 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6183 & FG_COMM,req(ireq),IERR)
6185 c write (iout,*) "IRECV ended"
6187 C Send the number of contacts needed by other processors
6188 do ii=1,ntask_cont_to
6189 iproc=itask_cont_to(ii)
6191 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6192 & FG_COMM,req(ireq),IERR)
6194 c write (iout,*) "ISEND ended"
6195 c write (iout,*) "number of requests (nn)",ireq
6198 & call MPI_Waitall(ireq,req,status_array,ierr)
6200 c & "Numbers of contacts to be received from other processors",
6201 c & (ncont_recv(i),i=1,ntask_cont_from)
6205 do ii=1,ntask_cont_from
6206 iproc=itask_cont_from(ii)
6208 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6209 c & " of CONT_TO_COMM group"
6213 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6214 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6215 c write (iout,*) "ireq,req",ireq,req(ireq)
6218 C Send the contacts to processors that need them
6219 do ii=1,ntask_cont_to
6220 iproc=itask_cont_to(ii)
6222 c write (iout,*) nn," contacts to processor",iproc,
6223 c & " of CONT_TO_COMM group"
6226 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6227 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6228 c write (iout,*) "ireq,req",ireq,req(ireq)
6230 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6234 c write (iout,*) "number of requests (contacts)",ireq
6235 c write (iout,*) "req",(req(i),i=1,4)
6238 & call MPI_Waitall(ireq,req,status_array,ierr)
6239 do iii=1,ntask_cont_from
6240 iproc=itask_cont_from(iii)
6243 write (iout,*) "Received",nn," contacts from processor",iproc,
6244 & " of CONT_FROM_COMM group"
6247 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6252 ii=zapas_recv(1,i,iii)
6253 c Flag the received contacts to prevent double-counting
6254 jj=-zapas_recv(2,i,iii)
6255 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6257 nnn=num_cont_hb(ii)+1
6260 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6261 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6262 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6263 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6264 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6265 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6266 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6267 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6268 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6269 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6270 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6271 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6272 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6273 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6274 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6275 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6276 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6277 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6278 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6279 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6280 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6281 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6282 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6283 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6288 write (iout,'(a)') 'Contact function values after receive:'
6290 write (iout,'(2i3,50(1x,i3,f5.2))')
6291 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6292 & j=1,num_cont_hb(i))
6299 write (iout,'(a)') 'Contact function values:'
6301 write (iout,'(2i3,50(1x,i3,f5.2))')
6302 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6303 & j=1,num_cont_hb(i))
6307 C Remove the loop below after debugging !!!
6314 C Calculate the local-electrostatic correlation terms
6315 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6317 num_conti=num_cont_hb(i)
6318 num_conti1=num_cont_hb(i+1)
6325 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6326 c & ' jj=',jj,' kk=',kk
6327 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6328 & .or. j.lt.0 .and. j1.gt.0) .and.
6329 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6330 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6331 C The system gains extra energy.
6332 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6333 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6334 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6336 else if (j1.eq.j) then
6337 C Contacts I-J and I-(J+1) occur simultaneously.
6338 C The system loses extra energy.
6339 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6344 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6345 c & ' jj=',jj,' kk=',kk
6347 C Contacts I-J and (I+1)-J occur simultaneously.
6348 C The system loses extra energy.
6349 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6356 c------------------------------------------------------------------------------
6357 subroutine add_hb_contact(ii,jj,itask)
6358 implicit real*8 (a-h,o-z)
6359 include "DIMENSIONS"
6360 include "COMMON.IOUNITS"
6363 parameter (max_cont=maxconts)
6364 parameter (max_dim=26)
6365 include "COMMON.CONTACTS"
6366 double precision zapas(max_dim,maxconts,max_fg_procs),
6367 & zapas_recv(max_dim,maxconts,max_fg_procs)
6368 common /przechowalnia/ zapas
6369 integer i,j,ii,jj,iproc,itask(4),nn
6370 c write (iout,*) "itask",itask
6373 if (iproc.gt.0) then
6374 do j=1,num_cont_hb(ii)
6376 c write (iout,*) "i",ii," j",jj," jjc",jjc
6378 ncont_sent(iproc)=ncont_sent(iproc)+1
6379 nn=ncont_sent(iproc)
6380 zapas(1,nn,iproc)=ii
6381 zapas(2,nn,iproc)=jjc
6382 zapas(3,nn,iproc)=facont_hb(j,ii)
6383 zapas(4,nn,iproc)=ees0p(j,ii)
6384 zapas(5,nn,iproc)=ees0m(j,ii)
6385 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6386 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6387 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6388 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6389 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6390 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6391 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6392 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6393 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6394 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6395 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6396 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6397 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6398 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6399 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6400 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6401 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6402 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6403 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6404 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6405 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6413 c------------------------------------------------------------------------------
6414 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6416 C This subroutine calculates multi-body contributions to hydrogen-bonding
6417 implicit real*8 (a-h,o-z)
6418 include 'DIMENSIONS'
6419 include 'COMMON.IOUNITS'
6422 parameter (max_cont=maxconts)
6423 parameter (max_dim=70)
6424 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6425 double precision zapas(max_dim,maxconts,max_fg_procs),
6426 & zapas_recv(max_dim,maxconts,max_fg_procs)
6427 common /przechowalnia/ zapas
6428 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6429 & status_array(MPI_STATUS_SIZE,maxconts*2)
6431 include 'COMMON.SETUP'
6432 include 'COMMON.FFIELD'
6433 include 'COMMON.DERIV'
6434 include 'COMMON.LOCAL'
6435 include 'COMMON.INTERACT'
6436 include 'COMMON.CONTACTS'
6437 include 'COMMON.CHAIN'
6438 include 'COMMON.CONTROL'
6439 double precision gx(3),gx1(3)
6440 integer num_cont_hb_old(maxres)
6442 double precision eello4,eello5,eelo6,eello_turn6
6443 external eello4,eello5,eello6,eello_turn6
6444 C Set lprn=.true. for debugging
6449 num_cont_hb_old(i)=num_cont_hb(i)
6453 if (nfgtasks.le.1) goto 30
6455 write (iout,'(a)') 'Contact function values before RECEIVE:'
6457 write (iout,'(2i3,50(1x,i2,f5.2))')
6458 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6459 & j=1,num_cont_hb(i))
6463 do i=1,ntask_cont_from
6466 do i=1,ntask_cont_to
6469 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6471 C Make the list of contacts to send to send to other procesors
6472 do i=iturn3_start,iturn3_end
6473 c write (iout,*) "make contact list turn3",i," num_cont",
6475 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6477 do i=iturn4_start,iturn4_end
6478 c write (iout,*) "make contact list turn4",i," num_cont",
6480 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6484 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6486 do j=1,num_cont_hb(i)
6489 iproc=iint_sent_local(k,jjc,ii)
6490 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6491 if (iproc.ne.0) then
6492 ncont_sent(iproc)=ncont_sent(iproc)+1
6493 nn=ncont_sent(iproc)
6495 zapas(2,nn,iproc)=jjc
6496 zapas(3,nn,iproc)=d_cont(j,i)
6500 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6505 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6513 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6524 & "Numbers of contacts to be sent to other processors",
6525 & (ncont_sent(i),i=1,ntask_cont_to)
6526 write (iout,*) "Contacts sent"
6527 do ii=1,ntask_cont_to
6529 iproc=itask_cont_to(ii)
6530 write (iout,*) nn," contacts to processor",iproc,
6531 & " of CONT_TO_COMM group"
6533 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6541 CorrelID1=nfgtasks+fg_rank+1
6543 C Receive the numbers of needed contacts from other processors
6544 do ii=1,ntask_cont_from
6545 iproc=itask_cont_from(ii)
6547 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6548 & FG_COMM,req(ireq),IERR)
6550 c write (iout,*) "IRECV ended"
6552 C Send the number of contacts needed by other processors
6553 do ii=1,ntask_cont_to
6554 iproc=itask_cont_to(ii)
6556 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6557 & FG_COMM,req(ireq),IERR)
6559 c write (iout,*) "ISEND ended"
6560 c write (iout,*) "number of requests (nn)",ireq
6563 & call MPI_Waitall(ireq,req,status_array,ierr)
6565 c & "Numbers of contacts to be received from other processors",
6566 c & (ncont_recv(i),i=1,ntask_cont_from)
6570 do ii=1,ntask_cont_from
6571 iproc=itask_cont_from(ii)
6573 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6574 c & " of CONT_TO_COMM group"
6578 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6579 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6580 c write (iout,*) "ireq,req",ireq,req(ireq)
6583 C Send the contacts to processors that need them
6584 do ii=1,ntask_cont_to
6585 iproc=itask_cont_to(ii)
6587 c write (iout,*) nn," contacts to processor",iproc,
6588 c & " of CONT_TO_COMM group"
6591 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6592 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6593 c write (iout,*) "ireq,req",ireq,req(ireq)
6595 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6599 c write (iout,*) "number of requests (contacts)",ireq
6600 c write (iout,*) "req",(req(i),i=1,4)
6603 & call MPI_Waitall(ireq,req,status_array,ierr)
6604 do iii=1,ntask_cont_from
6605 iproc=itask_cont_from(iii)
6608 write (iout,*) "Received",nn," contacts from processor",iproc,
6609 & " of CONT_FROM_COMM group"
6612 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6617 ii=zapas_recv(1,i,iii)
6618 c Flag the received contacts to prevent double-counting
6619 jj=-zapas_recv(2,i,iii)
6620 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6622 nnn=num_cont_hb(ii)+1
6625 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6629 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6634 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6642 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6651 write (iout,'(a)') 'Contact function values after receive:'
6653 write (iout,'(2i3,50(1x,i3,5f6.3))')
6654 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6655 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6662 write (iout,'(a)') 'Contact function values:'
6664 write (iout,'(2i3,50(1x,i2,5f6.3))')
6665 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6666 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6672 C Remove the loop below after debugging !!!
6679 C Calculate the dipole-dipole interaction energies
6680 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6681 do i=iatel_s,iatel_e+1
6682 num_conti=num_cont_hb(i)
6691 C Calculate the local-electrostatic correlation terms
6692 c write (iout,*) "gradcorr5 in eello5 before loop"
6694 c write (iout,'(i5,3f10.5)')
6695 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6697 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6698 c write (iout,*) "corr loop i",i
6700 num_conti=num_cont_hb(i)
6701 num_conti1=num_cont_hb(i+1)
6708 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6709 c & ' jj=',jj,' kk=',kk
6710 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6711 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6712 & .or. j.lt.0 .and. j1.gt.0) .and.
6713 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6714 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6715 C The system gains extra energy.
6717 sqd1=dsqrt(d_cont(jj,i))
6718 sqd2=dsqrt(d_cont(kk,i1))
6719 sred_geom = sqd1*sqd2
6720 IF (sred_geom.lt.cutoff_corr) THEN
6721 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6723 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6724 cd & ' jj=',jj,' kk=',kk
6725 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6726 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6728 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6729 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6732 cd write (iout,*) 'sred_geom=',sred_geom,
6733 cd & ' ekont=',ekont,' fprim=',fprimcont,
6734 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6735 cd write (iout,*) "g_contij",g_contij
6736 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6737 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6738 call calc_eello(i,jp,i+1,jp1,jj,kk)
6739 if (wcorr4.gt.0.0d0)
6740 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6741 if (energy_dec.and.wcorr4.gt.0.0d0)
6742 1 write (iout,'(a6,4i5,0pf7.3)')
6743 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6744 c write (iout,*) "gradcorr5 before eello5"
6746 c write (iout,'(i5,3f10.5)')
6747 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6749 if (wcorr5.gt.0.0d0)
6750 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6751 c write (iout,*) "gradcorr5 after eello5"
6753 c write (iout,'(i5,3f10.5)')
6754 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6756 if (energy_dec.and.wcorr5.gt.0.0d0)
6757 1 write (iout,'(a6,4i5,0pf7.3)')
6758 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6759 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6760 cd write(2,*)'ijkl',i,jp,i+1,jp1
6761 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6762 & .or. wturn6.eq.0.0d0))then
6763 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6764 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6765 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6766 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6767 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6768 cd & 'ecorr6=',ecorr6
6769 cd write (iout,'(4e15.5)') sred_geom,
6770 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6771 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6772 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6773 else if (wturn6.gt.0.0d0
6774 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6775 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6776 eturn6=eturn6+eello_turn6(i,jj,kk)
6777 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6778 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6779 cd write (2,*) 'multibody_eello:eturn6',eturn6
6788 num_cont_hb(i)=num_cont_hb_old(i)
6790 c write (iout,*) "gradcorr5 in eello5"
6792 c write (iout,'(i5,3f10.5)')
6793 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6797 c------------------------------------------------------------------------------
6798 subroutine add_hb_contact_eello(ii,jj,itask)
6799 implicit real*8 (a-h,o-z)
6800 include "DIMENSIONS"
6801 include "COMMON.IOUNITS"
6804 parameter (max_cont=maxconts)
6805 parameter (max_dim=70)
6806 include "COMMON.CONTACTS"
6807 double precision zapas(max_dim,maxconts,max_fg_procs),
6808 & zapas_recv(max_dim,maxconts,max_fg_procs)
6809 common /przechowalnia/ zapas
6810 integer i,j,ii,jj,iproc,itask(4),nn
6811 c write (iout,*) "itask",itask
6814 if (iproc.gt.0) then
6815 do j=1,num_cont_hb(ii)
6817 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6819 ncont_sent(iproc)=ncont_sent(iproc)+1
6820 nn=ncont_sent(iproc)
6821 zapas(1,nn,iproc)=ii
6822 zapas(2,nn,iproc)=jjc
6823 zapas(3,nn,iproc)=d_cont(j,ii)
6827 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6832 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6840 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6852 c------------------------------------------------------------------------------
6853 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6854 implicit real*8 (a-h,o-z)
6855 include 'DIMENSIONS'
6856 include 'COMMON.IOUNITS'
6857 include 'COMMON.DERIV'
6858 include 'COMMON.INTERACT'
6859 include 'COMMON.CONTACTS'
6860 double precision gx(3),gx1(3)
6870 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6871 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6872 C Following 4 lines for diagnostics.
6877 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6878 c & 'Contacts ',i,j,
6879 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6880 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6882 C Calculate the multi-body contribution to energy.
6883 c ecorr=ecorr+ekont*ees
6884 C Calculate multi-body contributions to the gradient.
6885 coeffpees0pij=coeffp*ees0pij
6886 coeffmees0mij=coeffm*ees0mij
6887 coeffpees0pkl=coeffp*ees0pkl
6888 coeffmees0mkl=coeffm*ees0mkl
6890 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6891 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6892 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6893 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6894 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6895 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6896 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6897 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6898 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6899 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6900 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6901 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6902 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6903 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6904 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6905 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6906 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6907 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6908 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6909 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6910 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6911 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6912 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6913 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6914 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6919 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6920 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6921 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6922 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6927 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6928 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6929 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6930 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6933 c write (iout,*) "ehbcorr",ekont*ees
6938 C---------------------------------------------------------------------------
6939 subroutine dipole(i,j,jj)
6940 implicit real*8 (a-h,o-z)
6941 include 'DIMENSIONS'
6942 include 'COMMON.IOUNITS'
6943 include 'COMMON.CHAIN'
6944 include 'COMMON.FFIELD'
6945 include 'COMMON.DERIV'
6946 include 'COMMON.INTERACT'
6947 include 'COMMON.CONTACTS'
6948 include 'COMMON.TORSION'
6949 include 'COMMON.VAR'
6950 include 'COMMON.GEO'
6951 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6953 iti1 = itortyp(itype(i+1))
6954 if (j.lt.nres-1) then
6955 itj1 = itortyp(itype(j+1))
6960 dipi(iii,1)=Ub2(iii,i)
6961 dipderi(iii)=Ub2der(iii,i)
6962 dipi(iii,2)=b1(iii,i+1)
6963 dipj(iii,1)=Ub2(iii,j)
6964 dipderj(iii)=Ub2der(iii,j)
6965 dipj(iii,2)=b1(iii,j+1)
6969 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6972 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6979 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6983 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6988 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6989 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6991 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6993 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6995 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7000 C---------------------------------------------------------------------------
7001 subroutine calc_eello(i,j,k,l,jj,kk)
7003 C This subroutine computes matrices and vectors needed to calculate
7004 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7006 implicit real*8 (a-h,o-z)
7007 include 'DIMENSIONS'
7008 include 'COMMON.IOUNITS'
7009 include 'COMMON.CHAIN'
7010 include 'COMMON.DERIV'
7011 include 'COMMON.INTERACT'
7012 include 'COMMON.CONTACTS'
7013 include 'COMMON.TORSION'
7014 include 'COMMON.VAR'
7015 include 'COMMON.GEO'
7016 include 'COMMON.FFIELD'
7017 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7018 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7021 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7022 cd & ' jj=',jj,' kk=',kk
7023 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7024 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7025 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7028 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7029 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7032 call transpose2(aa1(1,1),aa1t(1,1))
7033 call transpose2(aa2(1,1),aa2t(1,1))
7036 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7037 & aa1tder(1,1,lll,kkk))
7038 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7039 & aa2tder(1,1,lll,kkk))
7043 C parallel orientation of the two CA-CA-CA frames.
7045 iti=itortyp(itype(i))
7049 itk1=itortyp(itype(k+1))
7050 itj=itortyp(itype(j))
7051 if (l.lt.nres-1) then
7052 itl1=itortyp(itype(l+1))
7056 C A1 kernel(j+1) A2T
7058 cd write (iout,'(3f10.5,5x,3f10.5)')
7059 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7061 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7062 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7063 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7064 C Following matrices are needed only for 6-th order cumulants
7065 IF (wcorr6.gt.0.0d0) THEN
7066 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7067 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7068 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7069 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7070 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7071 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7072 & ADtEAderx(1,1,1,1,1,1))
7074 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7075 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7076 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7077 & ADtEA1derx(1,1,1,1,1,1))
7079 C End 6-th order cumulants
7082 cd write (2,*) 'In calc_eello6'
7084 cd write (2,*) 'iii=',iii
7086 cd write (2,*) 'kkk=',kkk
7088 cd write (2,'(3(2f10.5),5x)')
7089 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7094 call transpose2(EUgder(1,1,k),auxmat(1,1))
7095 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7096 call transpose2(EUg(1,1,k),auxmat(1,1))
7097 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7098 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7102 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7103 & EAEAderx(1,1,lll,kkk,iii,1))
7107 C A1T kernel(i+1) A2
7108 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7109 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7110 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7111 C Following matrices are needed only for 6-th order cumulants
7112 IF (wcorr6.gt.0.0d0) THEN
7113 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7114 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7115 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7116 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7117 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7118 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7119 & ADtEAderx(1,1,1,1,1,2))
7120 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7121 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7122 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7123 & ADtEA1derx(1,1,1,1,1,2))
7125 C End 6-th order cumulants
7126 call transpose2(EUgder(1,1,l),auxmat(1,1))
7127 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7128 call transpose2(EUg(1,1,l),auxmat(1,1))
7129 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7130 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7134 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7135 & EAEAderx(1,1,lll,kkk,iii,2))
7140 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7141 C They are needed only when the fifth- or the sixth-order cumulants are
7143 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7144 call transpose2(AEA(1,1,1),auxmat(1,1))
7145 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7146 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7147 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7148 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7149 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7150 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7151 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7152 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7153 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7154 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7155 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7156 call transpose2(AEA(1,1,2),auxmat(1,1))
7157 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7158 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7159 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7160 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7161 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7162 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7163 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7164 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7165 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7166 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7167 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7168 C Calculate the Cartesian derivatives of the vectors.
7172 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7173 call matvec2(auxmat(1,1),b1(1,i),
7174 & AEAb1derx(1,lll,kkk,iii,1,1))
7175 call matvec2(auxmat(1,1),Ub2(1,i),
7176 & AEAb2derx(1,lll,kkk,iii,1,1))
7177 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7178 & AEAb1derx(1,lll,kkk,iii,2,1))
7179 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7180 & AEAb2derx(1,lll,kkk,iii,2,1))
7181 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7182 call matvec2(auxmat(1,1),b1(1,j),
7183 & AEAb1derx(1,lll,kkk,iii,1,2))
7184 call matvec2(auxmat(1,1),Ub2(1,j),
7185 & AEAb2derx(1,lll,kkk,iii,1,2))
7186 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7187 & AEAb1derx(1,lll,kkk,iii,2,2))
7188 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7189 & AEAb2derx(1,lll,kkk,iii,2,2))
7196 C Antiparallel orientation of the two CA-CA-CA frames.
7198 iti=itortyp(itype(i))
7202 itk1=itortyp(itype(k+1))
7203 itl=itortyp(itype(l))
7204 itj=itortyp(itype(j))
7205 if (j.lt.nres-1) then
7206 itj1=itortyp(itype(j+1))
7210 C A2 kernel(j-1)T A1T
7211 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7212 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7213 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7214 C Following matrices are needed only for 6-th order cumulants
7215 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7216 & j.eq.i+4 .and. l.eq.i+3)) THEN
7217 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7218 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7219 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7220 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7221 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7222 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7223 & ADtEAderx(1,1,1,1,1,1))
7224 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7225 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7226 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7227 & ADtEA1derx(1,1,1,1,1,1))
7229 C End 6-th order cumulants
7230 call transpose2(EUgder(1,1,k),auxmat(1,1))
7231 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7232 call transpose2(EUg(1,1,k),auxmat(1,1))
7233 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7234 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7238 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7239 & EAEAderx(1,1,lll,kkk,iii,1))
7243 C A2T kernel(i+1)T A1
7244 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7245 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7246 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7247 C Following matrices are needed only for 6-th order cumulants
7248 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7249 & j.eq.i+4 .and. l.eq.i+3)) THEN
7250 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7251 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7252 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7253 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7254 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7255 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7256 & ADtEAderx(1,1,1,1,1,2))
7257 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7258 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7259 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7260 & ADtEA1derx(1,1,1,1,1,2))
7262 C End 6-th order cumulants
7263 call transpose2(EUgder(1,1,j),auxmat(1,1))
7264 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7265 call transpose2(EUg(1,1,j),auxmat(1,1))
7266 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7267 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7271 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7272 & EAEAderx(1,1,lll,kkk,iii,2))
7277 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7278 C They are needed only when the fifth- or the sixth-order cumulants are
7280 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7281 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7282 call transpose2(AEA(1,1,1),auxmat(1,1))
7283 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7284 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7285 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7286 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7287 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7288 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7289 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7290 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7291 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7292 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7293 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7294 call transpose2(AEA(1,1,2),auxmat(1,1))
7295 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7296 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7297 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7298 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7299 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7300 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7301 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7302 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7303 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7304 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7305 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7306 C Calculate the Cartesian derivatives of the vectors.
7310 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7311 call matvec2(auxmat(1,1),b1(1,i),
7312 & AEAb1derx(1,lll,kkk,iii,1,1))
7313 call matvec2(auxmat(1,1),Ub2(1,i),
7314 & AEAb2derx(1,lll,kkk,iii,1,1))
7315 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7316 & AEAb1derx(1,lll,kkk,iii,2,1))
7317 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7318 & AEAb2derx(1,lll,kkk,iii,2,1))
7319 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7320 call matvec2(auxmat(1,1),b1(1,l),
7321 & AEAb1derx(1,lll,kkk,iii,1,2))
7322 call matvec2(auxmat(1,1),Ub2(1,l),
7323 & AEAb2derx(1,lll,kkk,iii,1,2))
7324 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7325 & AEAb1derx(1,lll,kkk,iii,2,2))
7326 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7327 & AEAb2derx(1,lll,kkk,iii,2,2))
7336 C---------------------------------------------------------------------------
7337 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7338 & KK,KKderg,AKA,AKAderg,AKAderx)
7342 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7343 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7344 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7349 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7351 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7354 cd if (lprn) write (2,*) 'In kernel'
7356 cd if (lprn) write (2,*) 'kkk=',kkk
7358 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7359 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7361 cd write (2,*) 'lll=',lll
7362 cd write (2,*) 'iii=1'
7364 cd write (2,'(3(2f10.5),5x)')
7365 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7368 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7369 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7371 cd write (2,*) 'lll=',lll
7372 cd write (2,*) 'iii=2'
7374 cd write (2,'(3(2f10.5),5x)')
7375 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7382 C---------------------------------------------------------------------------
7383 double precision function eello4(i,j,k,l,jj,kk)
7384 implicit real*8 (a-h,o-z)
7385 include 'DIMENSIONS'
7386 include 'COMMON.IOUNITS'
7387 include 'COMMON.CHAIN'
7388 include 'COMMON.DERIV'
7389 include 'COMMON.INTERACT'
7390 include 'COMMON.CONTACTS'
7391 include 'COMMON.TORSION'
7392 include 'COMMON.VAR'
7393 include 'COMMON.GEO'
7394 double precision pizda(2,2),ggg1(3),ggg2(3)
7395 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7399 cd print *,'eello4:',i,j,k,l,jj,kk
7400 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7401 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7402 cold eij=facont_hb(jj,i)
7403 cold ekl=facont_hb(kk,k)
7405 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7406 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7407 gcorr_loc(k-1)=gcorr_loc(k-1)
7408 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7410 gcorr_loc(l-1)=gcorr_loc(l-1)
7411 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7413 gcorr_loc(j-1)=gcorr_loc(j-1)
7414 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7419 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7420 & -EAEAderx(2,2,lll,kkk,iii,1)
7421 cd derx(lll,kkk,iii)=0.0d0
7425 cd gcorr_loc(l-1)=0.0d0
7426 cd gcorr_loc(j-1)=0.0d0
7427 cd gcorr_loc(k-1)=0.0d0
7429 cd write (iout,*)'Contacts have occurred for peptide groups',
7430 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7431 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7432 if (j.lt.nres-1) then
7439 if (l.lt.nres-1) then
7447 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7448 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7449 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7450 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7451 cgrad ghalf=0.5d0*ggg1(ll)
7452 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7453 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7454 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7455 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7456 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7457 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7458 cgrad ghalf=0.5d0*ggg2(ll)
7459 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7460 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7461 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7462 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7463 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7464 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7468 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7473 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7478 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7483 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7487 cd write (2,*) iii,gcorr_loc(iii)
7490 cd write (2,*) 'ekont',ekont
7491 cd write (iout,*) 'eello4',ekont*eel4
7494 C---------------------------------------------------------------------------
7495 double precision function eello5(i,j,k,l,jj,kk)
7496 implicit real*8 (a-h,o-z)
7497 include 'DIMENSIONS'
7498 include 'COMMON.IOUNITS'
7499 include 'COMMON.CHAIN'
7500 include 'COMMON.DERIV'
7501 include 'COMMON.INTERACT'
7502 include 'COMMON.CONTACTS'
7503 include 'COMMON.TORSION'
7504 include 'COMMON.VAR'
7505 include 'COMMON.GEO'
7506 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7507 double precision ggg1(3),ggg2(3)
7508 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7513 C /l\ / \ \ / \ / \ / C
7514 C / \ / \ \ / \ / \ / C
7515 C j| o |l1 | o | o| o | | o |o C
7516 C \ |/k\| |/ \| / |/ \| |/ \| C
7517 C \i/ \ / \ / / \ / \ C
7519 C (I) (II) (III) (IV) C
7521 C eello5_1 eello5_2 eello5_3 eello5_4 C
7523 C Antiparallel chains C
7526 C /j\ / \ \ / \ / \ / C
7527 C / \ / \ \ / \ / \ / C
7528 C j1| o |l | o | o| o | | o |o C
7529 C \ |/k\| |/ \| / |/ \| |/ \| C
7530 C \i/ \ / \ / / \ / \ C
7532 C (I) (II) (III) (IV) C
7534 C eello5_1 eello5_2 eello5_3 eello5_4 C
7536 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7538 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7539 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7544 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7546 itk=itortyp(itype(k))
7547 itl=itortyp(itype(l))
7548 itj=itortyp(itype(j))
7553 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7554 cd & eel5_3_num,eel5_4_num)
7558 derx(lll,kkk,iii)=0.0d0
7562 cd eij=facont_hb(jj,i)
7563 cd ekl=facont_hb(kk,k)
7565 cd write (iout,*)'Contacts have occurred for peptide groups',
7566 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7568 C Contribution from the graph I.
7569 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7570 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7571 call transpose2(EUg(1,1,k),auxmat(1,1))
7572 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7573 vv(1)=pizda(1,1)-pizda(2,2)
7574 vv(2)=pizda(1,2)+pizda(2,1)
7575 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7576 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7577 C Explicit gradient in virtual-dihedral angles.
7578 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7579 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7580 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7581 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7582 call matmat2(AEA(1,1,1),auxmat1(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(AEAb2(1,1,1),Ub2der(1,k))
7587 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7588 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7589 vv(1)=pizda(1,1)-pizda(2,2)
7590 vv(2)=pizda(1,2)+pizda(2,1)
7592 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7593 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7594 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7596 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7597 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7598 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7600 C Cartesian gradient
7604 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7606 vv(1)=pizda(1,1)-pizda(2,2)
7607 vv(2)=pizda(1,2)+pizda(2,1)
7608 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7609 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7610 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7616 C Contribution from graph II
7617 call transpose2(EE(1,1,itk),auxmat(1,1))
7618 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7619 vv(1)=pizda(1,1)+pizda(2,2)
7620 vv(2)=pizda(2,1)-pizda(1,2)
7621 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7622 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7623 C Explicit gradient in virtual-dihedral angles.
7624 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7625 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7626 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7630 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7631 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7632 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7634 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7635 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7636 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7638 C Cartesian gradient
7642 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7644 vv(1)=pizda(1,1)+pizda(2,2)
7645 vv(2)=pizda(2,1)-pizda(1,2)
7646 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7647 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7648 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7656 C Parallel orientation
7657 C Contribution from graph III
7658 call transpose2(EUg(1,1,l),auxmat(1,1))
7659 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7660 vv(1)=pizda(1,1)-pizda(2,2)
7661 vv(2)=pizda(1,2)+pizda(2,1)
7662 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7663 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7664 C Explicit gradient in virtual-dihedral angles.
7665 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7666 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7667 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7668 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7669 vv(1)=pizda(1,1)-pizda(2,2)
7670 vv(2)=pizda(1,2)+pizda(2,1)
7671 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7672 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7673 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7674 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7675 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7676 vv(1)=pizda(1,1)-pizda(2,2)
7677 vv(2)=pizda(1,2)+pizda(2,1)
7678 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7679 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7680 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7681 C Cartesian gradient
7685 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7689 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7690 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7696 C Contribution from graph IV
7698 call transpose2(EE(1,1,itl),auxmat(1,1))
7699 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7700 vv(1)=pizda(1,1)+pizda(2,2)
7701 vv(2)=pizda(2,1)-pizda(1,2)
7702 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7703 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7704 C Explicit gradient in virtual-dihedral angles.
7705 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7706 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7707 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7708 vv(1)=pizda(1,1)+pizda(2,2)
7709 vv(2)=pizda(2,1)-pizda(1,2)
7710 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7711 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7712 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7713 C Cartesian gradient
7717 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7719 vv(1)=pizda(1,1)+pizda(2,2)
7720 vv(2)=pizda(2,1)-pizda(1,2)
7721 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7722 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7723 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7728 C Antiparallel orientation
7729 C Contribution from graph III
7731 call transpose2(EUg(1,1,j),auxmat(1,1))
7732 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7733 vv(1)=pizda(1,1)-pizda(2,2)
7734 vv(2)=pizda(1,2)+pizda(2,1)
7735 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7736 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7737 C Explicit gradient in virtual-dihedral angles.
7738 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7739 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7740 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7741 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7742 vv(1)=pizda(1,1)-pizda(2,2)
7743 vv(2)=pizda(1,2)+pizda(2,1)
7744 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7745 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7746 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7747 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7748 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7749 vv(1)=pizda(1,1)-pizda(2,2)
7750 vv(2)=pizda(1,2)+pizda(2,1)
7751 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7752 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7753 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7754 C Cartesian gradient
7758 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7760 vv(1)=pizda(1,1)-pizda(2,2)
7761 vv(2)=pizda(1,2)+pizda(2,1)
7762 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7763 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7764 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7769 C Contribution from graph IV
7771 call transpose2(EE(1,1,itj),auxmat(1,1))
7772 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7773 vv(1)=pizda(1,1)+pizda(2,2)
7774 vv(2)=pizda(2,1)-pizda(1,2)
7775 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7776 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7777 C Explicit gradient in virtual-dihedral angles.
7778 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7779 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7780 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7781 vv(1)=pizda(1,1)+pizda(2,2)
7782 vv(2)=pizda(2,1)-pizda(1,2)
7783 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7784 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7785 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7786 C Cartesian gradient
7790 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7792 vv(1)=pizda(1,1)+pizda(2,2)
7793 vv(2)=pizda(2,1)-pizda(1,2)
7794 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7795 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7796 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7802 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7803 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7804 cd write (2,*) 'ijkl',i,j,k,l
7805 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7806 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7808 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7809 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7810 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7811 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7812 if (j.lt.nres-1) then
7819 if (l.lt.nres-1) then
7829 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7830 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7831 C summed up outside the subrouine as for the other subroutines
7832 C handling long-range interactions. The old code is commented out
7833 C with "cgrad" to keep track of changes.
7835 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7836 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7837 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7838 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7839 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7840 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7841 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7842 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7843 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7844 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7846 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7847 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7848 cgrad ghalf=0.5d0*ggg1(ll)
7850 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7851 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7852 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7853 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7854 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7855 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7856 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7857 cgrad ghalf=0.5d0*ggg2(ll)
7859 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7860 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7861 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7862 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7863 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7864 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7869 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7870 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7875 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7876 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7882 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7887 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7891 cd write (2,*) iii,g_corr5_loc(iii)
7894 cd write (2,*) 'ekont',ekont
7895 cd write (iout,*) 'eello5',ekont*eel5
7898 c--------------------------------------------------------------------------
7899 double precision function eello6(i,j,k,l,jj,kk)
7900 implicit real*8 (a-h,o-z)
7901 include 'DIMENSIONS'
7902 include 'COMMON.IOUNITS'
7903 include 'COMMON.CHAIN'
7904 include 'COMMON.DERIV'
7905 include 'COMMON.INTERACT'
7906 include 'COMMON.CONTACTS'
7907 include 'COMMON.TORSION'
7908 include 'COMMON.VAR'
7909 include 'COMMON.GEO'
7910 include 'COMMON.FFIELD'
7911 double precision ggg1(3),ggg2(3)
7912 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7917 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7925 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7926 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7930 derx(lll,kkk,iii)=0.0d0
7934 cd eij=facont_hb(jj,i)
7935 cd ekl=facont_hb(kk,k)
7941 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7942 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7943 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7944 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7945 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7946 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7948 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7949 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7950 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7951 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7952 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7953 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7957 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7959 C If turn contributions are considered, they will be handled separately.
7960 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7961 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7962 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7963 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7964 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7965 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7966 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7968 if (j.lt.nres-1) then
7975 if (l.lt.nres-1) then
7983 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7984 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7985 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7986 cgrad ghalf=0.5d0*ggg1(ll)
7988 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7989 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7990 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7991 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7992 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7993 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7994 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7995 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7996 cgrad ghalf=0.5d0*ggg2(ll)
7997 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7999 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8000 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8001 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8002 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8003 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8004 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8009 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8010 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8015 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8016 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8022 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8027 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8031 cd write (2,*) iii,g_corr6_loc(iii)
8034 cd write (2,*) 'ekont',ekont
8035 cd write (iout,*) 'eello6',ekont*eel6
8038 c--------------------------------------------------------------------------
8039 double precision function eello6_graph1(i,j,k,l,imat,swap)
8040 implicit real*8 (a-h,o-z)
8041 include 'DIMENSIONS'
8042 include 'COMMON.IOUNITS'
8043 include 'COMMON.CHAIN'
8044 include 'COMMON.DERIV'
8045 include 'COMMON.INTERACT'
8046 include 'COMMON.CONTACTS'
8047 include 'COMMON.TORSION'
8048 include 'COMMON.VAR'
8049 include 'COMMON.GEO'
8050 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8054 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8056 C Parallel Antiparallel C
8062 C \ j|/k\| / \ |/k\|l / C
8067 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8068 itk=itortyp(itype(k))
8069 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8070 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8071 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8072 call transpose2(EUgC(1,1,k),auxmat(1,1))
8073 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8074 vv1(1)=pizda1(1,1)-pizda1(2,2)
8075 vv1(2)=pizda1(1,2)+pizda1(2,1)
8076 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8077 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8078 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8079 s5=scalar2(vv(1),Dtobr2(1,i))
8080 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8081 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8082 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8083 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8084 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8085 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8086 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8087 & +scalar2(vv(1),Dtobr2der(1,i)))
8088 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8089 vv1(1)=pizda1(1,1)-pizda1(2,2)
8090 vv1(2)=pizda1(1,2)+pizda1(2,1)
8091 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8092 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8094 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8095 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8096 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8097 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8098 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8100 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8101 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8102 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8103 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8104 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8106 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8107 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8108 vv1(1)=pizda1(1,1)-pizda1(2,2)
8109 vv1(2)=pizda1(1,2)+pizda1(2,1)
8110 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8111 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8112 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8113 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8122 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8123 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8124 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8125 call transpose2(EUgC(1,1,k),auxmat(1,1))
8126 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8128 vv1(1)=pizda1(1,1)-pizda1(2,2)
8129 vv1(2)=pizda1(1,2)+pizda1(2,1)
8130 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8131 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8132 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8133 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8134 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8135 s5=scalar2(vv(1),Dtobr2(1,i))
8136 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8142 c----------------------------------------------------------------------------
8143 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8144 implicit real*8 (a-h,o-z)
8145 include 'DIMENSIONS'
8146 include 'COMMON.IOUNITS'
8147 include 'COMMON.CHAIN'
8148 include 'COMMON.DERIV'
8149 include 'COMMON.INTERACT'
8150 include 'COMMON.CONTACTS'
8151 include 'COMMON.TORSION'
8152 include 'COMMON.VAR'
8153 include 'COMMON.GEO'
8155 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8156 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8159 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8161 C Parallel Antiparallel C
8167 C \ j|/k\| \ |/k\|l C
8172 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8173 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8174 C AL 7/4/01 s1 would occur in the sixth-order moment,
8175 C but not in a cluster cumulant
8177 s1=dip(1,jj,i)*dip(1,kk,k)
8179 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8180 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8181 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8182 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8183 call transpose2(EUg(1,1,k),auxmat(1,1))
8184 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8185 vv(1)=pizda(1,1)-pizda(2,2)
8186 vv(2)=pizda(1,2)+pizda(2,1)
8187 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8188 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8190 eello6_graph2=-(s1+s2+s3+s4)
8192 eello6_graph2=-(s2+s3+s4)
8195 C Derivatives in gamma(i-1)
8198 s1=dipderg(1,jj,i)*dip(1,kk,k)
8200 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8201 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8202 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8203 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8205 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8207 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8209 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8211 C Derivatives in gamma(k-1)
8213 s1=dip(1,jj,i)*dipderg(1,kk,k)
8215 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8216 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8217 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8218 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8219 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8220 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8221 vv(1)=pizda(1,1)-pizda(2,2)
8222 vv(2)=pizda(1,2)+pizda(2,1)
8223 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8225 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8227 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8229 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8230 C Derivatives in gamma(j-1) or gamma(l-1)
8233 s1=dipderg(3,jj,i)*dip(1,kk,k)
8235 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8236 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8237 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8238 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8239 vv(1)=pizda(1,1)-pizda(2,2)
8240 vv(2)=pizda(1,2)+pizda(2,1)
8241 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8244 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8246 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8249 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8250 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8252 C Derivatives in gamma(l-1) or gamma(j-1)
8255 s1=dip(1,jj,i)*dipderg(3,kk,k)
8257 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8258 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8259 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8260 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8261 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8262 vv(1)=pizda(1,1)-pizda(2,2)
8263 vv(2)=pizda(1,2)+pizda(2,1)
8264 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8267 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8269 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8272 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8273 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8275 C Cartesian derivatives.
8277 write (2,*) 'In eello6_graph2'
8279 write (2,*) 'iii=',iii
8281 write (2,*) 'kkk=',kkk
8283 write (2,'(3(2f10.5),5x)')
8284 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8294 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8296 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8299 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8301 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8302 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8304 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8305 call transpose2(EUg(1,1,k),auxmat(1,1))
8306 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8308 vv(1)=pizda(1,1)-pizda(2,2)
8309 vv(2)=pizda(1,2)+pizda(2,1)
8310 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8311 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8313 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8315 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8318 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8320 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8327 c----------------------------------------------------------------------------
8328 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8329 implicit real*8 (a-h,o-z)
8330 include 'DIMENSIONS'
8331 include 'COMMON.IOUNITS'
8332 include 'COMMON.CHAIN'
8333 include 'COMMON.DERIV'
8334 include 'COMMON.INTERACT'
8335 include 'COMMON.CONTACTS'
8336 include 'COMMON.TORSION'
8337 include 'COMMON.VAR'
8338 include 'COMMON.GEO'
8339 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8341 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8343 C Parallel Antiparallel C
8349 C j|/k\| / |/k\|l / C
8354 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8356 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8357 C energy moment and not to the cluster cumulant.
8358 iti=itortyp(itype(i))
8359 if (j.lt.nres-1) then
8360 itj1=itortyp(itype(j+1))
8364 itk=itortyp(itype(k))
8365 itk1=itortyp(itype(k+1))
8366 if (l.lt.nres-1) then
8367 itl1=itortyp(itype(l+1))
8372 s1=dip(4,jj,i)*dip(4,kk,k)
8374 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8375 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8376 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8377 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8378 call transpose2(EE(1,1,itk),auxmat(1,1))
8379 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8380 vv(1)=pizda(1,1)+pizda(2,2)
8381 vv(2)=pizda(2,1)-pizda(1,2)
8382 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8383 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8384 cd & "sum",-(s2+s3+s4)
8386 eello6_graph3=-(s1+s2+s3+s4)
8388 eello6_graph3=-(s2+s3+s4)
8391 C Derivatives in gamma(k-1)
8392 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8393 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8394 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8395 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8396 C Derivatives in gamma(l-1)
8397 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8398 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8399 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8400 vv(1)=pizda(1,1)+pizda(2,2)
8401 vv(2)=pizda(2,1)-pizda(1,2)
8402 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8403 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8404 C Cartesian derivatives.
8410 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8412 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8415 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8417 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8418 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8420 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8421 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8423 vv(1)=pizda(1,1)+pizda(2,2)
8424 vv(2)=pizda(2,1)-pizda(1,2)
8425 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8427 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8429 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8432 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8434 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8436 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8442 c----------------------------------------------------------------------------
8443 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8444 implicit real*8 (a-h,o-z)
8445 include 'DIMENSIONS'
8446 include 'COMMON.IOUNITS'
8447 include 'COMMON.CHAIN'
8448 include 'COMMON.DERIV'
8449 include 'COMMON.INTERACT'
8450 include 'COMMON.CONTACTS'
8451 include 'COMMON.TORSION'
8452 include 'COMMON.VAR'
8453 include 'COMMON.GEO'
8454 include 'COMMON.FFIELD'
8455 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8456 & auxvec1(2),auxmat1(2,2)
8458 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8460 C Parallel Antiparallel C
8466 C \ j|/k\| \ |/k\|l C
8471 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8473 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8474 C energy moment and not to the cluster cumulant.
8475 cd write (2,*) 'eello_graph4: wturn6',wturn6
8476 iti=itortyp(itype(i))
8477 itj=itortyp(itype(j))
8478 if (j.lt.nres-1) then
8479 itj1=itortyp(itype(j+1))
8483 itk=itortyp(itype(k))
8484 if (k.lt.nres-1) then
8485 itk1=itortyp(itype(k+1))
8489 itl=itortyp(itype(l))
8490 if (l.lt.nres-1) then
8491 itl1=itortyp(itype(l+1))
8495 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8496 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8497 cd & ' itl',itl,' itl1',itl1
8500 s1=dip(3,jj,i)*dip(3,kk,k)
8502 s1=dip(2,jj,j)*dip(2,kk,l)
8505 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8506 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8508 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8509 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8511 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8512 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8514 call transpose2(EUg(1,1,k),auxmat(1,1))
8515 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8516 vv(1)=pizda(1,1)-pizda(2,2)
8517 vv(2)=pizda(2,1)+pizda(1,2)
8518 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8519 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8521 eello6_graph4=-(s1+s2+s3+s4)
8523 eello6_graph4=-(s2+s3+s4)
8525 C Derivatives in gamma(i-1)
8529 s1=dipderg(2,jj,i)*dip(3,kk,k)
8531 s1=dipderg(4,jj,j)*dip(2,kk,l)
8534 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8536 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8537 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8539 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8540 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8542 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8543 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8544 cd write (2,*) 'turn6 derivatives'
8546 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8548 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8552 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8554 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8558 C Derivatives in gamma(k-1)
8561 s1=dip(3,jj,i)*dipderg(2,kk,k)
8563 s1=dip(2,jj,j)*dipderg(4,kk,l)
8566 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8567 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8569 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8570 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8572 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8573 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8575 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8576 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8577 vv(1)=pizda(1,1)-pizda(2,2)
8578 vv(2)=pizda(2,1)+pizda(1,2)
8579 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8580 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8582 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8584 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8588 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8590 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8593 C Derivatives in gamma(j-1) or gamma(l-1)
8594 if (l.eq.j+1 .and. l.gt.1) then
8595 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8596 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8597 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8598 vv(1)=pizda(1,1)-pizda(2,2)
8599 vv(2)=pizda(2,1)+pizda(1,2)
8600 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8601 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8602 else if (j.gt.1) then
8603 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8604 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8605 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8606 vv(1)=pizda(1,1)-pizda(2,2)
8607 vv(2)=pizda(2,1)+pizda(1,2)
8608 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8609 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8610 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8612 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8615 C Cartesian derivatives.
8622 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8624 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8628 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8630 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8634 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8636 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8638 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8639 & b1(1,j+1),auxvec(1))
8640 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8642 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8643 & b1(1,l+1),auxvec(1))
8644 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8646 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8648 vv(1)=pizda(1,1)-pizda(2,2)
8649 vv(2)=pizda(2,1)+pizda(1,2)
8650 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8652 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8654 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8657 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8660 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8663 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8665 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8667 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8671 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8673 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8676 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8678 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8686 c----------------------------------------------------------------------------
8687 double precision function eello_turn6(i,jj,kk)
8688 implicit real*8 (a-h,o-z)
8689 include 'DIMENSIONS'
8690 include 'COMMON.IOUNITS'
8691 include 'COMMON.CHAIN'
8692 include 'COMMON.DERIV'
8693 include 'COMMON.INTERACT'
8694 include 'COMMON.CONTACTS'
8695 include 'COMMON.TORSION'
8696 include 'COMMON.VAR'
8697 include 'COMMON.GEO'
8698 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8699 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8701 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8702 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8703 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8704 C the respective energy moment and not to the cluster cumulant.
8713 iti=itortyp(itype(i))
8714 itk=itortyp(itype(k))
8715 itk1=itortyp(itype(k+1))
8716 itl=itortyp(itype(l))
8717 itj=itortyp(itype(j))
8718 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8719 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8720 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8725 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8727 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8731 derx_turn(lll,kkk,iii)=0.0d0
8738 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8740 cd write (2,*) 'eello6_5',eello6_5
8742 call transpose2(AEA(1,1,1),auxmat(1,1))
8743 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8744 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8745 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8747 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8748 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8749 s2 = scalar2(b1(1,k),vtemp1(1))
8751 call transpose2(AEA(1,1,2),atemp(1,1))
8752 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8753 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8754 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8756 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8757 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8758 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8760 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8761 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8762 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8763 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8764 ss13 = scalar2(b1(1,k),vtemp4(1))
8765 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8767 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8773 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8774 C Derivatives in gamma(i+2)
8778 call transpose2(AEA(1,1,1),auxmatd(1,1))
8779 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8780 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8781 call transpose2(AEAderg(1,1,2),atempd(1,1))
8782 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8783 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8785 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8786 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8787 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8793 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8794 C Derivatives in gamma(i+3)
8796 call transpose2(AEA(1,1,1),auxmatd(1,1))
8797 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8798 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8799 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8801 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8802 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8803 s2d = scalar2(b1(1,k),vtemp1d(1))
8805 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8806 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8808 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8810 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8811 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8812 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8820 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8821 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8823 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8824 & -0.5d0*ekont*(s2d+s12d)
8826 C Derivatives in gamma(i+4)
8827 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8828 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8829 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8831 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8832 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8833 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8841 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8843 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8845 C Derivatives in gamma(i+5)
8847 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8848 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8849 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8851 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8852 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8853 s2d = scalar2(b1(1,k),vtemp1d(1))
8855 call transpose2(AEA(1,1,2),atempd(1,1))
8856 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8857 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8859 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8860 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8862 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8863 ss13d = scalar2(b1(1,k),vtemp4d(1))
8864 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8872 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8873 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8875 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8876 & -0.5d0*ekont*(s2d+s12d)
8878 C Cartesian derivatives
8883 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8884 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8885 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8887 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8888 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8890 s2d = scalar2(b1(1,k),vtemp1d(1))
8892 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8893 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8894 s8d = -(atempd(1,1)+atempd(2,2))*
8895 & scalar2(cc(1,1,itl),vtemp2(1))
8897 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8899 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8900 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8907 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8910 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8914 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8915 & - 0.5d0*(s8d+s12d)
8917 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8926 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8928 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8929 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8930 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8931 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8932 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8934 ss13d = scalar2(b1(1,k),vtemp4d(1))
8935 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8936 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8940 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8941 cd & 16*eel_turn6_num
8943 if (j.lt.nres-1) then
8950 if (l.lt.nres-1) then
8958 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8959 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8960 cgrad ghalf=0.5d0*ggg1(ll)
8962 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8963 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8964 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8965 & +ekont*derx_turn(ll,2,1)
8966 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8967 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8968 & +ekont*derx_turn(ll,4,1)
8969 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8970 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8971 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8972 cgrad ghalf=0.5d0*ggg2(ll)
8974 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8975 & +ekont*derx_turn(ll,2,2)
8976 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8977 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8978 & +ekont*derx_turn(ll,4,2)
8979 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8980 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8981 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8986 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8991 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8997 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9002 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9006 cd write (2,*) iii,g_corr6_loc(iii)
9008 eello_turn6=ekont*eel_turn6
9009 cd write (2,*) 'ekont',ekont
9010 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9014 C-----------------------------------------------------------------------------
9015 double precision function scalar(u,v)
9016 !DIR$ INLINEALWAYS scalar
9018 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9021 double precision u(3),v(3)
9022 cd double precision sc
9030 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9033 crc-------------------------------------------------
9034 SUBROUTINE MATVEC2(A1,V1,V2)
9035 !DIR$ INLINEALWAYS MATVEC2
9037 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9039 implicit real*8 (a-h,o-z)
9040 include 'DIMENSIONS'
9041 DIMENSION A1(2,2),V1(2),V2(2)
9045 c 3 VI=VI+A1(I,K)*V1(K)
9049 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9050 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9055 C---------------------------------------
9056 SUBROUTINE MATMAT2(A1,A2,A3)
9058 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9060 implicit real*8 (a-h,o-z)
9061 include 'DIMENSIONS'
9062 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9063 c DIMENSION AI3(2,2)
9067 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9073 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9074 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9075 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9076 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9084 c-------------------------------------------------------------------------
9085 double precision function scalar2(u,v)
9086 !DIR$ INLINEALWAYS scalar2
9088 double precision u(2),v(2)
9091 scalar2=u(1)*v(1)+u(2)*v(2)
9095 C-----------------------------------------------------------------------------
9097 subroutine transpose2(a,at)
9098 !DIR$ INLINEALWAYS transpose2
9100 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9103 double precision a(2,2),at(2,2)
9110 c--------------------------------------------------------------------------
9111 subroutine transpose(n,a,at)
9114 double precision a(n,n),at(n,n)
9122 C---------------------------------------------------------------------------
9123 subroutine prodmat3(a1,a2,kk,transp,prod)
9124 !DIR$ INLINEALWAYS prodmat3
9126 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9130 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9132 crc double precision auxmat(2,2),prod_(2,2)
9135 crc call transpose2(kk(1,1),auxmat(1,1))
9136 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9137 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9139 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9140 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9141 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9142 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9143 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9144 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9145 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9146 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9149 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9150 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9152 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9153 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9154 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9155 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9156 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9157 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9158 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9159 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9162 c call transpose2(a2(1,1),a2t(1,1))
9165 crc print *,((prod_(i,j),i=1,2),j=1,2)
9166 crc print *,((prod(i,j),i=1,2),j=1,2)