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)
2300 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2301 EE(1,2,i-2)=eeold(1,2,iti)
2302 EE(2,1,i-2)=eeold(2,1,iti)
2303 EE(2,2,i-2)=eeold(2,2,iti)
2304 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2309 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2310 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2311 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2312 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2313 b1tilde(1,i-2)=b1(1,i-2)
2314 b1tilde(2,i-2)=-b1(2,i-2)
2315 b2tilde(1,i-2)=b2(1,i-2)
2316 b2tilde(2,i-2)=-b2(2,i-2)
2317 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2318 c write(iout,*) 'b1=',b1(1,i-2)
2319 c write (iout,*) 'theta=', theta(i-1)
2322 do i=ivec_start+2,ivec_end+2
2327 if (i .lt. nres+1) then
2364 if (i .gt. 3 .and. i .lt. nres+1) then
2365 obrot_der(1,i-2)=-sin1
2366 obrot_der(2,i-2)= cos1
2367 Ugder(1,1,i-2)= sin1
2368 Ugder(1,2,i-2)=-cos1
2369 Ugder(2,1,i-2)=-cos1
2370 Ugder(2,2,i-2)=-sin1
2373 obrot2_der(1,i-2)=-dwasin2
2374 obrot2_der(2,i-2)= dwacos2
2375 Ug2der(1,1,i-2)= dwasin2
2376 Ug2der(1,2,i-2)=-dwacos2
2377 Ug2der(2,1,i-2)=-dwacos2
2378 Ug2der(2,2,i-2)=-dwasin2
2380 obrot_der(1,i-2)=0.0d0
2381 obrot_der(2,i-2)=0.0d0
2382 Ugder(1,1,i-2)=0.0d0
2383 Ugder(1,2,i-2)=0.0d0
2384 Ugder(2,1,i-2)=0.0d0
2385 Ugder(2,2,i-2)=0.0d0
2386 obrot2_der(1,i-2)=0.0d0
2387 obrot2_der(2,i-2)=0.0d0
2388 Ug2der(1,1,i-2)=0.0d0
2389 Ug2der(1,2,i-2)=0.0d0
2390 Ug2der(2,1,i-2)=0.0d0
2391 Ug2der(2,2,i-2)=0.0d0
2393 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2394 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2395 iti = itortyp(itype(i-2))
2399 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2400 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2401 iti1 = itortyp(itype(i-1))
2405 cd write (iout,*) '*******i',i,' iti1',iti
2406 cd write (iout,*) 'b1',b1(:,iti)
2407 cd write (iout,*) 'b2',b2(:,iti)
2408 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2409 c if (i .gt. iatel_s+2) then
2410 if (i .gt. nnt+2) then
2411 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2413 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2414 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2416 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2417 c & EE(1,2,iti),EE(2,2,iti)
2418 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2419 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2420 c write(iout,*) "Macierz EUG",
2421 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2423 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2425 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2426 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2427 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2428 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2429 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2440 DtUg2(l,k,i-2)=0.0d0
2444 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2445 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2447 muder(k,i-2)=Ub2der(k,i-2)
2449 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2450 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2451 if (itype(i-1).le.ntyp) then
2452 iti1 = itortyp(itype(i-1))
2460 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2462 c write (iout,*) 'mu ',mu(:,i-2),i-2
2463 cd write (iout,*) 'mu1',mu1(:,i-2)
2464 cd write (iout,*) 'mu2',mu2(:,i-2)
2465 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2467 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2468 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2469 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2470 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2471 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2472 C Vectors and matrices dependent on a single virtual-bond dihedral.
2473 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2474 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2475 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2476 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2477 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2478 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2479 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2480 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2481 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2484 C Matrices dependent on two consecutive virtual-bond dihedrals.
2485 C The order of matrices is from left to right.
2486 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2488 c do i=max0(ivec_start,2),ivec_end
2490 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2491 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2492 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2493 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2494 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2495 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2496 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2497 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2500 #if defined(MPI) && defined(PARMAT)
2502 c if (fg_rank.eq.0) then
2503 write (iout,*) "Arrays UG and UGDER before GATHER"
2505 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2506 & ((ug(l,k,i),l=1,2),k=1,2),
2507 & ((ugder(l,k,i),l=1,2),k=1,2)
2509 write (iout,*) "Arrays UG2 and UG2DER"
2511 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2512 & ((ug2(l,k,i),l=1,2),k=1,2),
2513 & ((ug2der(l,k,i),l=1,2),k=1,2)
2515 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2517 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2518 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2519 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2521 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2523 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2524 & costab(i),sintab(i),costab2(i),sintab2(i)
2526 write (iout,*) "Array MUDER"
2528 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2532 if (nfgtasks.gt.1) then
2534 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2535 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2536 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2538 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2539 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2541 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2542 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2544 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2545 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2547 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2548 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2550 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2551 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2553 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2554 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2556 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2557 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2558 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2559 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2560 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2561 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2562 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2563 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2564 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2565 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2566 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2567 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2568 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2570 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2571 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2573 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2574 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2576 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2577 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2579 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2580 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2582 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2583 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2585 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2586 & ivec_count(fg_rank1),
2587 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2589 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2592 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2593 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2595 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2596 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2598 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2599 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2601 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2602 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2604 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2605 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2607 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2608 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2610 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2611 & ivec_count(fg_rank1),
2612 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2614 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2615 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2617 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2618 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2620 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2621 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2623 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2624 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2626 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2627 & ivec_count(fg_rank1),
2628 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2630 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2631 & ivec_count(fg_rank1),
2632 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2634 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2635 & ivec_count(fg_rank1),
2636 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2637 & MPI_MAT2,FG_COMM1,IERR)
2638 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2639 & ivec_count(fg_rank1),
2640 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2641 & MPI_MAT2,FG_COMM1,IERR)
2644 c Passes matrix info through the ring
2647 if (irecv.lt.0) irecv=nfgtasks1-1
2650 if (inext.ge.nfgtasks1) inext=0
2652 c write (iout,*) "isend",isend," irecv",irecv
2654 lensend=lentyp(isend)
2655 lenrecv=lentyp(irecv)
2656 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2657 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2658 c & MPI_ROTAT1(lensend),inext,2200+isend,
2659 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2660 c & iprev,2200+irecv,FG_COMM,status,IERR)
2661 c write (iout,*) "Gather ROTAT1"
2663 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2664 c & MPI_ROTAT2(lensend),inext,3300+isend,
2665 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2666 c & iprev,3300+irecv,FG_COMM,status,IERR)
2667 c write (iout,*) "Gather ROTAT2"
2669 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2670 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2671 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2672 & iprev,4400+irecv,FG_COMM,status,IERR)
2673 c write (iout,*) "Gather ROTAT_OLD"
2675 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2676 & MPI_PRECOMP11(lensend),inext,5500+isend,
2677 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2678 & iprev,5500+irecv,FG_COMM,status,IERR)
2679 c write (iout,*) "Gather PRECOMP11"
2681 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2682 & MPI_PRECOMP12(lensend),inext,6600+isend,
2683 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2684 & iprev,6600+irecv,FG_COMM,status,IERR)
2685 c write (iout,*) "Gather PRECOMP12"
2687 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2689 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2690 & MPI_ROTAT2(lensend),inext,7700+isend,
2691 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2692 & iprev,7700+irecv,FG_COMM,status,IERR)
2693 c write (iout,*) "Gather PRECOMP21"
2695 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2696 & MPI_PRECOMP22(lensend),inext,8800+isend,
2697 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2698 & iprev,8800+irecv,FG_COMM,status,IERR)
2699 c write (iout,*) "Gather PRECOMP22"
2701 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2702 & MPI_PRECOMP23(lensend),inext,9900+isend,
2703 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2704 & MPI_PRECOMP23(lenrecv),
2705 & iprev,9900+irecv,FG_COMM,status,IERR)
2706 c write (iout,*) "Gather PRECOMP23"
2711 if (irecv.lt.0) irecv=nfgtasks1-1
2714 time_gather=time_gather+MPI_Wtime()-time00
2717 c if (fg_rank.eq.0) then
2718 write (iout,*) "Arrays UG and UGDER"
2720 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2721 & ((ug(l,k,i),l=1,2),k=1,2),
2722 & ((ugder(l,k,i),l=1,2),k=1,2)
2724 write (iout,*) "Arrays UG2 and UG2DER"
2726 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2727 & ((ug2(l,k,i),l=1,2),k=1,2),
2728 & ((ug2der(l,k,i),l=1,2),k=1,2)
2730 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2732 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2733 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2734 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2736 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2738 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2739 & costab(i),sintab(i),costab2(i),sintab2(i)
2741 write (iout,*) "Array MUDER"
2743 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2749 cd iti = itortyp(itype(i))
2752 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2753 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2758 C--------------------------------------------------------------------------
2759 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2761 C This subroutine calculates the average interaction energy and its gradient
2762 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2763 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2764 C The potential depends both on the distance of peptide-group centers and on
2765 C the orientation of the CA-CA virtual bonds.
2767 implicit real*8 (a-h,o-z)
2771 include 'DIMENSIONS'
2772 include 'COMMON.CONTROL'
2773 include 'COMMON.SETUP'
2774 include 'COMMON.IOUNITS'
2775 include 'COMMON.GEO'
2776 include 'COMMON.VAR'
2777 include 'COMMON.LOCAL'
2778 include 'COMMON.CHAIN'
2779 include 'COMMON.DERIV'
2780 include 'COMMON.INTERACT'
2781 include 'COMMON.CONTACTS'
2782 include 'COMMON.TORSION'
2783 include 'COMMON.VECTORS'
2784 include 'COMMON.FFIELD'
2785 include 'COMMON.TIME1'
2786 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2787 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2788 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2789 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2790 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2791 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2793 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2795 double precision scal_el /1.0d0/
2797 double precision scal_el /0.5d0/
2800 C 13-go grudnia roku pamietnego...
2801 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2802 & 0.0d0,1.0d0,0.0d0,
2803 & 0.0d0,0.0d0,1.0d0/
2804 cd write(iout,*) 'In EELEC'
2806 cd write(iout,*) 'Type',i
2807 cd write(iout,*) 'B1',B1(:,i)
2808 cd write(iout,*) 'B2',B2(:,i)
2809 cd write(iout,*) 'CC',CC(:,:,i)
2810 cd write(iout,*) 'DD',DD(:,:,i)
2811 cd write(iout,*) 'EE',EE(:,:,i)
2813 cd call check_vecgrad
2815 if (icheckgrad.eq.1) then
2817 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2819 dc_norm(k,i)=dc(k,i)*fac
2821 c write (iout,*) 'i',i,' fac',fac
2824 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2825 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2826 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2827 c call vec_and_deriv
2833 time_mat=time_mat+MPI_Wtime()-time01
2837 cd write (iout,*) 'i=',i
2839 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2842 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2843 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2856 cd print '(a)','Enter EELEC'
2857 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2859 gel_loc_loc(i)=0.0d0
2864 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2866 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2868 do i=iturn3_start,iturn3_end
2869 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2870 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2874 dx_normi=dc_norm(1,i)
2875 dy_normi=dc_norm(2,i)
2876 dz_normi=dc_norm(3,i)
2877 xmedi=c(1,i)+0.5d0*dxi
2878 ymedi=c(2,i)+0.5d0*dyi
2879 zmedi=c(3,i)+0.5d0*dzi
2881 call eelecij(i,i+2,ees,evdw1,eel_loc)
2882 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2883 num_cont_hb(i)=num_conti
2885 do i=iturn4_start,iturn4_end
2886 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2887 & .or. itype(i+3).eq.ntyp1
2888 & .or. itype(i+4).eq.ntyp1) cycle
2892 dx_normi=dc_norm(1,i)
2893 dy_normi=dc_norm(2,i)
2894 dz_normi=dc_norm(3,i)
2895 xmedi=c(1,i)+0.5d0*dxi
2896 ymedi=c(2,i)+0.5d0*dyi
2897 zmedi=c(3,i)+0.5d0*dzi
2898 num_conti=num_cont_hb(i)
2899 c write(iout,*) "JESTEM W PETLI"
2900 call eelecij(i,i+3,ees,evdw1,eel_loc)
2901 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2902 & call eturn4(i,eello_turn4)
2903 num_cont_hb(i)=num_conti
2906 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2908 do i=iatel_s,iatel_e
2910 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2914 dx_normi=dc_norm(1,i)
2915 dy_normi=dc_norm(2,i)
2916 dz_normi=dc_norm(3,i)
2917 xmedi=c(1,i)+0.5d0*dxi
2918 ymedi=c(2,i)+0.5d0*dyi
2919 zmedi=c(3,i)+0.5d0*dzi
2920 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2921 num_conti=num_cont_hb(i)
2922 do j=ielstart(i),ielend(i)
2924 c write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
2925 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2926 call eelecij(i,j,ees,evdw1,eel_loc)
2928 num_cont_hb(i)=num_conti
2930 c write (iout,*) "Number of loop steps in EELEC:",ind
2932 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2933 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2935 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2936 ccc eel_loc=eel_loc+eello_turn3
2937 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2940 C-------------------------------------------------------------------------------
2941 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2942 implicit real*8 (a-h,o-z)
2943 include 'DIMENSIONS'
2947 include 'COMMON.CONTROL'
2948 include 'COMMON.IOUNITS'
2949 include 'COMMON.GEO'
2950 include 'COMMON.VAR'
2951 include 'COMMON.LOCAL'
2952 include 'COMMON.CHAIN'
2953 include 'COMMON.DERIV'
2954 include 'COMMON.INTERACT'
2955 include 'COMMON.CONTACTS'
2956 include 'COMMON.TORSION'
2957 include 'COMMON.VECTORS'
2958 include 'COMMON.FFIELD'
2959 include 'COMMON.TIME1'
2960 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2961 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2962 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2963 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2964 & gmuij2(4),gmuji2(4)
2965 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2966 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2968 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2970 double precision scal_el /1.0d0/
2972 double precision scal_el /0.5d0/
2975 C 13-go grudnia roku pamietnego...
2976 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2977 & 0.0d0,1.0d0,0.0d0,
2978 & 0.0d0,0.0d0,1.0d0/
2979 c time00=MPI_Wtime()
2980 cd write (iout,*) "eelecij",i,j
2984 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2985 aaa=app(iteli,itelj)
2986 bbb=bpp(iteli,itelj)
2987 ael6i=ael6(iteli,itelj)
2988 ael3i=ael3(iteli,itelj)
2992 dx_normj=dc_norm(1,j)
2993 dy_normj=dc_norm(2,j)
2994 dz_normj=dc_norm(3,j)
2995 xj=c(1,j)+0.5D0*dxj-xmedi
2996 yj=c(2,j)+0.5D0*dyj-ymedi
2997 zj=c(3,j)+0.5D0*dzj-zmedi
2998 rij=xj*xj+yj*yj+zj*zj
3004 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3005 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3006 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3007 fac=cosa-3.0D0*cosb*cosg
3009 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3010 if (j.eq.i+2) ev1=scal_el*ev1
3015 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3018 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3019 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3022 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3023 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3024 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3025 cd & xmedi,ymedi,zmedi,xj,yj,zj
3027 if (energy_dec) then
3028 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3030 &,iteli,itelj,aaa,evdw1
3031 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3035 C Calculate contributions to the Cartesian gradient.
3038 facvdw=-6*rrmij*(ev1+evdwij)
3039 facel=-3*rrmij*(el1+eesij)
3045 * Radial derivatives. First process both termini of the fragment (i,j)
3051 c ghalf=0.5D0*ggg(k)
3052 c gelc(k,i)=gelc(k,i)+ghalf
3053 c gelc(k,j)=gelc(k,j)+ghalf
3055 c 9/28/08 AL Gradient compotents will be summed only at the end
3057 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3058 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3061 * Loop over residues i+1 thru j-1.
3065 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3072 c ghalf=0.5D0*ggg(k)
3073 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3074 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3076 c 9/28/08 AL Gradient compotents will be summed only at the end
3078 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3079 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3082 * Loop over residues i+1 thru j-1.
3086 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3093 fac=-3*rrmij*(facvdw+facvdw+facel)
3098 * Radial derivatives. First process both termini of the fragment (i,j)
3104 c ghalf=0.5D0*ggg(k)
3105 c gelc(k,i)=gelc(k,i)+ghalf
3106 c gelc(k,j)=gelc(k,j)+ghalf
3108 c 9/28/08 AL Gradient compotents will be summed only at the end
3110 gelc_long(k,j)=gelc(k,j)+ggg(k)
3111 gelc_long(k,i)=gelc(k,i)-ggg(k)
3114 * Loop over residues i+1 thru j-1.
3118 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3121 c 9/28/08 AL Gradient compotents will be summed only at the end
3126 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3127 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3133 ecosa=2.0D0*fac3*fac1+fac4
3136 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3137 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3139 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3140 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3142 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3143 cd & (dcosg(k),k=1,3)
3145 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3148 c ghalf=0.5D0*ggg(k)
3149 c gelc(k,i)=gelc(k,i)+ghalf
3150 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3151 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3152 c gelc(k,j)=gelc(k,j)+ghalf
3153 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3154 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3158 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3163 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3164 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3166 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3167 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3168 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3169 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3171 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3172 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3173 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3175 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3176 C energy of a peptide unit is assumed in the form of a second-order
3177 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3178 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3179 C are computed for EVERY pair of non-contiguous peptide groups.
3182 if (j.lt.nres-1) then
3194 muij(kkk)=mu(k,i)*mu(l,j)
3195 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3197 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3198 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3199 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3200 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3201 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3202 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3206 cd write (iout,*) 'EELEC: i',i,' j',j
3207 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3208 cd write(iout,*) 'muij',muij
3209 ury=scalar(uy(1,i),erij)
3210 urz=scalar(uz(1,i),erij)
3211 vry=scalar(uy(1,j),erij)
3212 vrz=scalar(uz(1,j),erij)
3213 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3214 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3215 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3216 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3217 fac=dsqrt(-ael6i)*r3ij
3222 cd write (iout,'(4i5,4f10.5)')
3223 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3224 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3225 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3226 cd & uy(:,j),uz(:,j)
3227 cd write (iout,'(4f10.5)')
3228 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3229 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3230 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3231 cd write (iout,'(9f10.5/)')
3232 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3233 C Derivatives of the elements of A in virtual-bond vectors
3234 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3236 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3237 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3238 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3239 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3240 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3241 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3242 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3243 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3244 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3245 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3246 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3247 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3249 C Compute radial contributions to the gradient
3267 C Add the contributions coming from er
3270 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3271 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3272 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3273 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3276 C Derivatives in DC(i)
3277 cgrad ghalf1=0.5d0*agg(k,1)
3278 cgrad ghalf2=0.5d0*agg(k,2)
3279 cgrad ghalf3=0.5d0*agg(k,3)
3280 cgrad ghalf4=0.5d0*agg(k,4)
3281 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3282 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3283 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3284 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3285 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3286 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3287 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3288 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3289 C Derivatives in DC(i+1)
3290 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3291 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3292 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3293 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3294 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3295 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3296 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3297 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3298 C Derivatives in DC(j)
3299 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3300 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3301 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3302 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3303 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3304 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3305 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3306 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3307 C Derivatives in DC(j+1) or DC(nres-1)
3308 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3309 & -3.0d0*vryg(k,3)*ury)
3310 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3311 & -3.0d0*vrzg(k,3)*ury)
3312 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3313 & -3.0d0*vryg(k,3)*urz)
3314 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3315 & -3.0d0*vrzg(k,3)*urz)
3316 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3318 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3331 aggi(k,l)=-aggi(k,l)
3332 aggi1(k,l)=-aggi1(k,l)
3333 aggj(k,l)=-aggj(k,l)
3334 aggj1(k,l)=-aggj1(k,l)
3337 if (j.lt.nres-1) then
3343 aggi(k,l)=-aggi(k,l)
3344 aggi1(k,l)=-aggi1(k,l)
3345 aggj(k,l)=-aggj(k,l)
3346 aggj1(k,l)=-aggj1(k,l)
3357 aggi(k,l)=-aggi(k,l)
3358 aggi1(k,l)=-aggi1(k,l)
3359 aggj(k,l)=-aggj(k,l)
3360 aggj1(k,l)=-aggj1(k,l)
3365 IF (wel_loc.gt.0.0d0) THEN
3366 C Contribution to the local-electrostatic energy coming from the i-j pair
3367 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3369 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3370 C Calculate patrial derivative for theta angle
3372 geel_loc_ij=a22*gmuij1(1)
3376 c write(iout,*) "derivative over thatai"
3377 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3379 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3380 & geel_loc_ij*wel_loc
3381 c write(iout,*) "derivative over thatai-1"
3382 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3389 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3390 & geel_loc_ij*wel_loc
3391 c Derivative over j residue
3392 geel_loc_ji=a22*gmuji1(1)
3396 c write(iout,*) "derivative over thataj"
3397 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3400 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3401 & geel_loc_ji*wel_loc
3407 c write(iout,*) "derivative over thataj-1"
3408 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3410 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3411 & geel_loc_ji*wel_loc
3413 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3415 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3416 & 'eelloc',i,j,eel_loc_ij
3417 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3419 eel_loc=eel_loc+eel_loc_ij
3420 C Partial derivatives in virtual-bond dihedral angles gamma
3422 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3423 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3424 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3425 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3426 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3427 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3428 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3430 ggg(l)=agg(l,1)*muij(1)+
3431 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3432 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3433 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3434 cgrad ghalf=0.5d0*ggg(l)
3435 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3436 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3440 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3443 C Remaining derivatives of eello
3445 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3446 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3447 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3448 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3449 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3450 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3451 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3452 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3455 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3456 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3457 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3458 & .and. num_conti.le.maxconts) then
3459 c write (iout,*) i,j," entered corr"
3461 C Calculate the contact function. The ith column of the array JCONT will
3462 C contain the numbers of atoms that make contacts with the atom I (of numbers
3463 C greater than I). The arrays FACONT and GACONT will contain the values of
3464 C the contact function and its derivative.
3465 c r0ij=1.02D0*rpp(iteli,itelj)
3466 c r0ij=1.11D0*rpp(iteli,itelj)
3467 r0ij=2.20D0*rpp(iteli,itelj)
3468 c r0ij=1.55D0*rpp(iteli,itelj)
3469 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3470 if (fcont.gt.0.0D0) then
3471 num_conti=num_conti+1
3472 if (num_conti.gt.maxconts) then
3473 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3474 & ' will skip next contacts for this conf.'
3476 jcont_hb(num_conti,i)=j
3477 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3478 cd & " jcont_hb",jcont_hb(num_conti,i)
3479 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3480 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3481 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3483 d_cont(num_conti,i)=rij
3484 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3485 C --- Electrostatic-interaction matrix ---
3486 a_chuj(1,1,num_conti,i)=a22
3487 a_chuj(1,2,num_conti,i)=a23
3488 a_chuj(2,1,num_conti,i)=a32
3489 a_chuj(2,2,num_conti,i)=a33
3490 C --- Gradient of rij
3492 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3499 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3500 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3501 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3502 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3503 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3508 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3509 C Calculate contact energies
3511 wij=cosa-3.0D0*cosb*cosg
3514 c fac3=dsqrt(-ael6i)/r0ij**3
3515 fac3=dsqrt(-ael6i)*r3ij
3516 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3517 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3518 if (ees0tmp.gt.0) then
3519 ees0pij=dsqrt(ees0tmp)
3523 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3524 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3525 if (ees0tmp.gt.0) then
3526 ees0mij=dsqrt(ees0tmp)
3531 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3532 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3533 C Diagnostics. Comment out or remove after debugging!
3534 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3535 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3536 c ees0m(num_conti,i)=0.0D0
3538 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3539 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3540 C Angular derivatives of the contact function
3541 ees0pij1=fac3/ees0pij
3542 ees0mij1=fac3/ees0mij
3543 fac3p=-3.0D0*fac3*rrmij
3544 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3545 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3547 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3548 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3549 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3550 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3551 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3552 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3553 ecosap=ecosa1+ecosa2
3554 ecosbp=ecosb1+ecosb2
3555 ecosgp=ecosg1+ecosg2
3556 ecosam=ecosa1-ecosa2
3557 ecosbm=ecosb1-ecosb2
3558 ecosgm=ecosg1-ecosg2
3567 facont_hb(num_conti,i)=fcont
3568 fprimcont=fprimcont/rij
3569 cd facont_hb(num_conti,i)=1.0D0
3570 C Following line is for diagnostics.
3573 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3574 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3577 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3578 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3580 gggp(1)=gggp(1)+ees0pijp*xj
3581 gggp(2)=gggp(2)+ees0pijp*yj
3582 gggp(3)=gggp(3)+ees0pijp*zj
3583 gggm(1)=gggm(1)+ees0mijp*xj
3584 gggm(2)=gggm(2)+ees0mijp*yj
3585 gggm(3)=gggm(3)+ees0mijp*zj
3586 C Derivatives due to the contact function
3587 gacont_hbr(1,num_conti,i)=fprimcont*xj
3588 gacont_hbr(2,num_conti,i)=fprimcont*yj
3589 gacont_hbr(3,num_conti,i)=fprimcont*zj
3592 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3593 c following the change of gradient-summation algorithm.
3595 cgrad ghalfp=0.5D0*gggp(k)
3596 cgrad ghalfm=0.5D0*gggm(k)
3597 gacontp_hb1(k,num_conti,i)=!ghalfp
3598 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3599 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3600 gacontp_hb2(k,num_conti,i)=!ghalfp
3601 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3602 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3603 gacontp_hb3(k,num_conti,i)=gggp(k)
3604 gacontm_hb1(k,num_conti,i)=!ghalfm
3605 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3606 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3607 gacontm_hb2(k,num_conti,i)=!ghalfm
3608 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3609 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3610 gacontm_hb3(k,num_conti,i)=gggm(k)
3612 C Diagnostics. Comment out or remove after debugging!
3614 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3615 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3616 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3617 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3618 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3619 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3622 endif ! num_conti.le.maxconts
3625 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3628 ghalf=0.5d0*agg(l,k)
3629 aggi(l,k)=aggi(l,k)+ghalf
3630 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3631 aggj(l,k)=aggj(l,k)+ghalf
3634 if (j.eq.nres-1 .and. i.lt.j-2) then
3637 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3642 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3645 C-----------------------------------------------------------------------------
3646 subroutine eturn3(i,eello_turn3)
3647 C Third- and fourth-order contributions from turns
3648 implicit real*8 (a-h,o-z)
3649 include 'DIMENSIONS'
3650 include 'COMMON.IOUNITS'
3651 include 'COMMON.GEO'
3652 include 'COMMON.VAR'
3653 include 'COMMON.LOCAL'
3654 include 'COMMON.CHAIN'
3655 include 'COMMON.DERIV'
3656 include 'COMMON.INTERACT'
3657 include 'COMMON.CONTACTS'
3658 include 'COMMON.TORSION'
3659 include 'COMMON.VECTORS'
3660 include 'COMMON.FFIELD'
3661 include 'COMMON.CONTROL'
3663 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3664 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3665 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3666 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3667 & auxgmat2(2,2),auxgmatt2(2,2)
3668 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3669 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3670 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3671 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3674 c write (iout,*) "eturn3",i,j,j1,j2
3679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3681 C Third-order contributions
3688 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3689 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3690 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3691 c auxalary matices for theta gradient
3692 c auxalary matrix for i+1 and constant i+2
3693 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3694 c auxalary matrix for i+2 and constant i+1
3695 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3696 call transpose2(auxmat(1,1),auxmat1(1,1))
3697 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3698 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3699 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3700 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3701 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3702 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3703 C Derivatives in theta
3704 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3705 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3706 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3707 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3709 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3710 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3711 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3712 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3713 cd & ' eello_turn3_num',4*eello_turn3_num
3714 C Derivatives in gamma(i)
3715 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3716 call transpose2(auxmat2(1,1),auxmat3(1,1))
3717 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3718 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3719 C Derivatives in gamma(i+1)
3720 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3721 call transpose2(auxmat2(1,1),auxmat3(1,1))
3722 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3723 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3724 & +0.5d0*(pizda(1,1)+pizda(2,2))
3725 C Cartesian derivatives
3727 c ghalf1=0.5d0*agg(l,1)
3728 c ghalf2=0.5d0*agg(l,2)
3729 c ghalf3=0.5d0*agg(l,3)
3730 c ghalf4=0.5d0*agg(l,4)
3731 a_temp(1,1)=aggi(l,1)!+ghalf1
3732 a_temp(1,2)=aggi(l,2)!+ghalf2
3733 a_temp(2,1)=aggi(l,3)!+ghalf3
3734 a_temp(2,2)=aggi(l,4)!+ghalf4
3735 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3736 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3737 & +0.5d0*(pizda(1,1)+pizda(2,2))
3738 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3739 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3740 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3741 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3742 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3743 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3744 & +0.5d0*(pizda(1,1)+pizda(2,2))
3745 a_temp(1,1)=aggj(l,1)!+ghalf1
3746 a_temp(1,2)=aggj(l,2)!+ghalf2
3747 a_temp(2,1)=aggj(l,3)!+ghalf3
3748 a_temp(2,2)=aggj(l,4)!+ghalf4
3749 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3750 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3751 & +0.5d0*(pizda(1,1)+pizda(2,2))
3752 a_temp(1,1)=aggj1(l,1)
3753 a_temp(1,2)=aggj1(l,2)
3754 a_temp(2,1)=aggj1(l,3)
3755 a_temp(2,2)=aggj1(l,4)
3756 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3757 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3758 & +0.5d0*(pizda(1,1)+pizda(2,2))
3762 C-------------------------------------------------------------------------------
3763 subroutine eturn4(i,eello_turn4)
3764 C Third- and fourth-order contributions from turns
3765 implicit real*8 (a-h,o-z)
3766 include 'DIMENSIONS'
3767 include 'COMMON.IOUNITS'
3768 include 'COMMON.GEO'
3769 include 'COMMON.VAR'
3770 include 'COMMON.LOCAL'
3771 include 'COMMON.CHAIN'
3772 include 'COMMON.DERIV'
3773 include 'COMMON.INTERACT'
3774 include 'COMMON.CONTACTS'
3775 include 'COMMON.TORSION'
3776 include 'COMMON.VECTORS'
3777 include 'COMMON.FFIELD'
3778 include 'COMMON.CONTROL'
3780 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3781 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3782 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3783 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3784 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3785 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3786 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3787 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3788 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3789 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3790 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3793 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3795 C Fourth-order contributions
3803 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3804 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3805 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3806 c write(iout,*)"WCHODZE W PROGRAM"
3811 iti1=itortyp(itype(i+1))
3812 iti2=itortyp(itype(i+2))
3813 iti3=itortyp(itype(i+3))
3814 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3815 call transpose2(EUg(1,1,i+1),e1t(1,1))
3816 call transpose2(Eug(1,1,i+2),e2t(1,1))
3817 call transpose2(Eug(1,1,i+3),e3t(1,1))
3818 C Ematrix derivative in theta
3819 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3820 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3821 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3822 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3823 c eta1 in derivative theta
3824 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3825 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3826 c auxgvec is derivative of Ub2 so i+3 theta
3827 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3828 c auxalary matrix of E i+1
3829 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3832 s1=scalar2(b1(1,i+2),auxvec(1))
3833 c derivative of theta i+2 with constant i+3
3834 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3835 c derivative of theta i+2 with constant i+2
3836 gs32=scalar2(b1(1,i+2),auxgvec(1))
3837 c derivative of E matix in theta of i+1
3838 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3840 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3841 c ea31 in derivative theta
3842 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3843 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3844 c auxilary matrix auxgvec of Ub2 with constant E matirx
3845 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3846 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3847 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3851 s2=scalar2(b1(1,i+1),auxvec(1))
3852 c derivative of theta i+1 with constant i+3
3853 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3854 c derivative of theta i+2 with constant i+1
3855 gs21=scalar2(b1(1,i+1),auxgvec(1))
3856 c derivative of theta i+3 with constant i+1
3857 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3858 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3860 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3861 c two derivatives over diffetent matrices
3862 c gtae3e2 is derivative over i+3
3863 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3864 c ae3gte2 is derivative over i+2
3865 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3866 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3867 c three possible derivative over theta E matices
3869 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3871 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3873 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3874 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3876 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3877 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3878 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3880 eello_turn4=eello_turn4-(s1+s2+s3)
3882 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3883 & -(gs13+gsE13+gsEE1)*wturn4
3884 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3885 & -(gs23+gs21+gsEE2)*wturn4
3886 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3887 & -(gs32+gsE31+gsEE3)*wturn4
3888 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3891 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3892 & 'eturn4',i,j,-(s1+s2+s3)
3893 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3894 c & ' eello_turn4_num',8*eello_turn4_num
3895 C Derivatives in gamma(i)
3896 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3897 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3898 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3899 s1=scalar2(b1(1,i+2),auxvec(1))
3900 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3901 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3902 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3903 C Derivatives in gamma(i+1)
3904 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3905 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3906 s2=scalar2(b1(1,i+1),auxvec(1))
3907 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3908 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3909 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3910 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3911 C Derivatives in gamma(i+2)
3912 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3913 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3914 s1=scalar2(b1(1,i+2),auxvec(1))
3915 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3916 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3917 s2=scalar2(b1(1,i+1),auxvec(1))
3918 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3919 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3920 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3921 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3922 C Cartesian derivatives
3923 C Derivatives of this turn contributions in DC(i+2)
3924 if (j.lt.nres-1) then
3926 a_temp(1,1)=agg(l,1)
3927 a_temp(1,2)=agg(l,2)
3928 a_temp(2,1)=agg(l,3)
3929 a_temp(2,2)=agg(l,4)
3930 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3931 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3932 s1=scalar2(b1(1,i+2),auxvec(1))
3933 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3934 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3935 s2=scalar2(b1(1,i+1),auxvec(1))
3936 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3937 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3938 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3940 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3943 C Remaining derivatives of this turn contribution
3945 a_temp(1,1)=aggi(l,1)
3946 a_temp(1,2)=aggi(l,2)
3947 a_temp(2,1)=aggi(l,3)
3948 a_temp(2,2)=aggi(l,4)
3949 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3950 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3951 s1=scalar2(b1(1,i+2),auxvec(1))
3952 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3953 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3954 s2=scalar2(b1(1,i+1),auxvec(1))
3955 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3956 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3957 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3958 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3959 a_temp(1,1)=aggi1(l,1)
3960 a_temp(1,2)=aggi1(l,2)
3961 a_temp(2,1)=aggi1(l,3)
3962 a_temp(2,2)=aggi1(l,4)
3963 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3964 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3965 s1=scalar2(b1(1,i+2),auxvec(1))
3966 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3967 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3968 s2=scalar2(b1(1,i+1),auxvec(1))
3969 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3970 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3971 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3972 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3973 a_temp(1,1)=aggj(l,1)
3974 a_temp(1,2)=aggj(l,2)
3975 a_temp(2,1)=aggj(l,3)
3976 a_temp(2,2)=aggj(l,4)
3977 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3978 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3979 s1=scalar2(b1(1,i+2),auxvec(1))
3980 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3981 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3982 s2=scalar2(b1(1,i+1),auxvec(1))
3983 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3984 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3985 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3986 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3987 a_temp(1,1)=aggj1(l,1)
3988 a_temp(1,2)=aggj1(l,2)
3989 a_temp(2,1)=aggj1(l,3)
3990 a_temp(2,2)=aggj1(l,4)
3991 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3992 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3993 s1=scalar2(b1(1,i+2),auxvec(1))
3994 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3995 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3996 s2=scalar2(b1(1,i+1),auxvec(1))
3997 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3998 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3999 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4000 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4001 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4005 C-----------------------------------------------------------------------------
4006 subroutine vecpr(u,v,w)
4007 implicit real*8(a-h,o-z)
4008 dimension u(3),v(3),w(3)
4009 w(1)=u(2)*v(3)-u(3)*v(2)
4010 w(2)=-u(1)*v(3)+u(3)*v(1)
4011 w(3)=u(1)*v(2)-u(2)*v(1)
4014 C-----------------------------------------------------------------------------
4015 subroutine unormderiv(u,ugrad,unorm,ungrad)
4016 C This subroutine computes the derivatives of a normalized vector u, given
4017 C the derivatives computed without normalization conditions, ugrad. Returns
4020 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4021 double precision vec(3)
4022 double precision scalar
4024 c write (2,*) 'ugrad',ugrad
4027 vec(i)=scalar(ugrad(1,i),u(1))
4029 c write (2,*) 'vec',vec
4032 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4035 c write (2,*) 'ungrad',ungrad
4038 C-----------------------------------------------------------------------------
4039 subroutine escp_soft_sphere(evdw2,evdw2_14)
4041 C This subroutine calculates the excluded-volume interaction energy between
4042 C peptide-group centers and side chains and its gradient in virtual-bond and
4043 C side-chain vectors.
4045 implicit real*8 (a-h,o-z)
4046 include 'DIMENSIONS'
4047 include 'COMMON.GEO'
4048 include 'COMMON.VAR'
4049 include 'COMMON.LOCAL'
4050 include 'COMMON.CHAIN'
4051 include 'COMMON.DERIV'
4052 include 'COMMON.INTERACT'
4053 include 'COMMON.FFIELD'
4054 include 'COMMON.IOUNITS'
4055 include 'COMMON.CONTROL'
4060 cd print '(a)','Enter ESCP'
4061 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4062 do i=iatscp_s,iatscp_e
4063 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4065 xi=0.5D0*(c(1,i)+c(1,i+1))
4066 yi=0.5D0*(c(2,i)+c(2,i+1))
4067 zi=0.5D0*(c(3,i)+c(3,i+1))
4069 do iint=1,nscp_gr(i)
4071 do j=iscpstart(i,iint),iscpend(i,iint)
4072 if (itype(j).eq.ntyp1) cycle
4073 itypj=iabs(itype(j))
4074 C Uncomment following three lines for SC-p interactions
4078 C Uncomment following three lines for Ca-p interactions
4082 rij=xj*xj+yj*yj+zj*zj
4085 if (rij.lt.r0ijsq) then
4086 evdwij=0.25d0*(rij-r0ijsq)**2
4094 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4099 cgrad if (j.lt.i) then
4100 cd write (iout,*) 'j<i'
4101 C Uncomment following three lines for SC-p interactions
4103 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4106 cd write (iout,*) 'j>i'
4108 cgrad ggg(k)=-ggg(k)
4109 C Uncomment following line for SC-p interactions
4110 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4114 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4116 cgrad kstart=min0(i+1,j)
4117 cgrad kend=max0(i-1,j-1)
4118 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4119 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4120 cgrad do k=kstart,kend
4122 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4126 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4127 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4135 C-----------------------------------------------------------------------------
4136 subroutine escp(evdw2,evdw2_14)
4138 C This subroutine calculates the excluded-volume interaction energy between
4139 C peptide-group centers and side chains and its gradient in virtual-bond and
4140 C side-chain vectors.
4142 implicit real*8 (a-h,o-z)
4143 include 'DIMENSIONS'
4144 include 'COMMON.GEO'
4145 include 'COMMON.VAR'
4146 include 'COMMON.LOCAL'
4147 include 'COMMON.CHAIN'
4148 include 'COMMON.DERIV'
4149 include 'COMMON.INTERACT'
4150 include 'COMMON.FFIELD'
4151 include 'COMMON.IOUNITS'
4152 include 'COMMON.CONTROL'
4156 cd print '(a)','Enter ESCP'
4157 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4158 do i=iatscp_s,iatscp_e
4159 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4161 xi=0.5D0*(c(1,i)+c(1,i+1))
4162 yi=0.5D0*(c(2,i)+c(2,i+1))
4163 zi=0.5D0*(c(3,i)+c(3,i+1))
4165 do iint=1,nscp_gr(i)
4167 do j=iscpstart(i,iint),iscpend(i,iint)
4168 itypj=iabs(itype(j))
4169 if (itypj.eq.ntyp1) cycle
4170 C Uncomment following three lines for SC-p interactions
4174 C Uncomment following three lines for Ca-p interactions
4178 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4180 e1=fac*fac*aad(itypj,iteli)
4181 e2=fac*bad(itypj,iteli)
4182 if (iabs(j-i) .le. 2) then
4185 evdw2_14=evdw2_14+e1+e2
4189 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4190 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4193 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4195 fac=-(evdwij+e1)*rrij
4199 cgrad if (j.lt.i) then
4200 cd write (iout,*) 'j<i'
4201 C Uncomment following three lines for SC-p interactions
4203 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4206 cd write (iout,*) 'j>i'
4208 cgrad ggg(k)=-ggg(k)
4209 C Uncomment following line for SC-p interactions
4210 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4211 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4215 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4217 cgrad kstart=min0(i+1,j)
4218 cgrad kend=max0(i-1,j-1)
4219 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4220 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4221 cgrad do k=kstart,kend
4223 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4227 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4228 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4236 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4237 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4238 gradx_scp(j,i)=expon*gradx_scp(j,i)
4241 C******************************************************************************
4245 C To save time the factor EXPON has been extracted from ALL components
4246 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4249 C******************************************************************************
4252 C--------------------------------------------------------------------------
4253 subroutine edis(ehpb)
4255 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4257 implicit real*8 (a-h,o-z)
4258 include 'DIMENSIONS'
4259 include 'COMMON.SBRIDGE'
4260 include 'COMMON.CHAIN'
4261 include 'COMMON.DERIV'
4262 include 'COMMON.VAR'
4263 include 'COMMON.INTERACT'
4264 include 'COMMON.IOUNITS'
4267 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4268 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4269 if (link_end.eq.0) return
4270 do i=link_start,link_end
4271 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4272 C CA-CA distance used in regularization of structure.
4275 C iii and jjj point to the residues for which the distance is assigned.
4276 if (ii.gt.nres) then
4283 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4284 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4285 C distance and angle dependent SS bond potential.
4286 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4287 & iabs(itype(jjj)).eq.1) then
4288 call ssbond_ene(iii,jjj,eij)
4290 cd write (iout,*) "eij",eij
4292 C Calculate the distance between the two points and its difference from the
4296 C Get the force constant corresponding to this distance.
4298 C Calculate the contribution to energy.
4299 ehpb=ehpb+waga*rdis*rdis
4301 C Evaluate gradient.
4304 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4305 cd & ' waga=',waga,' fac=',fac
4307 ggg(j)=fac*(c(j,jj)-c(j,ii))
4309 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4310 C If this is a SC-SC distance, we need to calculate the contributions to the
4311 C Cartesian gradient in the SC vectors (ghpbx).
4314 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4315 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4318 cgrad do j=iii,jjj-1
4320 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4324 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4325 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4332 C--------------------------------------------------------------------------
4333 subroutine ssbond_ene(i,j,eij)
4335 C Calculate the distance and angle dependent SS-bond potential energy
4336 C using a free-energy function derived based on RHF/6-31G** ab initio
4337 C calculations of diethyl disulfide.
4339 C A. Liwo and U. Kozlowska, 11/24/03
4341 implicit real*8 (a-h,o-z)
4342 include 'DIMENSIONS'
4343 include 'COMMON.SBRIDGE'
4344 include 'COMMON.CHAIN'
4345 include 'COMMON.DERIV'
4346 include 'COMMON.LOCAL'
4347 include 'COMMON.INTERACT'
4348 include 'COMMON.VAR'
4349 include 'COMMON.IOUNITS'
4350 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4351 itypi=iabs(itype(i))
4355 dxi=dc_norm(1,nres+i)
4356 dyi=dc_norm(2,nres+i)
4357 dzi=dc_norm(3,nres+i)
4358 c dsci_inv=dsc_inv(itypi)
4359 dsci_inv=vbld_inv(nres+i)
4360 itypj=iabs(itype(j))
4361 c dscj_inv=dsc_inv(itypj)
4362 dscj_inv=vbld_inv(nres+j)
4366 dxj=dc_norm(1,nres+j)
4367 dyj=dc_norm(2,nres+j)
4368 dzj=dc_norm(3,nres+j)
4369 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4374 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4375 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4376 om12=dxi*dxj+dyi*dyj+dzi*dzj
4378 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4379 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4385 deltat12=om2-om1+2.0d0
4387 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4388 & +akct*deltad*deltat12
4389 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4390 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4391 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4392 c & " deltat12",deltat12," eij",eij
4393 ed=2*akcm*deltad+akct*deltat12
4395 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4396 eom1=-2*akth*deltat1-pom1-om2*pom2
4397 eom2= 2*akth*deltat2+pom1-om1*pom2
4400 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4401 ghpbx(k,i)=ghpbx(k,i)-ggk
4402 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4403 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4404 ghpbx(k,j)=ghpbx(k,j)+ggk
4405 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4406 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4407 ghpbc(k,i)=ghpbc(k,i)-ggk
4408 ghpbc(k,j)=ghpbc(k,j)+ggk
4411 C Calculate the components of the gradient in DC and X
4415 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4420 C--------------------------------------------------------------------------
4421 subroutine ebond(estr)
4423 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4425 implicit real*8 (a-h,o-z)
4426 include 'DIMENSIONS'
4427 include 'COMMON.LOCAL'
4428 include 'COMMON.GEO'
4429 include 'COMMON.INTERACT'
4430 include 'COMMON.DERIV'
4431 include 'COMMON.VAR'
4432 include 'COMMON.CHAIN'
4433 include 'COMMON.IOUNITS'
4434 include 'COMMON.NAMES'
4435 include 'COMMON.FFIELD'
4436 include 'COMMON.CONTROL'
4437 include 'COMMON.SETUP'
4438 double precision u(3),ud(3)
4441 do i=ibondp_start,ibondp_end
4442 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4443 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4445 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4446 & *dc(j,i-1)/vbld(i)
4448 if (energy_dec) write(iout,*)
4449 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4451 diff = vbld(i)-vbldp0
4452 if (energy_dec) write (iout,*)
4453 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4456 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4458 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4461 estr=0.5d0*AKP*estr+estr1
4463 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4465 do i=ibond_start,ibond_end
4467 if (iti.ne.10 .and. iti.ne.ntyp1) then
4470 diff=vbld(i+nres)-vbldsc0(1,iti)
4471 if (energy_dec) write (iout,*)
4472 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4473 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4474 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4476 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4480 diff=vbld(i+nres)-vbldsc0(j,iti)
4481 ud(j)=aksc(j,iti)*diff
4482 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4496 uprod2=uprod2*u(k)*u(k)
4500 usumsqder=usumsqder+ud(j)*uprod2
4502 estr=estr+uprod/usum
4504 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4512 C--------------------------------------------------------------------------
4513 subroutine ebend(etheta)
4515 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4516 C angles gamma and its derivatives in consecutive thetas and gammas.
4518 implicit real*8 (a-h,o-z)
4519 include 'DIMENSIONS'
4520 include 'COMMON.LOCAL'
4521 include 'COMMON.GEO'
4522 include 'COMMON.INTERACT'
4523 include 'COMMON.DERIV'
4524 include 'COMMON.VAR'
4525 include 'COMMON.CHAIN'
4526 include 'COMMON.IOUNITS'
4527 include 'COMMON.NAMES'
4528 include 'COMMON.FFIELD'
4529 include 'COMMON.CONTROL'
4530 common /calcthet/ term1,term2,termm,diffak,ratak,
4531 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4532 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4533 double precision y(2),z(2)
4535 c time11=dexp(-2*time)
4538 c write (*,'(a,i2)') 'EBEND ICG=',icg
4539 do i=ithet_start,ithet_end
4540 if (itype(i-1).eq.ntyp1) cycle
4541 C Zero the energy function and its derivative at 0 or pi.
4542 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4544 ichir1=isign(1,itype(i-2))
4545 ichir2=isign(1,itype(i))
4546 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4547 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4548 if (itype(i-1).eq.10) then
4549 itype1=isign(10,itype(i-2))
4550 ichir11=isign(1,itype(i-2))
4551 ichir12=isign(1,itype(i-2))
4552 itype2=isign(10,itype(i))
4553 ichir21=isign(1,itype(i))
4554 ichir22=isign(1,itype(i))
4557 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4560 if (phii.ne.phii) phii=150.0
4570 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4573 if (phii1.ne.phii1) phii1=150.0
4585 C Calculate the "mean" value of theta from the part of the distribution
4586 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4587 C In following comments this theta will be referred to as t_c.
4588 thet_pred_mean=0.0d0
4590 athetk=athet(k,it,ichir1,ichir2)
4591 bthetk=bthet(k,it,ichir1,ichir2)
4593 athetk=athet(k,itype1,ichir11,ichir12)
4594 bthetk=bthet(k,itype2,ichir21,ichir22)
4596 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4598 dthett=thet_pred_mean*ssd
4599 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4600 C Derivatives of the "mean" values in gamma1 and gamma2.
4601 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4602 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4603 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4604 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4606 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4607 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4608 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4609 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4611 if (theta(i).gt.pi-delta) then
4612 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4614 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4615 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4616 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4618 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4620 else if (theta(i).lt.delta) then
4621 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4622 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4623 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4625 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4626 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4629 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4632 etheta=etheta+ethetai
4633 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4635 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4636 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4637 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4639 C Ufff.... We've done all this!!!
4642 C---------------------------------------------------------------------------
4643 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
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 C Calculate the contributions to both Gaussian lobes.
4653 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4654 C The "polynomial part" of the "standard deviation" of this part of
4658 sig=sig*thet_pred_mean+polthet(j,it)
4660 C Derivative of the "interior part" of the "standard deviation of the"
4661 C gamma-dependent Gaussian lobe in t_c.
4662 sigtc=3*polthet(3,it)
4664 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4667 C Set the parameters of both Gaussian lobes of the distribution.
4668 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4669 fac=sig*sig+sigc0(it)
4672 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4673 sigsqtc=-4.0D0*sigcsq*sigtc
4674 c print *,i,sig,sigtc,sigsqtc
4675 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4676 sigtc=-sigtc/(fac*fac)
4677 C Following variable is sigma(t_c)**(-2)
4678 sigcsq=sigcsq*sigcsq
4680 sig0inv=1.0D0/sig0i**2
4681 delthec=thetai-thet_pred_mean
4682 delthe0=thetai-theta0i
4683 term1=-0.5D0*sigcsq*delthec*delthec
4684 term2=-0.5D0*sig0inv*delthe0*delthe0
4685 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4686 C NaNs in taking the logarithm. We extract the largest exponent which is added
4687 C to the energy (this being the log of the distribution) at the end of energy
4688 C term evaluation for this virtual-bond angle.
4689 if (term1.gt.term2) then
4691 term2=dexp(term2-termm)
4695 term1=dexp(term1-termm)
4698 C The ratio between the gamma-independent and gamma-dependent lobes of
4699 C the distribution is a Gaussian function of thet_pred_mean too.
4700 diffak=gthet(2,it)-thet_pred_mean
4701 ratak=diffak/gthet(3,it)**2
4702 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4703 C Let's differentiate it in thet_pred_mean NOW.
4705 C Now put together the distribution terms to make complete distribution.
4706 termexp=term1+ak*term2
4707 termpre=sigc+ak*sig0i
4708 C Contribution of the bending energy from this theta is just the -log of
4709 C the sum of the contributions from the two lobes and the pre-exponential
4710 C factor. Simple enough, isn't it?
4711 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4712 C NOW the derivatives!!!
4713 C 6/6/97 Take into account the deformation.
4714 E_theta=(delthec*sigcsq*term1
4715 & +ak*delthe0*sig0inv*term2)/termexp
4716 E_tc=((sigtc+aktc*sig0i)/termpre
4717 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4718 & aktc*term2)/termexp)
4721 c-----------------------------------------------------------------------------
4722 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4723 implicit real*8 (a-h,o-z)
4724 include 'DIMENSIONS'
4725 include 'COMMON.LOCAL'
4726 include 'COMMON.IOUNITS'
4727 common /calcthet/ term1,term2,termm,diffak,ratak,
4728 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4729 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4730 delthec=thetai-thet_pred_mean
4731 delthe0=thetai-theta0i
4732 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4733 t3 = thetai-thet_pred_mean
4737 t14 = t12+t6*sigsqtc
4739 t21 = thetai-theta0i
4745 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4746 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4747 & *(-t12*t9-ak*sig0inv*t27)
4751 C--------------------------------------------------------------------------
4752 subroutine ebend(etheta)
4754 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4755 C angles gamma and its derivatives in consecutive thetas and gammas.
4756 C ab initio-derived potentials from
4757 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4759 implicit real*8 (a-h,o-z)
4760 include 'DIMENSIONS'
4761 include 'COMMON.LOCAL'
4762 include 'COMMON.GEO'
4763 include 'COMMON.INTERACT'
4764 include 'COMMON.DERIV'
4765 include 'COMMON.VAR'
4766 include 'COMMON.CHAIN'
4767 include 'COMMON.IOUNITS'
4768 include 'COMMON.NAMES'
4769 include 'COMMON.FFIELD'
4770 include 'COMMON.CONTROL'
4771 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4772 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4773 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4774 & sinph1ph2(maxdouble,maxdouble)
4775 logical lprn /.false./, lprn1 /.false./
4777 do i=ithet_start,ithet_end
4778 if (itype(i-1).eq.ntyp1) cycle
4779 if (iabs(itype(i+1)).eq.20) iblock=2
4780 if (iabs(itype(i+1)).ne.20) iblock=1
4784 theti2=0.5d0*theta(i)
4785 ityp2=ithetyp((itype(i-1)))
4787 coskt(k)=dcos(k*theti2)
4788 sinkt(k)=dsin(k*theti2)
4790 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4793 if (phii.ne.phii) phii=150.0
4797 ityp1=ithetyp((itype(i-2)))
4798 C propagation of chirality for glycine type
4800 cosph1(k)=dcos(k*phii)
4801 sinph1(k)=dsin(k*phii)
4811 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4814 if (phii1.ne.phii1) phii1=150.0
4819 ityp3=ithetyp((itype(i)))
4821 cosph2(k)=dcos(k*phii1)
4822 sinph2(k)=dsin(k*phii1)
4832 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4835 ccl=cosph1(l)*cosph2(k-l)
4836 ssl=sinph1(l)*sinph2(k-l)
4837 scl=sinph1(l)*cosph2(k-l)
4838 csl=cosph1(l)*sinph2(k-l)
4839 cosph1ph2(l,k)=ccl-ssl
4840 cosph1ph2(k,l)=ccl+ssl
4841 sinph1ph2(l,k)=scl+csl
4842 sinph1ph2(k,l)=scl-csl
4846 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4847 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4848 write (iout,*) "coskt and sinkt"
4850 write (iout,*) k,coskt(k),sinkt(k)
4854 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4855 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4858 & write (iout,*) "k",k,"
4859 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4860 & " ethetai",ethetai
4863 write (iout,*) "cosph and sinph"
4865 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4867 write (iout,*) "cosph1ph2 and sinph2ph2"
4870 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4871 & sinph1ph2(l,k),sinph1ph2(k,l)
4874 write(iout,*) "ethetai",ethetai
4878 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4879 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4880 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4881 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4882 ethetai=ethetai+sinkt(m)*aux
4883 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4884 dephii=dephii+k*sinkt(m)*(
4885 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4886 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4887 dephii1=dephii1+k*sinkt(m)*(
4888 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4889 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4891 & write (iout,*) "m",m," k",k," bbthet",
4892 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4893 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4894 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4895 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4899 & write(iout,*) "ethetai",ethetai
4903 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4904 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4905 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4906 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4907 ethetai=ethetai+sinkt(m)*aux
4908 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4909 dephii=dephii+l*sinkt(m)*(
4910 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4911 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4912 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4913 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4914 dephii1=dephii1+(k-l)*sinkt(m)*(
4915 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4916 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4917 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4918 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4920 write (iout,*) "m",m," k",k," l",l," ffthet",
4921 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4922 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4923 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4924 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4925 & " ethetai",ethetai
4926 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4927 & cosph1ph2(k,l)*sinkt(m),
4928 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4936 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4937 & i,theta(i)*rad2deg,phii*rad2deg,
4938 & phii1*rad2deg,ethetai
4940 etheta=etheta+ethetai
4941 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4942 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4943 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
4949 c-----------------------------------------------------------------------------
4950 subroutine esc(escloc)
4951 C Calculate the local energy of a side chain and its derivatives in the
4952 C corresponding virtual-bond valence angles THETA and the spherical angles
4954 implicit real*8 (a-h,o-z)
4955 include 'DIMENSIONS'
4956 include 'COMMON.GEO'
4957 include 'COMMON.LOCAL'
4958 include 'COMMON.VAR'
4959 include 'COMMON.INTERACT'
4960 include 'COMMON.DERIV'
4961 include 'COMMON.CHAIN'
4962 include 'COMMON.IOUNITS'
4963 include 'COMMON.NAMES'
4964 include 'COMMON.FFIELD'
4965 include 'COMMON.CONTROL'
4966 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4967 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4968 common /sccalc/ time11,time12,time112,theti,it,nlobit
4971 c write (iout,'(a)') 'ESC'
4972 do i=loc_start,loc_end
4974 if (it.eq.ntyp1) cycle
4975 if (it.eq.10) goto 1
4976 nlobit=nlob(iabs(it))
4977 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4978 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4979 theti=theta(i+1)-pipol
4984 if (x(2).gt.pi-delta) then
4988 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4990 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4991 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4993 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4994 & ddersc0(1),dersc(1))
4995 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4996 & ddersc0(3),dersc(3))
4998 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5000 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5001 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5002 & dersc0(2),esclocbi,dersc02)
5003 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5005 call splinthet(x(2),0.5d0*delta,ss,ssd)
5010 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5012 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5013 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5015 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5017 c write (iout,*) escloci
5018 else if (x(2).lt.delta) then
5022 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5024 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5025 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5027 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5028 & ddersc0(1),dersc(1))
5029 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5030 & ddersc0(3),dersc(3))
5032 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5034 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5035 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5036 & dersc0(2),esclocbi,dersc02)
5037 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5042 call splinthet(x(2),0.5d0*delta,ss,ssd)
5044 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5046 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5047 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5049 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5050 c write (iout,*) escloci
5052 call enesc(x,escloci,dersc,ddummy,.false.)
5055 escloc=escloc+escloci
5056 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5057 & 'escloc',i,escloci
5058 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5060 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5062 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5063 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5068 C---------------------------------------------------------------------------
5069 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5070 implicit real*8 (a-h,o-z)
5071 include 'DIMENSIONS'
5072 include 'COMMON.GEO'
5073 include 'COMMON.LOCAL'
5074 include 'COMMON.IOUNITS'
5075 common /sccalc/ time11,time12,time112,theti,it,nlobit
5076 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5077 double precision contr(maxlob,-1:1)
5079 c write (iout,*) 'it=',it,' nlobit=',nlobit
5083 if (mixed) ddersc(j)=0.0d0
5087 C Because of periodicity of the dependence of the SC energy in omega we have
5088 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5089 C To avoid underflows, first compute & store the exponents.
5097 z(k)=x(k)-censc(k,j,it)
5102 Axk=Axk+gaussc(l,k,j,it)*z(l)
5108 expfac=expfac+Ax(k,j,iii)*z(k)
5116 C As in the case of ebend, we want to avoid underflows in exponentiation and
5117 C subsequent NaNs and INFs in energy calculation.
5118 C Find the largest exponent
5122 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5126 cd print *,'it=',it,' emin=',emin
5128 C Compute the contribution to SC energy and derivatives
5133 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5134 if(adexp.ne.adexp) adexp=1.0
5137 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5139 cd print *,'j=',j,' expfac=',expfac
5140 escloc_i=escloc_i+expfac
5142 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5146 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5147 & +gaussc(k,2,j,it))*expfac
5154 dersc(1)=dersc(1)/cos(theti)**2
5155 ddersc(1)=ddersc(1)/cos(theti)**2
5158 escloci=-(dlog(escloc_i)-emin)
5160 dersc(j)=dersc(j)/escloc_i
5164 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5169 C------------------------------------------------------------------------------
5170 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5171 implicit real*8 (a-h,o-z)
5172 include 'DIMENSIONS'
5173 include 'COMMON.GEO'
5174 include 'COMMON.LOCAL'
5175 include 'COMMON.IOUNITS'
5176 common /sccalc/ time11,time12,time112,theti,it,nlobit
5177 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5178 double precision contr(maxlob)
5189 z(k)=x(k)-censc(k,j,it)
5195 Axk=Axk+gaussc(l,k,j,it)*z(l)
5201 expfac=expfac+Ax(k,j)*z(k)
5206 C As in the case of ebend, we want to avoid underflows in exponentiation and
5207 C subsequent NaNs and INFs in energy calculation.
5208 C Find the largest exponent
5211 if (emin.gt.contr(j)) emin=contr(j)
5215 C Compute the contribution to SC energy and derivatives
5219 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5220 escloc_i=escloc_i+expfac
5222 dersc(k)=dersc(k)+Ax(k,j)*expfac
5224 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5225 & +gaussc(1,2,j,it))*expfac
5229 dersc(1)=dersc(1)/cos(theti)**2
5230 dersc12=dersc12/cos(theti)**2
5231 escloci=-(dlog(escloc_i)-emin)
5233 dersc(j)=dersc(j)/escloc_i
5235 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5239 c----------------------------------------------------------------------------------
5240 subroutine esc(escloc)
5241 C Calculate the local energy of a side chain and its derivatives in the
5242 C corresponding virtual-bond valence angles THETA and the spherical angles
5243 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5244 C added by Urszula Kozlowska. 07/11/2007
5246 implicit real*8 (a-h,o-z)
5247 include 'DIMENSIONS'
5248 include 'COMMON.GEO'
5249 include 'COMMON.LOCAL'
5250 include 'COMMON.VAR'
5251 include 'COMMON.SCROT'
5252 include 'COMMON.INTERACT'
5253 include 'COMMON.DERIV'
5254 include 'COMMON.CHAIN'
5255 include 'COMMON.IOUNITS'
5256 include 'COMMON.NAMES'
5257 include 'COMMON.FFIELD'
5258 include 'COMMON.CONTROL'
5259 include 'COMMON.VECTORS'
5260 double precision x_prime(3),y_prime(3),z_prime(3)
5261 & , sumene,dsc_i,dp2_i,x(65),
5262 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5263 & de_dxx,de_dyy,de_dzz,de_dt
5264 double precision s1_t,s1_6_t,s2_t,s2_6_t
5266 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5267 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5268 & dt_dCi(3),dt_dCi1(3)
5269 common /sccalc/ time11,time12,time112,theti,it,nlobit
5272 do i=loc_start,loc_end
5273 if (itype(i).eq.ntyp1) cycle
5274 costtab(i+1) =dcos(theta(i+1))
5275 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5276 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5277 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5278 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5279 cosfac=dsqrt(cosfac2)
5280 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5281 sinfac=dsqrt(sinfac2)
5283 if (it.eq.10) goto 1
5285 C Compute the axes of tghe local cartesian coordinates system; store in
5286 c x_prime, y_prime and z_prime
5293 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5294 C & dc_norm(3,i+nres)
5296 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5297 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5300 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5303 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5304 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5305 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5306 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5307 c & " xy",scalar(x_prime(1),y_prime(1)),
5308 c & " xz",scalar(x_prime(1),z_prime(1)),
5309 c & " yy",scalar(y_prime(1),y_prime(1)),
5310 c & " yz",scalar(y_prime(1),z_prime(1)),
5311 c & " zz",scalar(z_prime(1),z_prime(1))
5313 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5314 C to local coordinate system. Store in xx, yy, zz.
5320 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5321 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5322 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5329 C Compute the energy of the ith side cbain
5331 c write (2,*) "xx",xx," yy",yy," zz",zz
5334 x(j) = sc_parmin(j,it)
5337 Cc diagnostics - remove later
5339 yy1 = dsin(alph(2))*dcos(omeg(2))
5340 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5341 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5342 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5344 C," --- ", xx_w,yy_w,zz_w
5347 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5348 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5350 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5351 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5353 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5354 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5355 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5356 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5357 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5359 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5360 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5361 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5362 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5363 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5365 dsc_i = 0.743d0+x(61)
5367 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5368 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5369 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5370 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5371 s1=(1+x(63))/(0.1d0 + dscp1)
5372 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5373 s2=(1+x(65))/(0.1d0 + dscp2)
5374 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5375 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5376 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5377 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5379 c & dscp1,dscp2,sumene
5380 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5381 escloc = escloc + sumene
5382 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5387 C This section to check the numerical derivatives of the energy of ith side
5388 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5389 C #define DEBUG in the code to turn it on.
5391 write (2,*) "sumene =",sumene
5395 write (2,*) xx,yy,zz
5396 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5397 de_dxx_num=(sumenep-sumene)/aincr
5399 write (2,*) "xx+ sumene from enesc=",sumenep
5402 write (2,*) xx,yy,zz
5403 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5404 de_dyy_num=(sumenep-sumene)/aincr
5406 write (2,*) "yy+ sumene from enesc=",sumenep
5409 write (2,*) xx,yy,zz
5410 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5411 de_dzz_num=(sumenep-sumene)/aincr
5413 write (2,*) "zz+ sumene from enesc=",sumenep
5414 costsave=cost2tab(i+1)
5415 sintsave=sint2tab(i+1)
5416 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5417 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5418 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5419 de_dt_num=(sumenep-sumene)/aincr
5420 write (2,*) " t+ sumene from enesc=",sumenep
5421 cost2tab(i+1)=costsave
5422 sint2tab(i+1)=sintsave
5423 C End of diagnostics section.
5426 C Compute the gradient of esc
5428 c zz=zz*dsign(1.0,dfloat(itype(i)))
5429 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5430 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5431 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5432 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5433 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5434 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5435 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5436 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5437 pom1=(sumene3*sint2tab(i+1)+sumene1)
5438 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5439 pom2=(sumene4*cost2tab(i+1)+sumene2)
5440 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5441 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5442 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5443 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5445 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5446 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5447 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5449 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5450 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5451 & +(pom1+pom2)*pom_dx
5453 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5456 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5457 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5458 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5460 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5461 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5462 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5463 & +x(59)*zz**2 +x(60)*xx*zz
5464 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5465 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5466 & +(pom1-pom2)*pom_dy
5468 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5471 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5472 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5473 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5474 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5475 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5476 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5477 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5478 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5480 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5483 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5484 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5485 & +pom1*pom_dt1+pom2*pom_dt2
5487 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5492 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5493 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5494 cosfac2xx=cosfac2*xx
5495 sinfac2yy=sinfac2*yy
5497 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5499 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5501 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5502 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5503 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5504 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5505 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5506 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5507 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5508 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5509 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5510 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5514 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5515 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5516 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5517 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5520 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5521 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5522 dZZ_XYZ(k)=vbld_inv(i+nres)*
5523 & (z_prime(k)-zz*dC_norm(k,i+nres))
5525 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5526 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5530 dXX_Ctab(k,i)=dXX_Ci(k)
5531 dXX_C1tab(k,i)=dXX_Ci1(k)
5532 dYY_Ctab(k,i)=dYY_Ci(k)
5533 dYY_C1tab(k,i)=dYY_Ci1(k)
5534 dZZ_Ctab(k,i)=dZZ_Ci(k)
5535 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5536 dXX_XYZtab(k,i)=dXX_XYZ(k)
5537 dYY_XYZtab(k,i)=dYY_XYZ(k)
5538 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5542 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5543 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5544 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5545 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5546 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5548 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5549 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5550 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5551 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5552 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5553 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5554 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5555 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5557 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5558 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5560 C to check gradient call subroutine check_grad
5566 c------------------------------------------------------------------------------
5567 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5569 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5570 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5571 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5572 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5574 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5575 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5577 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5578 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5579 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5580 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5581 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5583 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5584 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5585 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5586 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5587 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5589 dsc_i = 0.743d0+x(61)
5591 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5592 & *(xx*cost2+yy*sint2))
5593 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5594 & *(xx*cost2-yy*sint2))
5595 s1=(1+x(63))/(0.1d0 + dscp1)
5596 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5597 s2=(1+x(65))/(0.1d0 + dscp2)
5598 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5599 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5600 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5605 c------------------------------------------------------------------------------
5606 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5608 C This procedure calculates two-body contact function g(rij) and its derivative:
5611 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5614 C where x=(rij-r0ij)/delta
5616 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5619 double precision rij,r0ij,eps0ij,fcont,fprimcont
5620 double precision x,x2,x4,delta
5624 if (x.lt.-1.0D0) then
5627 else if (x.le.1.0D0) then
5630 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5631 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5638 c------------------------------------------------------------------------------
5639 subroutine splinthet(theti,delta,ss,ssder)
5640 implicit real*8 (a-h,o-z)
5641 include 'DIMENSIONS'
5642 include 'COMMON.VAR'
5643 include 'COMMON.GEO'
5646 if (theti.gt.pipol) then
5647 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5649 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5654 c------------------------------------------------------------------------------
5655 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5657 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5658 double precision ksi,ksi2,ksi3,a1,a2,a3
5659 a1=fprim0*delta/(f1-f0)
5665 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5666 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5669 c------------------------------------------------------------------------------
5670 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5672 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5673 double precision ksi,ksi2,ksi3,a1,a2,a3
5678 a2=3*(f1x-f0x)-2*fprim0x*delta
5679 a3=fprim0x*delta-2*(f1x-f0x)
5680 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5683 C-----------------------------------------------------------------------------
5685 C-----------------------------------------------------------------------------
5686 subroutine etor(etors,edihcnstr)
5687 implicit real*8 (a-h,o-z)
5688 include 'DIMENSIONS'
5689 include 'COMMON.VAR'
5690 include 'COMMON.GEO'
5691 include 'COMMON.LOCAL'
5692 include 'COMMON.TORSION'
5693 include 'COMMON.INTERACT'
5694 include 'COMMON.DERIV'
5695 include 'COMMON.CHAIN'
5696 include 'COMMON.NAMES'
5697 include 'COMMON.IOUNITS'
5698 include 'COMMON.FFIELD'
5699 include 'COMMON.TORCNSTR'
5700 include 'COMMON.CONTROL'
5702 C Set lprn=.true. for debugging
5706 do i=iphi_start,iphi_end
5708 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5709 & .or. itype(i).eq.ntyp1) cycle
5710 itori=itortyp(itype(i-2))
5711 itori1=itortyp(itype(i-1))
5714 C Proline-Proline pair is a special case...
5715 if (itori.eq.3 .and. itori1.eq.3) then
5716 if (phii.gt.-dwapi3) then
5718 fac=1.0D0/(1.0D0-cosphi)
5719 etorsi=v1(1,3,3)*fac
5720 etorsi=etorsi+etorsi
5721 etors=etors+etorsi-v1(1,3,3)
5722 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5723 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5726 v1ij=v1(j+1,itori,itori1)
5727 v2ij=v2(j+1,itori,itori1)
5730 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5731 if (energy_dec) etors_ii=etors_ii+
5732 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5733 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5737 v1ij=v1(j,itori,itori1)
5738 v2ij=v2(j,itori,itori1)
5741 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5742 if (energy_dec) etors_ii=etors_ii+
5743 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5744 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5747 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5750 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5751 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5752 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5753 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5754 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5756 ! 6/20/98 - dihedral angle constraints
5759 itori=idih_constr(i)
5762 if (difi.gt.drange(i)) then
5764 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5765 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5766 else if (difi.lt.-drange(i)) then
5768 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5769 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5771 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5772 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5774 ! write (iout,*) 'edihcnstr',edihcnstr
5777 c------------------------------------------------------------------------------
5778 subroutine etor_d(etors_d)
5782 c----------------------------------------------------------------------------
5784 subroutine etor(etors,edihcnstr)
5785 implicit real*8 (a-h,o-z)
5786 include 'DIMENSIONS'
5787 include 'COMMON.VAR'
5788 include 'COMMON.GEO'
5789 include 'COMMON.LOCAL'
5790 include 'COMMON.TORSION'
5791 include 'COMMON.INTERACT'
5792 include 'COMMON.DERIV'
5793 include 'COMMON.CHAIN'
5794 include 'COMMON.NAMES'
5795 include 'COMMON.IOUNITS'
5796 include 'COMMON.FFIELD'
5797 include 'COMMON.TORCNSTR'
5798 include 'COMMON.CONTROL'
5800 C Set lprn=.true. for debugging
5804 do i=iphi_start,iphi_end
5805 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5806 & .or. itype(i).eq.ntyp1) cycle
5808 if (iabs(itype(i)).eq.20) then
5813 itori=itortyp(itype(i-2))
5814 itori1=itortyp(itype(i-1))
5817 C Regular cosine and sine terms
5818 do j=1,nterm(itori,itori1,iblock)
5819 v1ij=v1(j,itori,itori1,iblock)
5820 v2ij=v2(j,itori,itori1,iblock)
5823 etors=etors+v1ij*cosphi+v2ij*sinphi
5824 if (energy_dec) etors_ii=etors_ii+
5825 & v1ij*cosphi+v2ij*sinphi
5826 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5830 C E = SUM ----------------------------------- - v1
5831 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5833 cosphi=dcos(0.5d0*phii)
5834 sinphi=dsin(0.5d0*phii)
5835 do j=1,nlor(itori,itori1,iblock)
5836 vl1ij=vlor1(j,itori,itori1)
5837 vl2ij=vlor2(j,itori,itori1)
5838 vl3ij=vlor3(j,itori,itori1)
5839 pom=vl2ij*cosphi+vl3ij*sinphi
5840 pom1=1.0d0/(pom*pom+1.0d0)
5841 etors=etors+vl1ij*pom1
5842 if (energy_dec) etors_ii=etors_ii+
5845 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5847 C Subtract the constant term
5848 etors=etors-v0(itori,itori1,iblock)
5849 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5850 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5852 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5853 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5854 & (v1(j,itori,itori1,iblock),j=1,6),
5855 & (v2(j,itori,itori1,iblock),j=1,6)
5856 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5857 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5859 ! 6/20/98 - dihedral angle constraints
5861 c do i=1,ndih_constr
5862 do i=idihconstr_start,idihconstr_end
5863 itori=idih_constr(i)
5865 difi=pinorm(phii-phi0(i))
5866 if (difi.gt.drange(i)) then
5868 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5869 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5870 else if (difi.lt.-drange(i)) then
5872 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5873 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5877 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5878 cd & rad2deg*phi0(i), rad2deg*drange(i),
5879 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5881 cd write (iout,*) 'edihcnstr',edihcnstr
5884 c----------------------------------------------------------------------------
5885 subroutine etor_d(etors_d)
5886 C 6/23/01 Compute double torsional energy
5887 implicit real*8 (a-h,o-z)
5888 include 'DIMENSIONS'
5889 include 'COMMON.VAR'
5890 include 'COMMON.GEO'
5891 include 'COMMON.LOCAL'
5892 include 'COMMON.TORSION'
5893 include 'COMMON.INTERACT'
5894 include 'COMMON.DERIV'
5895 include 'COMMON.CHAIN'
5896 include 'COMMON.NAMES'
5897 include 'COMMON.IOUNITS'
5898 include 'COMMON.FFIELD'
5899 include 'COMMON.TORCNSTR'
5901 C Set lprn=.true. for debugging
5905 c write(iout,*) "a tu??"
5906 do i=iphid_start,iphid_end
5907 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5908 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5909 itori=itortyp(itype(i-2))
5910 itori1=itortyp(itype(i-1))
5911 itori2=itortyp(itype(i))
5917 if (iabs(itype(i+1)).eq.20) iblock=2
5919 C Regular cosine and sine terms
5920 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5921 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5922 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5923 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5924 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5925 cosphi1=dcos(j*phii)
5926 sinphi1=dsin(j*phii)
5927 cosphi2=dcos(j*phii1)
5928 sinphi2=dsin(j*phii1)
5929 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5930 & v2cij*cosphi2+v2sij*sinphi2
5931 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5932 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5934 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5936 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5937 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5938 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5939 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5940 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5941 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5942 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5943 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5944 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5945 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5946 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5947 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5948 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5949 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5952 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5953 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5958 c------------------------------------------------------------------------------
5959 subroutine eback_sc_corr(esccor)
5960 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5961 c conformational states; temporarily implemented as differences
5962 c between UNRES torsional potentials (dependent on three types of
5963 c residues) and the torsional potentials dependent on all 20 types
5964 c of residues computed from AM1 energy surfaces of terminally-blocked
5965 c amino-acid residues.
5966 implicit real*8 (a-h,o-z)
5967 include 'DIMENSIONS'
5968 include 'COMMON.VAR'
5969 include 'COMMON.GEO'
5970 include 'COMMON.LOCAL'
5971 include 'COMMON.TORSION'
5972 include 'COMMON.SCCOR'
5973 include 'COMMON.INTERACT'
5974 include 'COMMON.DERIV'
5975 include 'COMMON.CHAIN'
5976 include 'COMMON.NAMES'
5977 include 'COMMON.IOUNITS'
5978 include 'COMMON.FFIELD'
5979 include 'COMMON.CONTROL'
5981 C Set lprn=.true. for debugging
5984 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5986 do i=itau_start,itau_end
5987 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5989 isccori=isccortyp(itype(i-2))
5990 isccori1=isccortyp(itype(i-1))
5991 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5993 do intertyp=1,3 !intertyp
5994 cc Added 09 May 2012 (Adasko)
5995 cc Intertyp means interaction type of backbone mainchain correlation:
5996 c 1 = SC...Ca...Ca...Ca
5997 c 2 = Ca...Ca...Ca...SC
5998 c 3 = SC...Ca...Ca...SCi
6000 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6001 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6002 & (itype(i-1).eq.ntyp1)))
6003 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6004 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6005 & .or.(itype(i).eq.ntyp1)))
6006 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6007 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6008 & (itype(i-3).eq.ntyp1)))) cycle
6009 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6010 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6012 do j=1,nterm_sccor(isccori,isccori1)
6013 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6014 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6015 cosphi=dcos(j*tauangle(intertyp,i))
6016 sinphi=dsin(j*tauangle(intertyp,i))
6017 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6018 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6020 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6021 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6023 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6024 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6025 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6026 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6027 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6033 c----------------------------------------------------------------------------
6034 subroutine multibody(ecorr)
6035 C This subroutine calculates multi-body contributions to energy following
6036 C the idea of Skolnick et al. If side chains I and J make a contact and
6037 C at the same time side chains I+1 and J+1 make a contact, an extra
6038 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6039 implicit real*8 (a-h,o-z)
6040 include 'DIMENSIONS'
6041 include 'COMMON.IOUNITS'
6042 include 'COMMON.DERIV'
6043 include 'COMMON.INTERACT'
6044 include 'COMMON.CONTACTS'
6045 double precision gx(3),gx1(3)
6048 C Set lprn=.true. for debugging
6052 write (iout,'(a)') 'Contact function values:'
6054 write (iout,'(i2,20(1x,i2,f10.5))')
6055 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6070 num_conti=num_cont(i)
6071 num_conti1=num_cont(i1)
6076 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6077 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6078 cd & ' ishift=',ishift
6079 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6080 C The system gains extra energy.
6081 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6082 endif ! j1==j+-ishift
6091 c------------------------------------------------------------------------------
6092 double precision function esccorr(i,j,k,l,jj,kk)
6093 implicit real*8 (a-h,o-z)
6094 include 'DIMENSIONS'
6095 include 'COMMON.IOUNITS'
6096 include 'COMMON.DERIV'
6097 include 'COMMON.INTERACT'
6098 include 'COMMON.CONTACTS'
6099 double precision gx(3),gx1(3)
6104 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6105 C Calculate the multi-body contribution to energy.
6106 C Calculate multi-body contributions to the gradient.
6107 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6108 cd & k,l,(gacont(m,kk,k),m=1,3)
6110 gx(m) =ekl*gacont(m,jj,i)
6111 gx1(m)=eij*gacont(m,kk,k)
6112 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6113 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6114 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6115 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6119 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6124 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6130 c------------------------------------------------------------------------------
6131 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6132 C This subroutine calculates multi-body contributions to hydrogen-bonding
6133 implicit real*8 (a-h,o-z)
6134 include 'DIMENSIONS'
6135 include 'COMMON.IOUNITS'
6138 parameter (max_cont=maxconts)
6139 parameter (max_dim=26)
6140 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6141 double precision zapas(max_dim,maxconts,max_fg_procs),
6142 & zapas_recv(max_dim,maxconts,max_fg_procs)
6143 common /przechowalnia/ zapas
6144 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6145 & status_array(MPI_STATUS_SIZE,maxconts*2)
6147 include 'COMMON.SETUP'
6148 include 'COMMON.FFIELD'
6149 include 'COMMON.DERIV'
6150 include 'COMMON.INTERACT'
6151 include 'COMMON.CONTACTS'
6152 include 'COMMON.CONTROL'
6153 include 'COMMON.LOCAL'
6154 double precision gx(3),gx1(3),time00
6157 C Set lprn=.true. for debugging
6162 if (nfgtasks.le.1) goto 30
6164 write (iout,'(a)') 'Contact function values before RECEIVE:'
6166 write (iout,'(2i3,50(1x,i2,f5.2))')
6167 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6168 & j=1,num_cont_hb(i))
6172 do i=1,ntask_cont_from
6175 do i=1,ntask_cont_to
6178 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6180 C Make the list of contacts to send to send to other procesors
6181 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6183 do i=iturn3_start,iturn3_end
6184 c write (iout,*) "make contact list turn3",i," num_cont",
6186 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6188 do i=iturn4_start,iturn4_end
6189 c write (iout,*) "make contact list turn4",i," num_cont",
6191 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6195 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6197 do j=1,num_cont_hb(i)
6200 iproc=iint_sent_local(k,jjc,ii)
6201 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6202 if (iproc.gt.0) then
6203 ncont_sent(iproc)=ncont_sent(iproc)+1
6204 nn=ncont_sent(iproc)
6206 zapas(2,nn,iproc)=jjc
6207 zapas(3,nn,iproc)=facont_hb(j,i)
6208 zapas(4,nn,iproc)=ees0p(j,i)
6209 zapas(5,nn,iproc)=ees0m(j,i)
6210 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6211 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6212 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6213 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6214 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6215 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6216 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6217 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6218 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6219 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6220 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6221 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6222 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6223 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6224 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6225 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6226 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6227 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6228 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6229 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6230 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6237 & "Numbers of contacts to be sent to other processors",
6238 & (ncont_sent(i),i=1,ntask_cont_to)
6239 write (iout,*) "Contacts sent"
6240 do ii=1,ntask_cont_to
6242 iproc=itask_cont_to(ii)
6243 write (iout,*) nn," contacts to processor",iproc,
6244 & " of CONT_TO_COMM group"
6246 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6254 CorrelID1=nfgtasks+fg_rank+1
6256 C Receive the numbers of needed contacts from other processors
6257 do ii=1,ntask_cont_from
6258 iproc=itask_cont_from(ii)
6260 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6261 & FG_COMM,req(ireq),IERR)
6263 c write (iout,*) "IRECV ended"
6265 C Send the number of contacts needed by other processors
6266 do ii=1,ntask_cont_to
6267 iproc=itask_cont_to(ii)
6269 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6270 & FG_COMM,req(ireq),IERR)
6272 c write (iout,*) "ISEND ended"
6273 c write (iout,*) "number of requests (nn)",ireq
6276 & call MPI_Waitall(ireq,req,status_array,ierr)
6278 c & "Numbers of contacts to be received from other processors",
6279 c & (ncont_recv(i),i=1,ntask_cont_from)
6283 do ii=1,ntask_cont_from
6284 iproc=itask_cont_from(ii)
6286 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6287 c & " of CONT_TO_COMM group"
6291 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6292 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6293 c write (iout,*) "ireq,req",ireq,req(ireq)
6296 C Send the contacts to processors that need them
6297 do ii=1,ntask_cont_to
6298 iproc=itask_cont_to(ii)
6300 c write (iout,*) nn," contacts to processor",iproc,
6301 c & " of CONT_TO_COMM group"
6304 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6305 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6306 c write (iout,*) "ireq,req",ireq,req(ireq)
6308 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6312 c write (iout,*) "number of requests (contacts)",ireq
6313 c write (iout,*) "req",(req(i),i=1,4)
6316 & call MPI_Waitall(ireq,req,status_array,ierr)
6317 do iii=1,ntask_cont_from
6318 iproc=itask_cont_from(iii)
6321 write (iout,*) "Received",nn," contacts from processor",iproc,
6322 & " of CONT_FROM_COMM group"
6325 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6330 ii=zapas_recv(1,i,iii)
6331 c Flag the received contacts to prevent double-counting
6332 jj=-zapas_recv(2,i,iii)
6333 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6335 nnn=num_cont_hb(ii)+1
6338 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6339 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6340 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6341 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6342 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6343 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6344 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6345 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6346 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6347 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6348 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6349 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6350 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6351 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6352 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6353 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6354 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6355 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6356 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6357 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6358 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6359 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6360 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6361 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6366 write (iout,'(a)') 'Contact function values after receive:'
6368 write (iout,'(2i3,50(1x,i3,f5.2))')
6369 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6370 & j=1,num_cont_hb(i))
6377 write (iout,'(a)') 'Contact function values:'
6379 write (iout,'(2i3,50(1x,i3,f5.2))')
6380 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6381 & j=1,num_cont_hb(i))
6385 C Remove the loop below after debugging !!!
6392 C Calculate the local-electrostatic correlation terms
6393 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6395 num_conti=num_cont_hb(i)
6396 num_conti1=num_cont_hb(i+1)
6403 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6404 c & ' jj=',jj,' kk=',kk
6405 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6406 & .or. j.lt.0 .and. j1.gt.0) .and.
6407 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6408 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6409 C The system gains extra energy.
6410 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6411 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6412 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6414 else if (j1.eq.j) then
6415 C Contacts I-J and I-(J+1) occur simultaneously.
6416 C The system loses extra energy.
6417 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6422 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6423 c & ' jj=',jj,' kk=',kk
6425 C Contacts I-J and (I+1)-J occur simultaneously.
6426 C The system loses extra energy.
6427 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6434 c------------------------------------------------------------------------------
6435 subroutine add_hb_contact(ii,jj,itask)
6436 implicit real*8 (a-h,o-z)
6437 include "DIMENSIONS"
6438 include "COMMON.IOUNITS"
6441 parameter (max_cont=maxconts)
6442 parameter (max_dim=26)
6443 include "COMMON.CONTACTS"
6444 double precision zapas(max_dim,maxconts,max_fg_procs),
6445 & zapas_recv(max_dim,maxconts,max_fg_procs)
6446 common /przechowalnia/ zapas
6447 integer i,j,ii,jj,iproc,itask(4),nn
6448 c write (iout,*) "itask",itask
6451 if (iproc.gt.0) then
6452 do j=1,num_cont_hb(ii)
6454 c write (iout,*) "i",ii," j",jj," jjc",jjc
6456 ncont_sent(iproc)=ncont_sent(iproc)+1
6457 nn=ncont_sent(iproc)
6458 zapas(1,nn,iproc)=ii
6459 zapas(2,nn,iproc)=jjc
6460 zapas(3,nn,iproc)=facont_hb(j,ii)
6461 zapas(4,nn,iproc)=ees0p(j,ii)
6462 zapas(5,nn,iproc)=ees0m(j,ii)
6463 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6464 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6465 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6466 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6467 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6468 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6469 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6470 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6471 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6472 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6473 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6474 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6475 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6476 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6477 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6478 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6479 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6480 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6481 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6482 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6483 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6491 c------------------------------------------------------------------------------
6492 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6494 C This subroutine calculates multi-body contributions to hydrogen-bonding
6495 implicit real*8 (a-h,o-z)
6496 include 'DIMENSIONS'
6497 include 'COMMON.IOUNITS'
6500 parameter (max_cont=maxconts)
6501 parameter (max_dim=70)
6502 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6503 double precision zapas(max_dim,maxconts,max_fg_procs),
6504 & zapas_recv(max_dim,maxconts,max_fg_procs)
6505 common /przechowalnia/ zapas
6506 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6507 & status_array(MPI_STATUS_SIZE,maxconts*2)
6509 include 'COMMON.SETUP'
6510 include 'COMMON.FFIELD'
6511 include 'COMMON.DERIV'
6512 include 'COMMON.LOCAL'
6513 include 'COMMON.INTERACT'
6514 include 'COMMON.CONTACTS'
6515 include 'COMMON.CHAIN'
6516 include 'COMMON.CONTROL'
6517 double precision gx(3),gx1(3)
6518 integer num_cont_hb_old(maxres)
6520 double precision eello4,eello5,eelo6,eello_turn6
6521 external eello4,eello5,eello6,eello_turn6
6522 C Set lprn=.true. for debugging
6527 num_cont_hb_old(i)=num_cont_hb(i)
6531 if (nfgtasks.le.1) goto 30
6533 write (iout,'(a)') 'Contact function values before RECEIVE:'
6535 write (iout,'(2i3,50(1x,i2,f5.2))')
6536 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6537 & j=1,num_cont_hb(i))
6541 do i=1,ntask_cont_from
6544 do i=1,ntask_cont_to
6547 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6549 C Make the list of contacts to send to send to other procesors
6550 do i=iturn3_start,iturn3_end
6551 c write (iout,*) "make contact list turn3",i," num_cont",
6553 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6555 do i=iturn4_start,iturn4_end
6556 c write (iout,*) "make contact list turn4",i," num_cont",
6558 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6562 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6564 do j=1,num_cont_hb(i)
6567 iproc=iint_sent_local(k,jjc,ii)
6568 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6569 if (iproc.ne.0) then
6570 ncont_sent(iproc)=ncont_sent(iproc)+1
6571 nn=ncont_sent(iproc)
6573 zapas(2,nn,iproc)=jjc
6574 zapas(3,nn,iproc)=d_cont(j,i)
6578 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6583 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6591 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6602 & "Numbers of contacts to be sent to other processors",
6603 & (ncont_sent(i),i=1,ntask_cont_to)
6604 write (iout,*) "Contacts sent"
6605 do ii=1,ntask_cont_to
6607 iproc=itask_cont_to(ii)
6608 write (iout,*) nn," contacts to processor",iproc,
6609 & " of CONT_TO_COMM group"
6611 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6619 CorrelID1=nfgtasks+fg_rank+1
6621 C Receive the numbers of needed contacts from other processors
6622 do ii=1,ntask_cont_from
6623 iproc=itask_cont_from(ii)
6625 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6626 & FG_COMM,req(ireq),IERR)
6628 c write (iout,*) "IRECV ended"
6630 C Send the number of contacts needed by other processors
6631 do ii=1,ntask_cont_to
6632 iproc=itask_cont_to(ii)
6634 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6635 & FG_COMM,req(ireq),IERR)
6637 c write (iout,*) "ISEND ended"
6638 c write (iout,*) "number of requests (nn)",ireq
6641 & call MPI_Waitall(ireq,req,status_array,ierr)
6643 c & "Numbers of contacts to be received from other processors",
6644 c & (ncont_recv(i),i=1,ntask_cont_from)
6648 do ii=1,ntask_cont_from
6649 iproc=itask_cont_from(ii)
6651 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6652 c & " of CONT_TO_COMM group"
6656 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6657 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6658 c write (iout,*) "ireq,req",ireq,req(ireq)
6661 C Send the contacts to processors that need them
6662 do ii=1,ntask_cont_to
6663 iproc=itask_cont_to(ii)
6665 c write (iout,*) nn," contacts to processor",iproc,
6666 c & " of CONT_TO_COMM group"
6669 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6670 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6671 c write (iout,*) "ireq,req",ireq,req(ireq)
6673 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6677 c write (iout,*) "number of requests (contacts)",ireq
6678 c write (iout,*) "req",(req(i),i=1,4)
6681 & call MPI_Waitall(ireq,req,status_array,ierr)
6682 do iii=1,ntask_cont_from
6683 iproc=itask_cont_from(iii)
6686 write (iout,*) "Received",nn," contacts from processor",iproc,
6687 & " of CONT_FROM_COMM group"
6690 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6695 ii=zapas_recv(1,i,iii)
6696 c Flag the received contacts to prevent double-counting
6697 jj=-zapas_recv(2,i,iii)
6698 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6700 nnn=num_cont_hb(ii)+1
6703 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6707 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6712 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6720 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6729 write (iout,'(a)') 'Contact function values after receive:'
6731 write (iout,'(2i3,50(1x,i3,5f6.3))')
6732 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6733 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6740 write (iout,'(a)') 'Contact function values:'
6742 write (iout,'(2i3,50(1x,i2,5f6.3))')
6743 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6744 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6750 C Remove the loop below after debugging !!!
6757 C Calculate the dipole-dipole interaction energies
6758 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6759 do i=iatel_s,iatel_e+1
6760 num_conti=num_cont_hb(i)
6769 C Calculate the local-electrostatic correlation terms
6770 c write (iout,*) "gradcorr5 in eello5 before loop"
6772 c write (iout,'(i5,3f10.5)')
6773 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6775 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6776 c write (iout,*) "corr loop i",i
6778 num_conti=num_cont_hb(i)
6779 num_conti1=num_cont_hb(i+1)
6786 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6787 c & ' jj=',jj,' kk=',kk
6788 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6789 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6790 & .or. j.lt.0 .and. j1.gt.0) .and.
6791 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6792 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6793 C The system gains extra energy.
6795 sqd1=dsqrt(d_cont(jj,i))
6796 sqd2=dsqrt(d_cont(kk,i1))
6797 sred_geom = sqd1*sqd2
6798 IF (sred_geom.lt.cutoff_corr) THEN
6799 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6801 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6802 cd & ' jj=',jj,' kk=',kk
6803 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6804 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6806 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6807 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6810 cd write (iout,*) 'sred_geom=',sred_geom,
6811 cd & ' ekont=',ekont,' fprim=',fprimcont,
6812 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6813 cd write (iout,*) "g_contij",g_contij
6814 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6815 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6816 call calc_eello(i,jp,i+1,jp1,jj,kk)
6817 if (wcorr4.gt.0.0d0)
6818 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6819 if (energy_dec.and.wcorr4.gt.0.0d0)
6820 1 write (iout,'(a6,4i5,0pf7.3)')
6821 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6822 c write (iout,*) "gradcorr5 before eello5"
6824 c write (iout,'(i5,3f10.5)')
6825 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6827 if (wcorr5.gt.0.0d0)
6828 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6829 c write (iout,*) "gradcorr5 after eello5"
6831 c write (iout,'(i5,3f10.5)')
6832 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6834 if (energy_dec.and.wcorr5.gt.0.0d0)
6835 1 write (iout,'(a6,4i5,0pf7.3)')
6836 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6837 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6838 cd write(2,*)'ijkl',i,jp,i+1,jp1
6839 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6840 & .or. wturn6.eq.0.0d0))then
6841 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6842 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6843 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6844 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6845 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6846 cd & 'ecorr6=',ecorr6
6847 cd write (iout,'(4e15.5)') sred_geom,
6848 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6849 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6850 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6851 else if (wturn6.gt.0.0d0
6852 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6853 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6854 eturn6=eturn6+eello_turn6(i,jj,kk)
6855 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6856 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6857 cd write (2,*) 'multibody_eello:eturn6',eturn6
6866 num_cont_hb(i)=num_cont_hb_old(i)
6868 c write (iout,*) "gradcorr5 in eello5"
6870 c write (iout,'(i5,3f10.5)')
6871 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6875 c------------------------------------------------------------------------------
6876 subroutine add_hb_contact_eello(ii,jj,itask)
6877 implicit real*8 (a-h,o-z)
6878 include "DIMENSIONS"
6879 include "COMMON.IOUNITS"
6882 parameter (max_cont=maxconts)
6883 parameter (max_dim=70)
6884 include "COMMON.CONTACTS"
6885 double precision zapas(max_dim,maxconts,max_fg_procs),
6886 & zapas_recv(max_dim,maxconts,max_fg_procs)
6887 common /przechowalnia/ zapas
6888 integer i,j,ii,jj,iproc,itask(4),nn
6889 c write (iout,*) "itask",itask
6892 if (iproc.gt.0) then
6893 do j=1,num_cont_hb(ii)
6895 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6897 ncont_sent(iproc)=ncont_sent(iproc)+1
6898 nn=ncont_sent(iproc)
6899 zapas(1,nn,iproc)=ii
6900 zapas(2,nn,iproc)=jjc
6901 zapas(3,nn,iproc)=d_cont(j,ii)
6905 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6910 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6918 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6930 c------------------------------------------------------------------------------
6931 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6932 implicit real*8 (a-h,o-z)
6933 include 'DIMENSIONS'
6934 include 'COMMON.IOUNITS'
6935 include 'COMMON.DERIV'
6936 include 'COMMON.INTERACT'
6937 include 'COMMON.CONTACTS'
6938 double precision gx(3),gx1(3)
6948 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6949 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6950 C Following 4 lines for diagnostics.
6955 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6956 c & 'Contacts ',i,j,
6957 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6958 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6960 C Calculate the multi-body contribution to energy.
6961 c ecorr=ecorr+ekont*ees
6962 C Calculate multi-body contributions to the gradient.
6963 coeffpees0pij=coeffp*ees0pij
6964 coeffmees0mij=coeffm*ees0mij
6965 coeffpees0pkl=coeffp*ees0pkl
6966 coeffmees0mkl=coeffm*ees0mkl
6968 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6969 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6970 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6971 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6972 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6973 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6974 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6975 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6976 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6977 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6978 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6979 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6980 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6981 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6982 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6983 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6984 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6985 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6986 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6987 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6988 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6989 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6990 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6991 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6992 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6997 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6998 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6999 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7000 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7005 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7006 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7007 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7008 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7011 c write (iout,*) "ehbcorr",ekont*ees
7016 C---------------------------------------------------------------------------
7017 subroutine dipole(i,j,jj)
7018 implicit real*8 (a-h,o-z)
7019 include 'DIMENSIONS'
7020 include 'COMMON.IOUNITS'
7021 include 'COMMON.CHAIN'
7022 include 'COMMON.FFIELD'
7023 include 'COMMON.DERIV'
7024 include 'COMMON.INTERACT'
7025 include 'COMMON.CONTACTS'
7026 include 'COMMON.TORSION'
7027 include 'COMMON.VAR'
7028 include 'COMMON.GEO'
7029 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7031 iti1 = itortyp(itype(i+1))
7032 if (j.lt.nres-1) then
7033 itj1 = itortyp(itype(j+1))
7038 dipi(iii,1)=Ub2(iii,i)
7039 dipderi(iii)=Ub2der(iii,i)
7040 dipi(iii,2)=b1(iii,i+1)
7041 dipj(iii,1)=Ub2(iii,j)
7042 dipderj(iii)=Ub2der(iii,j)
7043 dipj(iii,2)=b1(iii,j+1)
7047 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7050 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7057 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7061 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7066 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7067 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7069 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7071 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7073 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7078 C---------------------------------------------------------------------------
7079 subroutine calc_eello(i,j,k,l,jj,kk)
7081 C This subroutine computes matrices and vectors needed to calculate
7082 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7084 implicit real*8 (a-h,o-z)
7085 include 'DIMENSIONS'
7086 include 'COMMON.IOUNITS'
7087 include 'COMMON.CHAIN'
7088 include 'COMMON.DERIV'
7089 include 'COMMON.INTERACT'
7090 include 'COMMON.CONTACTS'
7091 include 'COMMON.TORSION'
7092 include 'COMMON.VAR'
7093 include 'COMMON.GEO'
7094 include 'COMMON.FFIELD'
7095 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7096 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7099 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7100 cd & ' jj=',jj,' kk=',kk
7101 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7102 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7103 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7106 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7107 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7110 call transpose2(aa1(1,1),aa1t(1,1))
7111 call transpose2(aa2(1,1),aa2t(1,1))
7114 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7115 & aa1tder(1,1,lll,kkk))
7116 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7117 & aa2tder(1,1,lll,kkk))
7121 C parallel orientation of the two CA-CA-CA frames.
7123 iti=itortyp(itype(i))
7127 itk1=itortyp(itype(k+1))
7128 itj=itortyp(itype(j))
7129 if (l.lt.nres-1) then
7130 itl1=itortyp(itype(l+1))
7134 C A1 kernel(j+1) A2T
7136 cd write (iout,'(3f10.5,5x,3f10.5)')
7137 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7139 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7140 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7141 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7142 C Following matrices are needed only for 6-th order cumulants
7143 IF (wcorr6.gt.0.0d0) THEN
7144 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7145 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7146 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7147 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7148 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7149 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7150 & ADtEAderx(1,1,1,1,1,1))
7152 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7153 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7154 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7155 & ADtEA1derx(1,1,1,1,1,1))
7157 C End 6-th order cumulants
7160 cd write (2,*) 'In calc_eello6'
7162 cd write (2,*) 'iii=',iii
7164 cd write (2,*) 'kkk=',kkk
7166 cd write (2,'(3(2f10.5),5x)')
7167 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7172 call transpose2(EUgder(1,1,k),auxmat(1,1))
7173 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7174 call transpose2(EUg(1,1,k),auxmat(1,1))
7175 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7176 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7180 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7181 & EAEAderx(1,1,lll,kkk,iii,1))
7185 C A1T kernel(i+1) A2
7186 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7187 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7188 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7189 C Following matrices are needed only for 6-th order cumulants
7190 IF (wcorr6.gt.0.0d0) THEN
7191 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7192 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7193 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7194 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7195 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7196 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7197 & ADtEAderx(1,1,1,1,1,2))
7198 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7199 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7200 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7201 & ADtEA1derx(1,1,1,1,1,2))
7203 C End 6-th order cumulants
7204 call transpose2(EUgder(1,1,l),auxmat(1,1))
7205 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7206 call transpose2(EUg(1,1,l),auxmat(1,1))
7207 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7208 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7212 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7213 & EAEAderx(1,1,lll,kkk,iii,2))
7218 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7219 C They are needed only when the fifth- or the sixth-order cumulants are
7221 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7222 call transpose2(AEA(1,1,1),auxmat(1,1))
7223 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7224 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7225 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7226 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7227 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7228 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7229 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7230 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7231 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7232 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7233 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7234 call transpose2(AEA(1,1,2),auxmat(1,1))
7235 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7236 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7237 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7238 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7239 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7240 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7241 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7242 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7243 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7244 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7245 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7246 C Calculate the Cartesian derivatives of the vectors.
7250 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7251 call matvec2(auxmat(1,1),b1(1,i),
7252 & AEAb1derx(1,lll,kkk,iii,1,1))
7253 call matvec2(auxmat(1,1),Ub2(1,i),
7254 & AEAb2derx(1,lll,kkk,iii,1,1))
7255 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7256 & AEAb1derx(1,lll,kkk,iii,2,1))
7257 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7258 & AEAb2derx(1,lll,kkk,iii,2,1))
7259 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7260 call matvec2(auxmat(1,1),b1(1,j),
7261 & AEAb1derx(1,lll,kkk,iii,1,2))
7262 call matvec2(auxmat(1,1),Ub2(1,j),
7263 & AEAb2derx(1,lll,kkk,iii,1,2))
7264 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7265 & AEAb1derx(1,lll,kkk,iii,2,2))
7266 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7267 & AEAb2derx(1,lll,kkk,iii,2,2))
7274 C Antiparallel orientation of the two CA-CA-CA frames.
7276 iti=itortyp(itype(i))
7280 itk1=itortyp(itype(k+1))
7281 itl=itortyp(itype(l))
7282 itj=itortyp(itype(j))
7283 if (j.lt.nres-1) then
7284 itj1=itortyp(itype(j+1))
7288 C A2 kernel(j-1)T A1T
7289 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7290 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7291 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7292 C Following matrices are needed only for 6-th order cumulants
7293 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7294 & j.eq.i+4 .and. l.eq.i+3)) THEN
7295 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7296 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7297 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7298 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7299 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7300 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7301 & ADtEAderx(1,1,1,1,1,1))
7302 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7303 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7304 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7305 & ADtEA1derx(1,1,1,1,1,1))
7307 C End 6-th order cumulants
7308 call transpose2(EUgder(1,1,k),auxmat(1,1))
7309 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7310 call transpose2(EUg(1,1,k),auxmat(1,1))
7311 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7312 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7316 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7317 & EAEAderx(1,1,lll,kkk,iii,1))
7321 C A2T kernel(i+1)T A1
7322 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7323 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7324 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7325 C Following matrices are needed only for 6-th order cumulants
7326 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7327 & j.eq.i+4 .and. l.eq.i+3)) THEN
7328 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7329 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7330 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7331 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7332 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7333 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7334 & ADtEAderx(1,1,1,1,1,2))
7335 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7336 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7337 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7338 & ADtEA1derx(1,1,1,1,1,2))
7340 C End 6-th order cumulants
7341 call transpose2(EUgder(1,1,j),auxmat(1,1))
7342 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7343 call transpose2(EUg(1,1,j),auxmat(1,1))
7344 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7345 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7349 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7350 & EAEAderx(1,1,lll,kkk,iii,2))
7355 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7356 C They are needed only when the fifth- or the sixth-order cumulants are
7358 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7359 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7360 call transpose2(AEA(1,1,1),auxmat(1,1))
7361 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7362 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7363 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7364 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7365 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7366 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7367 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7368 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7369 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7370 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7371 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7372 call transpose2(AEA(1,1,2),auxmat(1,1))
7373 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7374 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7375 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7376 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7377 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7378 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7379 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7380 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7381 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7382 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7383 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7384 C Calculate the Cartesian derivatives of the vectors.
7388 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7389 call matvec2(auxmat(1,1),b1(1,i),
7390 & AEAb1derx(1,lll,kkk,iii,1,1))
7391 call matvec2(auxmat(1,1),Ub2(1,i),
7392 & AEAb2derx(1,lll,kkk,iii,1,1))
7393 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7394 & AEAb1derx(1,lll,kkk,iii,2,1))
7395 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7396 & AEAb2derx(1,lll,kkk,iii,2,1))
7397 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7398 call matvec2(auxmat(1,1),b1(1,l),
7399 & AEAb1derx(1,lll,kkk,iii,1,2))
7400 call matvec2(auxmat(1,1),Ub2(1,l),
7401 & AEAb2derx(1,lll,kkk,iii,1,2))
7402 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7403 & AEAb1derx(1,lll,kkk,iii,2,2))
7404 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7405 & AEAb2derx(1,lll,kkk,iii,2,2))
7414 C---------------------------------------------------------------------------
7415 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7416 & KK,KKderg,AKA,AKAderg,AKAderx)
7420 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7421 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7422 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7427 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7429 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7432 cd if (lprn) write (2,*) 'In kernel'
7434 cd if (lprn) write (2,*) 'kkk=',kkk
7436 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7437 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7439 cd write (2,*) 'lll=',lll
7440 cd write (2,*) 'iii=1'
7442 cd write (2,'(3(2f10.5),5x)')
7443 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7446 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7447 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7449 cd write (2,*) 'lll=',lll
7450 cd write (2,*) 'iii=2'
7452 cd write (2,'(3(2f10.5),5x)')
7453 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7460 C---------------------------------------------------------------------------
7461 double precision function eello4(i,j,k,l,jj,kk)
7462 implicit real*8 (a-h,o-z)
7463 include 'DIMENSIONS'
7464 include 'COMMON.IOUNITS'
7465 include 'COMMON.CHAIN'
7466 include 'COMMON.DERIV'
7467 include 'COMMON.INTERACT'
7468 include 'COMMON.CONTACTS'
7469 include 'COMMON.TORSION'
7470 include 'COMMON.VAR'
7471 include 'COMMON.GEO'
7472 double precision pizda(2,2),ggg1(3),ggg2(3)
7473 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7477 cd print *,'eello4:',i,j,k,l,jj,kk
7478 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7479 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7480 cold eij=facont_hb(jj,i)
7481 cold ekl=facont_hb(kk,k)
7483 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7484 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7485 gcorr_loc(k-1)=gcorr_loc(k-1)
7486 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7488 gcorr_loc(l-1)=gcorr_loc(l-1)
7489 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7491 gcorr_loc(j-1)=gcorr_loc(j-1)
7492 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7497 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7498 & -EAEAderx(2,2,lll,kkk,iii,1)
7499 cd derx(lll,kkk,iii)=0.0d0
7503 cd gcorr_loc(l-1)=0.0d0
7504 cd gcorr_loc(j-1)=0.0d0
7505 cd gcorr_loc(k-1)=0.0d0
7507 cd write (iout,*)'Contacts have occurred for peptide groups',
7508 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7509 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7510 if (j.lt.nres-1) then
7517 if (l.lt.nres-1) then
7525 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7526 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7527 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7528 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7529 cgrad ghalf=0.5d0*ggg1(ll)
7530 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7531 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7532 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7533 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7534 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7535 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7536 cgrad ghalf=0.5d0*ggg2(ll)
7537 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7538 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7539 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7540 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7541 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7542 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7546 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7551 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7556 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7561 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7565 cd write (2,*) iii,gcorr_loc(iii)
7568 cd write (2,*) 'ekont',ekont
7569 cd write (iout,*) 'eello4',ekont*eel4
7572 C---------------------------------------------------------------------------
7573 double precision function eello5(i,j,k,l,jj,kk)
7574 implicit real*8 (a-h,o-z)
7575 include 'DIMENSIONS'
7576 include 'COMMON.IOUNITS'
7577 include 'COMMON.CHAIN'
7578 include 'COMMON.DERIV'
7579 include 'COMMON.INTERACT'
7580 include 'COMMON.CONTACTS'
7581 include 'COMMON.TORSION'
7582 include 'COMMON.VAR'
7583 include 'COMMON.GEO'
7584 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7585 double precision ggg1(3),ggg2(3)
7586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7591 C /l\ / \ \ / \ / \ / C
7592 C / \ / \ \ / \ / \ / C
7593 C j| o |l1 | o | o| o | | o |o C
7594 C \ |/k\| |/ \| / |/ \| |/ \| C
7595 C \i/ \ / \ / / \ / \ C
7597 C (I) (II) (III) (IV) C
7599 C eello5_1 eello5_2 eello5_3 eello5_4 C
7601 C Antiparallel chains C
7604 C /j\ / \ \ / \ / \ / C
7605 C / \ / \ \ / \ / \ / C
7606 C j1| o |l | o | o| o | | o |o C
7607 C \ |/k\| |/ \| / |/ \| |/ \| C
7608 C \i/ \ / \ / / \ / \ C
7610 C (I) (II) (III) (IV) C
7612 C eello5_1 eello5_2 eello5_3 eello5_4 C
7614 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7616 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7617 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7622 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7624 itk=itortyp(itype(k))
7625 itl=itortyp(itype(l))
7626 itj=itortyp(itype(j))
7631 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7632 cd & eel5_3_num,eel5_4_num)
7636 derx(lll,kkk,iii)=0.0d0
7640 cd eij=facont_hb(jj,i)
7641 cd ekl=facont_hb(kk,k)
7643 cd write (iout,*)'Contacts have occurred for peptide groups',
7644 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7646 C Contribution from the graph I.
7647 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7648 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7649 call transpose2(EUg(1,1,k),auxmat(1,1))
7650 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7651 vv(1)=pizda(1,1)-pizda(2,2)
7652 vv(2)=pizda(1,2)+pizda(2,1)
7653 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7654 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7655 C Explicit gradient in virtual-dihedral angles.
7656 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7657 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7658 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7659 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7660 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7661 vv(1)=pizda(1,1)-pizda(2,2)
7662 vv(2)=pizda(1,2)+pizda(2,1)
7663 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7664 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7665 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7666 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7667 vv(1)=pizda(1,1)-pizda(2,2)
7668 vv(2)=pizda(1,2)+pizda(2,1)
7670 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7671 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7672 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7674 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7675 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7676 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7678 C Cartesian gradient
7682 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7684 vv(1)=pizda(1,1)-pizda(2,2)
7685 vv(2)=pizda(1,2)+pizda(2,1)
7686 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7687 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7688 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7694 C Contribution from graph II
7695 call transpose2(EE(1,1,itk),auxmat(1,1))
7696 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7697 vv(1)=pizda(1,1)+pizda(2,2)
7698 vv(2)=pizda(2,1)-pizda(1,2)
7699 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7700 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7701 C Explicit gradient in virtual-dihedral angles.
7702 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7703 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7704 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7705 vv(1)=pizda(1,1)+pizda(2,2)
7706 vv(2)=pizda(2,1)-pizda(1,2)
7708 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7709 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7710 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7712 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7713 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7714 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7716 C Cartesian gradient
7720 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7722 vv(1)=pizda(1,1)+pizda(2,2)
7723 vv(2)=pizda(2,1)-pizda(1,2)
7724 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7725 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7726 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7734 C Parallel orientation
7735 C Contribution from graph III
7736 call transpose2(EUg(1,1,l),auxmat(1,1))
7737 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7738 vv(1)=pizda(1,1)-pizda(2,2)
7739 vv(2)=pizda(1,2)+pizda(2,1)
7740 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7741 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7742 C Explicit gradient in virtual-dihedral angles.
7743 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7744 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7745 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7746 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7747 vv(1)=pizda(1,1)-pizda(2,2)
7748 vv(2)=pizda(1,2)+pizda(2,1)
7749 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7750 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7751 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7752 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7753 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7754 vv(1)=pizda(1,1)-pizda(2,2)
7755 vv(2)=pizda(1,2)+pizda(2,1)
7756 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7757 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7758 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7759 C Cartesian gradient
7763 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7765 vv(1)=pizda(1,1)-pizda(2,2)
7766 vv(2)=pizda(1,2)+pizda(2,1)
7767 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7768 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7769 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7774 C Contribution from graph IV
7776 call transpose2(EE(1,1,itl),auxmat(1,1))
7777 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7778 vv(1)=pizda(1,1)+pizda(2,2)
7779 vv(2)=pizda(2,1)-pizda(1,2)
7780 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7781 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7782 C Explicit gradient in virtual-dihedral angles.
7783 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7784 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7785 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7786 vv(1)=pizda(1,1)+pizda(2,2)
7787 vv(2)=pizda(2,1)-pizda(1,2)
7788 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7789 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7790 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7791 C Cartesian gradient
7795 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7797 vv(1)=pizda(1,1)+pizda(2,2)
7798 vv(2)=pizda(2,1)-pizda(1,2)
7799 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7800 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7801 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7806 C Antiparallel orientation
7807 C Contribution from graph III
7809 call transpose2(EUg(1,1,j),auxmat(1,1))
7810 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7811 vv(1)=pizda(1,1)-pizda(2,2)
7812 vv(2)=pizda(1,2)+pizda(2,1)
7813 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7814 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7815 C Explicit gradient in virtual-dihedral angles.
7816 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7817 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7818 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7819 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7820 vv(1)=pizda(1,1)-pizda(2,2)
7821 vv(2)=pizda(1,2)+pizda(2,1)
7822 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7823 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7824 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7825 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7826 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7827 vv(1)=pizda(1,1)-pizda(2,2)
7828 vv(2)=pizda(1,2)+pizda(2,1)
7829 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7830 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7831 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7832 C Cartesian gradient
7836 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7838 vv(1)=pizda(1,1)-pizda(2,2)
7839 vv(2)=pizda(1,2)+pizda(2,1)
7840 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7841 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7842 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7847 C Contribution from graph IV
7849 call transpose2(EE(1,1,itj),auxmat(1,1))
7850 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7851 vv(1)=pizda(1,1)+pizda(2,2)
7852 vv(2)=pizda(2,1)-pizda(1,2)
7853 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7854 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7855 C Explicit gradient in virtual-dihedral angles.
7856 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7857 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7858 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7859 vv(1)=pizda(1,1)+pizda(2,2)
7860 vv(2)=pizda(2,1)-pizda(1,2)
7861 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7862 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7863 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7864 C Cartesian gradient
7868 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7870 vv(1)=pizda(1,1)+pizda(2,2)
7871 vv(2)=pizda(2,1)-pizda(1,2)
7872 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7873 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7874 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7880 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7881 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7882 cd write (2,*) 'ijkl',i,j,k,l
7883 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7884 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7886 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7887 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7888 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7889 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7890 if (j.lt.nres-1) then
7897 if (l.lt.nres-1) then
7907 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7908 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7909 C summed up outside the subrouine as for the other subroutines
7910 C handling long-range interactions. The old code is commented out
7911 C with "cgrad" to keep track of changes.
7913 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7914 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7915 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7916 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7917 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7918 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7919 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7920 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7921 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7922 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7924 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7925 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7926 cgrad ghalf=0.5d0*ggg1(ll)
7928 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7929 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7930 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7931 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7932 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7933 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7934 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7935 cgrad ghalf=0.5d0*ggg2(ll)
7937 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7938 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7939 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7940 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7941 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7942 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7947 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7948 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7953 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7954 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7960 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7965 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7969 cd write (2,*) iii,g_corr5_loc(iii)
7972 cd write (2,*) 'ekont',ekont
7973 cd write (iout,*) 'eello5',ekont*eel5
7976 c--------------------------------------------------------------------------
7977 double precision function eello6(i,j,k,l,jj,kk)
7978 implicit real*8 (a-h,o-z)
7979 include 'DIMENSIONS'
7980 include 'COMMON.IOUNITS'
7981 include 'COMMON.CHAIN'
7982 include 'COMMON.DERIV'
7983 include 'COMMON.INTERACT'
7984 include 'COMMON.CONTACTS'
7985 include 'COMMON.TORSION'
7986 include 'COMMON.VAR'
7987 include 'COMMON.GEO'
7988 include 'COMMON.FFIELD'
7989 double precision ggg1(3),ggg2(3)
7990 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7995 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8003 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8004 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8008 derx(lll,kkk,iii)=0.0d0
8012 cd eij=facont_hb(jj,i)
8013 cd ekl=facont_hb(kk,k)
8019 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8020 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8021 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8022 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8023 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8024 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8026 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8027 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8028 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8029 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8030 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8031 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8035 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8037 C If turn contributions are considered, they will be handled separately.
8038 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8039 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8040 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8041 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8042 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8043 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8044 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8046 if (j.lt.nres-1) then
8053 if (l.lt.nres-1) then
8061 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8062 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8063 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8064 cgrad ghalf=0.5d0*ggg1(ll)
8066 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8067 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8068 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8069 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8070 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8071 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8072 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8073 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8074 cgrad ghalf=0.5d0*ggg2(ll)
8075 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8077 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8078 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8079 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8080 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8081 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8082 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8087 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8088 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8093 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8094 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8100 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8105 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8109 cd write (2,*) iii,g_corr6_loc(iii)
8112 cd write (2,*) 'ekont',ekont
8113 cd write (iout,*) 'eello6',ekont*eel6
8116 c--------------------------------------------------------------------------
8117 double precision function eello6_graph1(i,j,k,l,imat,swap)
8118 implicit real*8 (a-h,o-z)
8119 include 'DIMENSIONS'
8120 include 'COMMON.IOUNITS'
8121 include 'COMMON.CHAIN'
8122 include 'COMMON.DERIV'
8123 include 'COMMON.INTERACT'
8124 include 'COMMON.CONTACTS'
8125 include 'COMMON.TORSION'
8126 include 'COMMON.VAR'
8127 include 'COMMON.GEO'
8128 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8132 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8134 C Parallel Antiparallel C
8140 C \ j|/k\| / \ |/k\|l / C
8145 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8146 itk=itortyp(itype(k))
8147 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8148 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8149 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8150 call transpose2(EUgC(1,1,k),auxmat(1,1))
8151 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8152 vv1(1)=pizda1(1,1)-pizda1(2,2)
8153 vv1(2)=pizda1(1,2)+pizda1(2,1)
8154 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8155 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8156 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8157 s5=scalar2(vv(1),Dtobr2(1,i))
8158 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8159 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8160 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8161 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8162 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8163 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8164 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8165 & +scalar2(vv(1),Dtobr2der(1,i)))
8166 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8167 vv1(1)=pizda1(1,1)-pizda1(2,2)
8168 vv1(2)=pizda1(1,2)+pizda1(2,1)
8169 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8170 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8172 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8173 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8174 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8175 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8176 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8178 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8179 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8180 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8181 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8182 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8184 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8185 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8186 vv1(1)=pizda1(1,1)-pizda1(2,2)
8187 vv1(2)=pizda1(1,2)+pizda1(2,1)
8188 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8189 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8190 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8191 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8200 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8201 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8202 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8203 call transpose2(EUgC(1,1,k),auxmat(1,1))
8204 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8206 vv1(1)=pizda1(1,1)-pizda1(2,2)
8207 vv1(2)=pizda1(1,2)+pizda1(2,1)
8208 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8209 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8210 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8211 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8212 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8213 s5=scalar2(vv(1),Dtobr2(1,i))
8214 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8220 c----------------------------------------------------------------------------
8221 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8222 implicit real*8 (a-h,o-z)
8223 include 'DIMENSIONS'
8224 include 'COMMON.IOUNITS'
8225 include 'COMMON.CHAIN'
8226 include 'COMMON.DERIV'
8227 include 'COMMON.INTERACT'
8228 include 'COMMON.CONTACTS'
8229 include 'COMMON.TORSION'
8230 include 'COMMON.VAR'
8231 include 'COMMON.GEO'
8233 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8234 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8237 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8239 C Parallel Antiparallel C
8245 C \ j|/k\| \ |/k\|l C
8250 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8251 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8252 C AL 7/4/01 s1 would occur in the sixth-order moment,
8253 C but not in a cluster cumulant
8255 s1=dip(1,jj,i)*dip(1,kk,k)
8257 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8258 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8259 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8260 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8261 call transpose2(EUg(1,1,k),auxmat(1,1))
8262 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8263 vv(1)=pizda(1,1)-pizda(2,2)
8264 vv(2)=pizda(1,2)+pizda(2,1)
8265 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8266 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8268 eello6_graph2=-(s1+s2+s3+s4)
8270 eello6_graph2=-(s2+s3+s4)
8273 C Derivatives in gamma(i-1)
8276 s1=dipderg(1,jj,i)*dip(1,kk,k)
8278 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8279 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8280 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8281 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8283 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8285 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8287 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8289 C Derivatives in gamma(k-1)
8291 s1=dip(1,jj,i)*dipderg(1,kk,k)
8293 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8294 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8295 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8296 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8297 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8298 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8299 vv(1)=pizda(1,1)-pizda(2,2)
8300 vv(2)=pizda(1,2)+pizda(2,1)
8301 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8303 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8305 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8307 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8308 C Derivatives in gamma(j-1) or gamma(l-1)
8311 s1=dipderg(3,jj,i)*dip(1,kk,k)
8313 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8315 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8316 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8317 vv(1)=pizda(1,1)-pizda(2,2)
8318 vv(2)=pizda(1,2)+pizda(2,1)
8319 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8322 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8324 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8327 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8328 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8330 C Derivatives in gamma(l-1) or gamma(j-1)
8333 s1=dip(1,jj,i)*dipderg(3,kk,k)
8335 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8336 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8337 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8338 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8339 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8340 vv(1)=pizda(1,1)-pizda(2,2)
8341 vv(2)=pizda(1,2)+pizda(2,1)
8342 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8345 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8347 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8350 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8351 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8353 C Cartesian derivatives.
8355 write (2,*) 'In eello6_graph2'
8357 write (2,*) 'iii=',iii
8359 write (2,*) 'kkk=',kkk
8361 write (2,'(3(2f10.5),5x)')
8362 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8372 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8374 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8377 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8379 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8380 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8382 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8383 call transpose2(EUg(1,1,k),auxmat(1,1))
8384 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8386 vv(1)=pizda(1,1)-pizda(2,2)
8387 vv(2)=pizda(1,2)+pizda(2,1)
8388 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8389 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8391 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8393 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8396 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8398 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8405 c----------------------------------------------------------------------------
8406 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8407 implicit real*8 (a-h,o-z)
8408 include 'DIMENSIONS'
8409 include 'COMMON.IOUNITS'
8410 include 'COMMON.CHAIN'
8411 include 'COMMON.DERIV'
8412 include 'COMMON.INTERACT'
8413 include 'COMMON.CONTACTS'
8414 include 'COMMON.TORSION'
8415 include 'COMMON.VAR'
8416 include 'COMMON.GEO'
8417 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8419 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8421 C Parallel Antiparallel C
8427 C j|/k\| / |/k\|l / C
8432 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8434 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8435 C energy moment and not to the cluster cumulant.
8436 iti=itortyp(itype(i))
8437 if (j.lt.nres-1) then
8438 itj1=itortyp(itype(j+1))
8442 itk=itortyp(itype(k))
8443 itk1=itortyp(itype(k+1))
8444 if (l.lt.nres-1) then
8445 itl1=itortyp(itype(l+1))
8450 s1=dip(4,jj,i)*dip(4,kk,k)
8452 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8453 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8454 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8455 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8456 call transpose2(EE(1,1,itk),auxmat(1,1))
8457 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8458 vv(1)=pizda(1,1)+pizda(2,2)
8459 vv(2)=pizda(2,1)-pizda(1,2)
8460 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8461 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8462 cd & "sum",-(s2+s3+s4)
8464 eello6_graph3=-(s1+s2+s3+s4)
8466 eello6_graph3=-(s2+s3+s4)
8469 C Derivatives in gamma(k-1)
8470 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8471 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8472 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8473 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8474 C Derivatives in gamma(l-1)
8475 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8476 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8477 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8478 vv(1)=pizda(1,1)+pizda(2,2)
8479 vv(2)=pizda(2,1)-pizda(1,2)
8480 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8481 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8482 C Cartesian derivatives.
8488 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8490 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8493 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8495 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8496 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8498 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8499 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8501 vv(1)=pizda(1,1)+pizda(2,2)
8502 vv(2)=pizda(2,1)-pizda(1,2)
8503 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8505 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8507 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8510 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8512 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8514 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8520 c----------------------------------------------------------------------------
8521 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8522 implicit real*8 (a-h,o-z)
8523 include 'DIMENSIONS'
8524 include 'COMMON.IOUNITS'
8525 include 'COMMON.CHAIN'
8526 include 'COMMON.DERIV'
8527 include 'COMMON.INTERACT'
8528 include 'COMMON.CONTACTS'
8529 include 'COMMON.TORSION'
8530 include 'COMMON.VAR'
8531 include 'COMMON.GEO'
8532 include 'COMMON.FFIELD'
8533 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8534 & auxvec1(2),auxmat1(2,2)
8536 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8538 C Parallel Antiparallel C
8544 C \ j|/k\| \ |/k\|l C
8549 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8551 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8552 C energy moment and not to the cluster cumulant.
8553 cd write (2,*) 'eello_graph4: wturn6',wturn6
8554 iti=itortyp(itype(i))
8555 itj=itortyp(itype(j))
8556 if (j.lt.nres-1) then
8557 itj1=itortyp(itype(j+1))
8561 itk=itortyp(itype(k))
8562 if (k.lt.nres-1) then
8563 itk1=itortyp(itype(k+1))
8567 itl=itortyp(itype(l))
8568 if (l.lt.nres-1) then
8569 itl1=itortyp(itype(l+1))
8573 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8574 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8575 cd & ' itl',itl,' itl1',itl1
8578 s1=dip(3,jj,i)*dip(3,kk,k)
8580 s1=dip(2,jj,j)*dip(2,kk,l)
8583 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8584 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8586 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8587 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8589 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8590 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8592 call transpose2(EUg(1,1,k),auxmat(1,1))
8593 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8594 vv(1)=pizda(1,1)-pizda(2,2)
8595 vv(2)=pizda(2,1)+pizda(1,2)
8596 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8597 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8599 eello6_graph4=-(s1+s2+s3+s4)
8601 eello6_graph4=-(s2+s3+s4)
8603 C Derivatives in gamma(i-1)
8607 s1=dipderg(2,jj,i)*dip(3,kk,k)
8609 s1=dipderg(4,jj,j)*dip(2,kk,l)
8612 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8614 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8615 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8617 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8618 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8620 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8621 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8622 cd write (2,*) 'turn6 derivatives'
8624 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8626 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8630 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8632 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8636 C Derivatives in gamma(k-1)
8639 s1=dip(3,jj,i)*dipderg(2,kk,k)
8641 s1=dip(2,jj,j)*dipderg(4,kk,l)
8644 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8645 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8647 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8648 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8650 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8651 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8653 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8654 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8655 vv(1)=pizda(1,1)-pizda(2,2)
8656 vv(2)=pizda(2,1)+pizda(1,2)
8657 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8658 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8660 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8662 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8666 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8668 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8671 C Derivatives in gamma(j-1) or gamma(l-1)
8672 if (l.eq.j+1 .and. l.gt.1) then
8673 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8674 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8675 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8676 vv(1)=pizda(1,1)-pizda(2,2)
8677 vv(2)=pizda(2,1)+pizda(1,2)
8678 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8679 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8680 else if (j.gt.1) then
8681 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8682 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8683 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8684 vv(1)=pizda(1,1)-pizda(2,2)
8685 vv(2)=pizda(2,1)+pizda(1,2)
8686 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8687 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8688 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8690 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8693 C Cartesian derivatives.
8700 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8702 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8706 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8708 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8712 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8714 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8716 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8717 & b1(1,j+1),auxvec(1))
8718 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8720 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8721 & b1(1,l+1),auxvec(1))
8722 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8724 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8726 vv(1)=pizda(1,1)-pizda(2,2)
8727 vv(2)=pizda(2,1)+pizda(1,2)
8728 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8730 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8732 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8735 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8738 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8741 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8743 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8745 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8749 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8751 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8754 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8756 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8764 c----------------------------------------------------------------------------
8765 double precision function eello_turn6(i,jj,kk)
8766 implicit real*8 (a-h,o-z)
8767 include 'DIMENSIONS'
8768 include 'COMMON.IOUNITS'
8769 include 'COMMON.CHAIN'
8770 include 'COMMON.DERIV'
8771 include 'COMMON.INTERACT'
8772 include 'COMMON.CONTACTS'
8773 include 'COMMON.TORSION'
8774 include 'COMMON.VAR'
8775 include 'COMMON.GEO'
8776 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8777 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8779 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8780 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8781 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8782 C the respective energy moment and not to the cluster cumulant.
8791 iti=itortyp(itype(i))
8792 itk=itortyp(itype(k))
8793 itk1=itortyp(itype(k+1))
8794 itl=itortyp(itype(l))
8795 itj=itortyp(itype(j))
8796 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8797 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8798 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8803 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8805 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8809 derx_turn(lll,kkk,iii)=0.0d0
8816 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8818 cd write (2,*) 'eello6_5',eello6_5
8820 call transpose2(AEA(1,1,1),auxmat(1,1))
8821 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8822 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8823 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8825 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8826 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8827 s2 = scalar2(b1(1,k),vtemp1(1))
8829 call transpose2(AEA(1,1,2),atemp(1,1))
8830 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8831 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8832 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8834 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8835 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8836 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8838 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8839 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8840 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8841 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8842 ss13 = scalar2(b1(1,k),vtemp4(1))
8843 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8845 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8851 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8852 C Derivatives in gamma(i+2)
8856 call transpose2(AEA(1,1,1),auxmatd(1,1))
8857 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8858 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8859 call transpose2(AEAderg(1,1,2),atempd(1,1))
8860 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8861 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8863 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8864 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8865 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8871 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8872 C Derivatives in gamma(i+3)
8874 call transpose2(AEA(1,1,1),auxmatd(1,1))
8875 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8876 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8877 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8879 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8880 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8881 s2d = scalar2(b1(1,k),vtemp1d(1))
8883 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8884 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8886 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8888 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8889 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8890 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8898 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8899 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8901 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8902 & -0.5d0*ekont*(s2d+s12d)
8904 C Derivatives in gamma(i+4)
8905 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8906 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8907 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8909 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8910 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8911 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8919 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8921 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8923 C Derivatives in gamma(i+5)
8925 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8926 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8927 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8929 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8930 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8931 s2d = scalar2(b1(1,k),vtemp1d(1))
8933 call transpose2(AEA(1,1,2),atempd(1,1))
8934 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8935 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8937 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8938 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8940 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8941 ss13d = scalar2(b1(1,k),vtemp4d(1))
8942 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8950 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8951 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8953 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8954 & -0.5d0*ekont*(s2d+s12d)
8956 C Cartesian derivatives
8961 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8962 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8963 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8965 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8966 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8968 s2d = scalar2(b1(1,k),vtemp1d(1))
8970 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8971 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8972 s8d = -(atempd(1,1)+atempd(2,2))*
8973 & scalar2(cc(1,1,itl),vtemp2(1))
8975 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8977 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8978 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8985 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8988 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8992 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8993 & - 0.5d0*(s8d+s12d)
8995 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9004 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9006 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9007 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9008 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9009 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9010 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9012 ss13d = scalar2(b1(1,k),vtemp4d(1))
9013 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9014 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9018 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9019 cd & 16*eel_turn6_num
9021 if (j.lt.nres-1) then
9028 if (l.lt.nres-1) then
9036 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9037 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9038 cgrad ghalf=0.5d0*ggg1(ll)
9040 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9041 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9042 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9043 & +ekont*derx_turn(ll,2,1)
9044 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9045 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9046 & +ekont*derx_turn(ll,4,1)
9047 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9048 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9049 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9050 cgrad ghalf=0.5d0*ggg2(ll)
9052 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9053 & +ekont*derx_turn(ll,2,2)
9054 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9055 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9056 & +ekont*derx_turn(ll,4,2)
9057 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9058 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9059 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9064 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9069 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9075 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9080 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9084 cd write (2,*) iii,g_corr6_loc(iii)
9086 eello_turn6=ekont*eel_turn6
9087 cd write (2,*) 'ekont',ekont
9088 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9092 C-----------------------------------------------------------------------------
9093 double precision function scalar(u,v)
9094 !DIR$ INLINEALWAYS scalar
9096 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9099 double precision u(3),v(3)
9100 cd double precision sc
9108 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9111 crc-------------------------------------------------
9112 SUBROUTINE MATVEC2(A1,V1,V2)
9113 !DIR$ INLINEALWAYS MATVEC2
9115 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9117 implicit real*8 (a-h,o-z)
9118 include 'DIMENSIONS'
9119 DIMENSION A1(2,2),V1(2),V2(2)
9123 c 3 VI=VI+A1(I,K)*V1(K)
9127 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9128 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9133 C---------------------------------------
9134 SUBROUTINE MATMAT2(A1,A2,A3)
9136 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9138 implicit real*8 (a-h,o-z)
9139 include 'DIMENSIONS'
9140 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9141 c DIMENSION AI3(2,2)
9145 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9151 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9152 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9153 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9154 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9162 c-------------------------------------------------------------------------
9163 double precision function scalar2(u,v)
9164 !DIR$ INLINEALWAYS scalar2
9166 double precision u(2),v(2)
9169 scalar2=u(1)*v(1)+u(2)*v(2)
9173 C-----------------------------------------------------------------------------
9175 subroutine transpose2(a,at)
9176 !DIR$ INLINEALWAYS transpose2
9178 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9181 double precision a(2,2),at(2,2)
9188 c--------------------------------------------------------------------------
9189 subroutine transpose(n,a,at)
9192 double precision a(n,n),at(n,n)
9200 C---------------------------------------------------------------------------
9201 subroutine prodmat3(a1,a2,kk,transp,prod)
9202 !DIR$ INLINEALWAYS prodmat3
9204 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9208 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9210 crc double precision auxmat(2,2),prod_(2,2)
9213 crc call transpose2(kk(1,1),auxmat(1,1))
9214 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9215 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9217 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9218 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9219 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9220 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9221 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9222 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9223 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9224 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9227 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9228 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9230 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9231 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9232 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9233 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9234 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9235 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9236 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9237 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9240 c call transpose2(a2(1,1),a2t(1,1))
9243 crc print *,((prod_(i,j),i=1,2),j=1,2)
9244 crc print *,((prod(i,j),i=1,2),j=1,2)