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 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)*sin(theta(i-1)/2.0)
2275 & +bnew1(2,1,iti)*sin(theta(i-1))
2276 & +bnew1(3,1,iti)*cos(theta(i-1)/2.0)
2277 gtb1(1,i-2)=bnew1(1,1,iti)*cos(theta(i-1)/2.0)/2.0
2278 & +bnew1(2,1,iti)*cos(theta(i-1))
2279 & -bnew1(3,1,iti)*sin(theta(i-1)/2.0)/2.0
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)*sin(theta(i-1)/2.0)
2283 & +bnew2(2,1,iti)*sin(theta(i-1))
2284 & +bnew2(3,1,iti)*cos(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)*cos(theta(i-1)/2.0)/2.0
2288 & +bnew2(2,1,iti)*cos(theta(i-1))
2289 & -bnew2(3,1,iti)*sin(theta(i-1)/2.0)/2.0
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 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2318 write (iout,*) 'theta=', theta(i-1)
2321 do i=ivec_start+2,ivec_end+2
2326 if (i .lt. nres+1) then
2363 if (i .gt. 3 .and. i .lt. nres+1) then
2364 obrot_der(1,i-2)=-sin1
2365 obrot_der(2,i-2)= cos1
2366 Ugder(1,1,i-2)= sin1
2367 Ugder(1,2,i-2)=-cos1
2368 Ugder(2,1,i-2)=-cos1
2369 Ugder(2,2,i-2)=-sin1
2372 obrot2_der(1,i-2)=-dwasin2
2373 obrot2_der(2,i-2)= dwacos2
2374 Ug2der(1,1,i-2)= dwasin2
2375 Ug2der(1,2,i-2)=-dwacos2
2376 Ug2der(2,1,i-2)=-dwacos2
2377 Ug2der(2,2,i-2)=-dwasin2
2379 obrot_der(1,i-2)=0.0d0
2380 obrot_der(2,i-2)=0.0d0
2381 Ugder(1,1,i-2)=0.0d0
2382 Ugder(1,2,i-2)=0.0d0
2383 Ugder(2,1,i-2)=0.0d0
2384 Ugder(2,2,i-2)=0.0d0
2385 obrot2_der(1,i-2)=0.0d0
2386 obrot2_der(2,i-2)=0.0d0
2387 Ug2der(1,1,i-2)=0.0d0
2388 Ug2der(1,2,i-2)=0.0d0
2389 Ug2der(2,1,i-2)=0.0d0
2390 Ug2der(2,2,i-2)=0.0d0
2392 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2393 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2394 iti = itortyp(itype(i-2))
2398 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2399 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2400 iti1 = itortyp(itype(i-1))
2404 cd write (iout,*) '*******i',i,' iti1',iti
2405 cd write (iout,*) 'b1',b1(:,iti)
2406 cd write (iout,*) 'b2',b2(:,iti)
2407 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2408 c if (i .gt. iatel_s+2) then
2409 if (i .gt. nnt+2) then
2410 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2412 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2413 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2415 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2416 c & EE(1,2,iti),EE(2,2,iti)
2417 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2418 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2419 c write(iout,*) "Macierz EUG",
2420 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2422 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2424 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2425 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2426 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2427 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2428 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2439 DtUg2(l,k,i-2)=0.0d0
2443 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2444 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2446 muder(k,i-2)=Ub2der(k,i-2)
2448 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2449 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2450 if (itype(i-1).le.ntyp) then
2451 iti1 = itortyp(itype(i-1))
2459 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2461 cd write (iout,*) 'mu ',mu(:,i-2)
2462 cd write (iout,*) 'mu1',mu1(:,i-2)
2463 cd write (iout,*) 'mu2',mu2(:,i-2)
2464 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2466 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2467 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2468 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2469 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2470 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2471 C Vectors and matrices dependent on a single virtual-bond dihedral.
2472 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2473 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2474 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2475 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2476 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2477 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2478 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2479 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2480 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2483 C Matrices dependent on two consecutive virtual-bond dihedrals.
2484 C The order of matrices is from left to right.
2485 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2487 c do i=max0(ivec_start,2),ivec_end
2489 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2490 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2491 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2492 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2493 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2494 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2495 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2496 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2499 #if defined(MPI) && defined(PARMAT)
2501 c if (fg_rank.eq.0) then
2502 write (iout,*) "Arrays UG and UGDER before GATHER"
2504 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2505 & ((ug(l,k,i),l=1,2),k=1,2),
2506 & ((ugder(l,k,i),l=1,2),k=1,2)
2508 write (iout,*) "Arrays UG2 and UG2DER"
2510 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2511 & ((ug2(l,k,i),l=1,2),k=1,2),
2512 & ((ug2der(l,k,i),l=1,2),k=1,2)
2514 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2516 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2517 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2518 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2520 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2522 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2523 & costab(i),sintab(i),costab2(i),sintab2(i)
2525 write (iout,*) "Array MUDER"
2527 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2531 if (nfgtasks.gt.1) then
2533 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2534 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2535 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2537 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2538 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2540 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2543 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2544 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2546 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2547 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2549 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2550 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2552 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2553 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2555 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2556 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2557 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2558 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2559 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2560 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2561 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2562 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2563 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2564 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2565 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2566 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2567 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2569 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2570 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2572 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2573 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2575 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2576 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2578 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2579 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2581 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2582 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2584 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2585 & ivec_count(fg_rank1),
2586 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2588 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2589 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2591 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2592 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2594 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2595 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2597 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2598 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2600 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2601 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2603 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2604 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2606 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2607 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2609 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2610 & ivec_count(fg_rank1),
2611 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2613 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2614 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2616 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2617 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2619 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2620 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2622 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2623 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2625 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2626 & ivec_count(fg_rank1),
2627 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2629 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2630 & ivec_count(fg_rank1),
2631 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2633 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2634 & ivec_count(fg_rank1),
2635 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2636 & MPI_MAT2,FG_COMM1,IERR)
2637 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2638 & ivec_count(fg_rank1),
2639 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2640 & MPI_MAT2,FG_COMM1,IERR)
2643 c Passes matrix info through the ring
2646 if (irecv.lt.0) irecv=nfgtasks1-1
2649 if (inext.ge.nfgtasks1) inext=0
2651 c write (iout,*) "isend",isend," irecv",irecv
2653 lensend=lentyp(isend)
2654 lenrecv=lentyp(irecv)
2655 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2656 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2657 c & MPI_ROTAT1(lensend),inext,2200+isend,
2658 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2659 c & iprev,2200+irecv,FG_COMM,status,IERR)
2660 c write (iout,*) "Gather ROTAT1"
2662 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2663 c & MPI_ROTAT2(lensend),inext,3300+isend,
2664 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2665 c & iprev,3300+irecv,FG_COMM,status,IERR)
2666 c write (iout,*) "Gather ROTAT2"
2668 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2669 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2670 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2671 & iprev,4400+irecv,FG_COMM,status,IERR)
2672 c write (iout,*) "Gather ROTAT_OLD"
2674 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2675 & MPI_PRECOMP11(lensend),inext,5500+isend,
2676 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2677 & iprev,5500+irecv,FG_COMM,status,IERR)
2678 c write (iout,*) "Gather PRECOMP11"
2680 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2681 & MPI_PRECOMP12(lensend),inext,6600+isend,
2682 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2683 & iprev,6600+irecv,FG_COMM,status,IERR)
2684 c write (iout,*) "Gather PRECOMP12"
2686 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2688 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2689 & MPI_ROTAT2(lensend),inext,7700+isend,
2690 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2691 & iprev,7700+irecv,FG_COMM,status,IERR)
2692 c write (iout,*) "Gather PRECOMP21"
2694 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2695 & MPI_PRECOMP22(lensend),inext,8800+isend,
2696 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2697 & iprev,8800+irecv,FG_COMM,status,IERR)
2698 c write (iout,*) "Gather PRECOMP22"
2700 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2701 & MPI_PRECOMP23(lensend),inext,9900+isend,
2702 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2703 & MPI_PRECOMP23(lenrecv),
2704 & iprev,9900+irecv,FG_COMM,status,IERR)
2705 c write (iout,*) "Gather PRECOMP23"
2710 if (irecv.lt.0) irecv=nfgtasks1-1
2713 time_gather=time_gather+MPI_Wtime()-time00
2716 c if (fg_rank.eq.0) then
2717 write (iout,*) "Arrays UG and UGDER"
2719 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2720 & ((ug(l,k,i),l=1,2),k=1,2),
2721 & ((ugder(l,k,i),l=1,2),k=1,2)
2723 write (iout,*) "Arrays UG2 and UG2DER"
2725 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2726 & ((ug2(l,k,i),l=1,2),k=1,2),
2727 & ((ug2der(l,k,i),l=1,2),k=1,2)
2729 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2731 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2732 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2733 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2735 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2737 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2738 & costab(i),sintab(i),costab2(i),sintab2(i)
2740 write (iout,*) "Array MUDER"
2742 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2748 cd iti = itortyp(itype(i))
2751 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2752 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2757 C--------------------------------------------------------------------------
2758 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2760 C This subroutine calculates the average interaction energy and its gradient
2761 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2762 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2763 C The potential depends both on the distance of peptide-group centers and on
2764 C the orientation of the CA-CA virtual bonds.
2766 implicit real*8 (a-h,o-z)
2770 include 'DIMENSIONS'
2771 include 'COMMON.CONTROL'
2772 include 'COMMON.SETUP'
2773 include 'COMMON.IOUNITS'
2774 include 'COMMON.GEO'
2775 include 'COMMON.VAR'
2776 include 'COMMON.LOCAL'
2777 include 'COMMON.CHAIN'
2778 include 'COMMON.DERIV'
2779 include 'COMMON.INTERACT'
2780 include 'COMMON.CONTACTS'
2781 include 'COMMON.TORSION'
2782 include 'COMMON.VECTORS'
2783 include 'COMMON.FFIELD'
2784 include 'COMMON.TIME1'
2785 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2786 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2787 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2788 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2789 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2790 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2792 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2794 double precision scal_el /1.0d0/
2796 double precision scal_el /0.5d0/
2799 C 13-go grudnia roku pamietnego...
2800 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2801 & 0.0d0,1.0d0,0.0d0,
2802 & 0.0d0,0.0d0,1.0d0/
2803 cd write(iout,*) 'In EELEC'
2805 cd write(iout,*) 'Type',i
2806 cd write(iout,*) 'B1',B1(:,i)
2807 cd write(iout,*) 'B2',B2(:,i)
2808 cd write(iout,*) 'CC',CC(:,:,i)
2809 cd write(iout,*) 'DD',DD(:,:,i)
2810 cd write(iout,*) 'EE',EE(:,:,i)
2812 cd call check_vecgrad
2814 if (icheckgrad.eq.1) then
2816 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2818 dc_norm(k,i)=dc(k,i)*fac
2820 c write (iout,*) 'i',i,' fac',fac
2823 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2824 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2825 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2826 c call vec_and_deriv
2832 time_mat=time_mat+MPI_Wtime()-time01
2836 cd write (iout,*) 'i=',i
2838 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2841 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2842 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2855 cd print '(a)','Enter EELEC'
2856 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2858 gel_loc_loc(i)=0.0d0
2863 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2865 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2867 do i=iturn3_start,iturn3_end
2868 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2869 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2873 dx_normi=dc_norm(1,i)
2874 dy_normi=dc_norm(2,i)
2875 dz_normi=dc_norm(3,i)
2876 xmedi=c(1,i)+0.5d0*dxi
2877 ymedi=c(2,i)+0.5d0*dyi
2878 zmedi=c(3,i)+0.5d0*dzi
2880 call eelecij(i,i+2,ees,evdw1,eel_loc)
2881 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2882 num_cont_hb(i)=num_conti
2884 do i=iturn4_start,iturn4_end
2885 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2886 & .or. itype(i+3).eq.ntyp1
2887 & .or. itype(i+4).eq.ntyp1) cycle
2891 dx_normi=dc_norm(1,i)
2892 dy_normi=dc_norm(2,i)
2893 dz_normi=dc_norm(3,i)
2894 xmedi=c(1,i)+0.5d0*dxi
2895 ymedi=c(2,i)+0.5d0*dyi
2896 zmedi=c(3,i)+0.5d0*dzi
2897 num_conti=num_cont_hb(i)
2898 c write(iout,*) "JESTEM W PETLI"
2899 call eelecij(i,i+3,ees,evdw1,eel_loc)
2900 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2901 & call eturn4(i,eello_turn4)
2902 num_cont_hb(i)=num_conti
2905 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2907 do i=iatel_s,iatel_e
2909 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2913 dx_normi=dc_norm(1,i)
2914 dy_normi=dc_norm(2,i)
2915 dz_normi=dc_norm(3,i)
2916 xmedi=c(1,i)+0.5d0*dxi
2917 ymedi=c(2,i)+0.5d0*dyi
2918 zmedi=c(3,i)+0.5d0*dzi
2919 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2920 num_conti=num_cont_hb(i)
2921 do j=ielstart(i),ielend(i)
2923 c write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
2924 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2925 call eelecij(i,j,ees,evdw1,eel_loc)
2927 num_cont_hb(i)=num_conti
2929 c write (iout,*) "Number of loop steps in EELEC:",ind
2931 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2932 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2934 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2935 ccc eel_loc=eel_loc+eello_turn3
2936 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2939 C-------------------------------------------------------------------------------
2940 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2941 implicit real*8 (a-h,o-z)
2942 include 'DIMENSIONS'
2946 include 'COMMON.CONTROL'
2947 include 'COMMON.IOUNITS'
2948 include 'COMMON.GEO'
2949 include 'COMMON.VAR'
2950 include 'COMMON.LOCAL'
2951 include 'COMMON.CHAIN'
2952 include 'COMMON.DERIV'
2953 include 'COMMON.INTERACT'
2954 include 'COMMON.CONTACTS'
2955 include 'COMMON.TORSION'
2956 include 'COMMON.VECTORS'
2957 include 'COMMON.FFIELD'
2958 include 'COMMON.TIME1'
2959 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2960 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2961 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2962 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2963 & gmuij2(4),gmuji2(4)
2964 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2965 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2967 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2969 double precision scal_el /1.0d0/
2971 double precision scal_el /0.5d0/
2974 C 13-go grudnia roku pamietnego...
2975 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2976 & 0.0d0,1.0d0,0.0d0,
2977 & 0.0d0,0.0d0,1.0d0/
2978 c time00=MPI_Wtime()
2979 cd write (iout,*) "eelecij",i,j
2983 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2984 aaa=app(iteli,itelj)
2985 bbb=bpp(iteli,itelj)
2986 ael6i=ael6(iteli,itelj)
2987 ael3i=ael3(iteli,itelj)
2991 dx_normj=dc_norm(1,j)
2992 dy_normj=dc_norm(2,j)
2993 dz_normj=dc_norm(3,j)
2994 xj=c(1,j)+0.5D0*dxj-xmedi
2995 yj=c(2,j)+0.5D0*dyj-ymedi
2996 zj=c(3,j)+0.5D0*dzj-zmedi
2997 rij=xj*xj+yj*yj+zj*zj
3003 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3004 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3005 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3006 fac=cosa-3.0D0*cosb*cosg
3008 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3009 if (j.eq.i+2) ev1=scal_el*ev1
3014 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3017 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3018 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3021 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3022 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3023 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3024 cd & xmedi,ymedi,zmedi,xj,yj,zj
3026 if (energy_dec) then
3027 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3029 &,iteli,itelj,aaa,evdw1
3030 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3034 C Calculate contributions to the Cartesian gradient.
3037 facvdw=-6*rrmij*(ev1+evdwij)
3038 facel=-3*rrmij*(el1+eesij)
3044 * Radial derivatives. First process both termini of the fragment (i,j)
3050 c ghalf=0.5D0*ggg(k)
3051 c gelc(k,i)=gelc(k,i)+ghalf
3052 c gelc(k,j)=gelc(k,j)+ghalf
3054 c 9/28/08 AL Gradient compotents will be summed only at the end
3056 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3057 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3060 * Loop over residues i+1 thru j-1.
3064 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3071 c ghalf=0.5D0*ggg(k)
3072 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3073 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3075 c 9/28/08 AL Gradient compotents will be summed only at the end
3077 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3078 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3081 * Loop over residues i+1 thru j-1.
3085 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3092 fac=-3*rrmij*(facvdw+facvdw+facel)
3097 * Radial derivatives. First process both termini of the fragment (i,j)
3103 c ghalf=0.5D0*ggg(k)
3104 c gelc(k,i)=gelc(k,i)+ghalf
3105 c gelc(k,j)=gelc(k,j)+ghalf
3107 c 9/28/08 AL Gradient compotents will be summed only at the end
3109 gelc_long(k,j)=gelc(k,j)+ggg(k)
3110 gelc_long(k,i)=gelc(k,i)-ggg(k)
3113 * Loop over residues i+1 thru j-1.
3117 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3120 c 9/28/08 AL Gradient compotents will be summed only at the end
3125 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3126 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3132 ecosa=2.0D0*fac3*fac1+fac4
3135 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3136 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3138 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3139 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3141 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3142 cd & (dcosg(k),k=1,3)
3144 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3147 c ghalf=0.5D0*ggg(k)
3148 c gelc(k,i)=gelc(k,i)+ghalf
3149 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3150 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3151 c gelc(k,j)=gelc(k,j)+ghalf
3152 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3153 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3157 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3162 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3163 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3165 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3166 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3167 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3168 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3170 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3171 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3172 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3174 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3175 C energy of a peptide unit is assumed in the form of a second-order
3176 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3177 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3178 C are computed for EVERY pair of non-contiguous peptide groups.
3181 if (j.lt.nres-1) then
3193 muij(kkk)=mu(k,i)*mu(l,j)
3195 gmuij1(kkk)=gtb1(k,i)*mu(l,j)
3196 write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(k,i),k,i
3197 gmuij2(kkk)=gUb2(k,i-1)*mu(l,j)
3198 gmuji1(kkk)=mu(k,i)*gtb1(l,j)
3199 write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(l,j),l,j
3200 gmuji2(kkk)=mu(k,i)*gUb2(l,j-1)
3204 cd write (iout,*) 'EELEC: i',i,' j',j
3205 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3206 cd write(iout,*) 'muij',muij
3207 ury=scalar(uy(1,i),erij)
3208 urz=scalar(uz(1,i),erij)
3209 vry=scalar(uy(1,j),erij)
3210 vrz=scalar(uz(1,j),erij)
3211 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3212 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3213 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3214 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3215 fac=dsqrt(-ael6i)*r3ij
3220 cd write (iout,'(4i5,4f10.5)')
3221 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3222 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3223 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3224 cd & uy(:,j),uz(:,j)
3225 cd write (iout,'(4f10.5)')
3226 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3227 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3228 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3229 cd write (iout,'(9f10.5/)')
3230 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3231 C Derivatives of the elements of A in virtual-bond vectors
3232 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3234 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3235 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3236 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3237 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3238 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3239 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3240 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3241 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3242 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3243 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3244 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3245 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3247 C Compute radial contributions to the gradient
3265 C Add the contributions coming from er
3268 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3269 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3270 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3271 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3274 C Derivatives in DC(i)
3275 cgrad ghalf1=0.5d0*agg(k,1)
3276 cgrad ghalf2=0.5d0*agg(k,2)
3277 cgrad ghalf3=0.5d0*agg(k,3)
3278 cgrad ghalf4=0.5d0*agg(k,4)
3279 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3280 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3281 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3282 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3283 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3284 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3285 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3286 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3287 C Derivatives in DC(i+1)
3288 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3289 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3290 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3291 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3292 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3293 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3294 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3295 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3296 C Derivatives in DC(j)
3297 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3298 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3299 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3300 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3301 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3302 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3303 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3304 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3305 C Derivatives in DC(j+1) or DC(nres-1)
3306 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3307 & -3.0d0*vryg(k,3)*ury)
3308 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3309 & -3.0d0*vrzg(k,3)*ury)
3310 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3311 & -3.0d0*vryg(k,3)*urz)
3312 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3313 & -3.0d0*vrzg(k,3)*urz)
3314 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3316 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3329 aggi(k,l)=-aggi(k,l)
3330 aggi1(k,l)=-aggi1(k,l)
3331 aggj(k,l)=-aggj(k,l)
3332 aggj1(k,l)=-aggj1(k,l)
3335 if (j.lt.nres-1) then
3341 aggi(k,l)=-aggi(k,l)
3342 aggi1(k,l)=-aggi1(k,l)
3343 aggj(k,l)=-aggj(k,l)
3344 aggj1(k,l)=-aggj1(k,l)
3355 aggi(k,l)=-aggi(k,l)
3356 aggi1(k,l)=-aggi1(k,l)
3357 aggj(k,l)=-aggj(k,l)
3358 aggj1(k,l)=-aggj1(k,l)
3363 IF (wel_loc.gt.0.0d0) THEN
3364 C Contribution to the local-electrostatic energy coming from the i-j pair
3365 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3367 C Calculate patrial derivative for theta angle
3369 geel_loc_ij=a22*gmuij1(1)
3373 write(iout,*) "derivative over thatai"
3374 write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3376 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3377 & geel_loc_ij*wel_loc
3378 write(iout,*) "derivative over thatai-1"
3379 write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3381 geel_loc_ij=a22*gmuij2(1)+a23*gmuij2(2)+a32*gmuij2(3)
3383 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3384 & geel_loc_ij*wel_loc
3385 geel_loc_ji=a22*gmuji1(1)+a23*gmuji1(2)+a32*gmuji1(3)
3387 write(iout,*) "derivative over thataj"
3388 write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3391 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3392 & geel_loc_ji*wel_loc
3393 geel_loc_ji=a22*gmuji2(1)+a23*gmuji2(2)+a32*gmuji2(3)
3395 write(iout,*) "derivative over thataj-1"
3396 write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3398 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3399 & geel_loc_ji*wel_loc
3401 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3403 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3404 & 'eelloc',i,j,eel_loc_ij
3405 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3407 eel_loc=eel_loc+eel_loc_ij
3408 C Partial derivatives in virtual-bond dihedral angles gamma
3410 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3411 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3412 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3413 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3414 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3415 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3416 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3418 ggg(l)=agg(l,1)*muij(1)+
3419 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3420 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3421 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3422 cgrad ghalf=0.5d0*ggg(l)
3423 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3424 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3428 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3431 C Remaining derivatives of eello
3433 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3434 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3435 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3436 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3437 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3438 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3439 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3440 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3443 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3444 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3445 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3446 & .and. num_conti.le.maxconts) then
3447 c write (iout,*) i,j," entered corr"
3449 C Calculate the contact function. The ith column of the array JCONT will
3450 C contain the numbers of atoms that make contacts with the atom I (of numbers
3451 C greater than I). The arrays FACONT and GACONT will contain the values of
3452 C the contact function and its derivative.
3453 c r0ij=1.02D0*rpp(iteli,itelj)
3454 c r0ij=1.11D0*rpp(iteli,itelj)
3455 r0ij=2.20D0*rpp(iteli,itelj)
3456 c r0ij=1.55D0*rpp(iteli,itelj)
3457 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3458 if (fcont.gt.0.0D0) then
3459 num_conti=num_conti+1
3460 if (num_conti.gt.maxconts) then
3461 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3462 & ' will skip next contacts for this conf.'
3464 jcont_hb(num_conti,i)=j
3465 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3466 cd & " jcont_hb",jcont_hb(num_conti,i)
3467 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3468 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3469 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3471 d_cont(num_conti,i)=rij
3472 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3473 C --- Electrostatic-interaction matrix ---
3474 a_chuj(1,1,num_conti,i)=a22
3475 a_chuj(1,2,num_conti,i)=a23
3476 a_chuj(2,1,num_conti,i)=a32
3477 a_chuj(2,2,num_conti,i)=a33
3478 C --- Gradient of rij
3480 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3487 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3488 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3489 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3490 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3491 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3496 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3497 C Calculate contact energies
3499 wij=cosa-3.0D0*cosb*cosg
3502 c fac3=dsqrt(-ael6i)/r0ij**3
3503 fac3=dsqrt(-ael6i)*r3ij
3504 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3505 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3506 if (ees0tmp.gt.0) then
3507 ees0pij=dsqrt(ees0tmp)
3511 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3512 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3513 if (ees0tmp.gt.0) then
3514 ees0mij=dsqrt(ees0tmp)
3519 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3520 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3521 C Diagnostics. Comment out or remove after debugging!
3522 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3523 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3524 c ees0m(num_conti,i)=0.0D0
3526 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3527 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3528 C Angular derivatives of the contact function
3529 ees0pij1=fac3/ees0pij
3530 ees0mij1=fac3/ees0mij
3531 fac3p=-3.0D0*fac3*rrmij
3532 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3533 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3535 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3536 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3537 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3538 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3539 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3540 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3541 ecosap=ecosa1+ecosa2
3542 ecosbp=ecosb1+ecosb2
3543 ecosgp=ecosg1+ecosg2
3544 ecosam=ecosa1-ecosa2
3545 ecosbm=ecosb1-ecosb2
3546 ecosgm=ecosg1-ecosg2
3555 facont_hb(num_conti,i)=fcont
3556 fprimcont=fprimcont/rij
3557 cd facont_hb(num_conti,i)=1.0D0
3558 C Following line is for diagnostics.
3561 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3562 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3565 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3566 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3568 gggp(1)=gggp(1)+ees0pijp*xj
3569 gggp(2)=gggp(2)+ees0pijp*yj
3570 gggp(3)=gggp(3)+ees0pijp*zj
3571 gggm(1)=gggm(1)+ees0mijp*xj
3572 gggm(2)=gggm(2)+ees0mijp*yj
3573 gggm(3)=gggm(3)+ees0mijp*zj
3574 C Derivatives due to the contact function
3575 gacont_hbr(1,num_conti,i)=fprimcont*xj
3576 gacont_hbr(2,num_conti,i)=fprimcont*yj
3577 gacont_hbr(3,num_conti,i)=fprimcont*zj
3580 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3581 c following the change of gradient-summation algorithm.
3583 cgrad ghalfp=0.5D0*gggp(k)
3584 cgrad ghalfm=0.5D0*gggm(k)
3585 gacontp_hb1(k,num_conti,i)=!ghalfp
3586 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3587 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3588 gacontp_hb2(k,num_conti,i)=!ghalfp
3589 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3590 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3591 gacontp_hb3(k,num_conti,i)=gggp(k)
3592 gacontm_hb1(k,num_conti,i)=!ghalfm
3593 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3594 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3595 gacontm_hb2(k,num_conti,i)=!ghalfm
3596 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3597 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3598 gacontm_hb3(k,num_conti,i)=gggm(k)
3600 C Diagnostics. Comment out or remove after debugging!
3602 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3603 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3604 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3605 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3606 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3607 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3610 endif ! num_conti.le.maxconts
3613 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3616 ghalf=0.5d0*agg(l,k)
3617 aggi(l,k)=aggi(l,k)+ghalf
3618 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3619 aggj(l,k)=aggj(l,k)+ghalf
3622 if (j.eq.nres-1 .and. i.lt.j-2) then
3625 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3630 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3633 C-----------------------------------------------------------------------------
3634 subroutine eturn3(i,eello_turn3)
3635 C Third- and fourth-order contributions from turns
3636 implicit real*8 (a-h,o-z)
3637 include 'DIMENSIONS'
3638 include 'COMMON.IOUNITS'
3639 include 'COMMON.GEO'
3640 include 'COMMON.VAR'
3641 include 'COMMON.LOCAL'
3642 include 'COMMON.CHAIN'
3643 include 'COMMON.DERIV'
3644 include 'COMMON.INTERACT'
3645 include 'COMMON.CONTACTS'
3646 include 'COMMON.TORSION'
3647 include 'COMMON.VECTORS'
3648 include 'COMMON.FFIELD'
3649 include 'COMMON.CONTROL'
3651 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3652 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3653 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3654 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3655 & auxgmat2(2,2),auxgmatt2(2,2)
3656 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3657 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3658 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3659 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3662 c write (iout,*) "eturn3",i,j,j1,j2
3667 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3669 C Third-order contributions
3676 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3677 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3678 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3679 c auxalary matices for theta gradient
3680 c auxalary matrix for i+1 and constant i+2
3681 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3682 c auxalary matrix for i+2 and constant i+1
3683 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3684 call transpose2(auxmat(1,1),auxmat1(1,1))
3685 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3686 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3687 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3688 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3689 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3690 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3691 C Derivatives in theta
3692 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3693 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3694 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3695 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3697 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3698 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3699 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3700 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3701 cd & ' eello_turn3_num',4*eello_turn3_num
3702 C Derivatives in gamma(i)
3703 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3704 call transpose2(auxmat2(1,1),auxmat3(1,1))
3705 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3706 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3707 C Derivatives in gamma(i+1)
3708 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3709 call transpose2(auxmat2(1,1),auxmat3(1,1))
3710 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3711 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3712 & +0.5d0*(pizda(1,1)+pizda(2,2))
3713 C Cartesian derivatives
3715 c ghalf1=0.5d0*agg(l,1)
3716 c ghalf2=0.5d0*agg(l,2)
3717 c ghalf3=0.5d0*agg(l,3)
3718 c ghalf4=0.5d0*agg(l,4)
3719 a_temp(1,1)=aggi(l,1)!+ghalf1
3720 a_temp(1,2)=aggi(l,2)!+ghalf2
3721 a_temp(2,1)=aggi(l,3)!+ghalf3
3722 a_temp(2,2)=aggi(l,4)!+ghalf4
3723 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3724 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3725 & +0.5d0*(pizda(1,1)+pizda(2,2))
3726 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3727 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3728 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3729 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3730 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3731 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3732 & +0.5d0*(pizda(1,1)+pizda(2,2))
3733 a_temp(1,1)=aggj(l,1)!+ghalf1
3734 a_temp(1,2)=aggj(l,2)!+ghalf2
3735 a_temp(2,1)=aggj(l,3)!+ghalf3
3736 a_temp(2,2)=aggj(l,4)!+ghalf4
3737 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3738 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3739 & +0.5d0*(pizda(1,1)+pizda(2,2))
3740 a_temp(1,1)=aggj1(l,1)
3741 a_temp(1,2)=aggj1(l,2)
3742 a_temp(2,1)=aggj1(l,3)
3743 a_temp(2,2)=aggj1(l,4)
3744 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3745 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3746 & +0.5d0*(pizda(1,1)+pizda(2,2))
3750 C-------------------------------------------------------------------------------
3751 subroutine eturn4(i,eello_turn4)
3752 C Third- and fourth-order contributions from turns
3753 implicit real*8 (a-h,o-z)
3754 include 'DIMENSIONS'
3755 include 'COMMON.IOUNITS'
3756 include 'COMMON.GEO'
3757 include 'COMMON.VAR'
3758 include 'COMMON.LOCAL'
3759 include 'COMMON.CHAIN'
3760 include 'COMMON.DERIV'
3761 include 'COMMON.INTERACT'
3762 include 'COMMON.CONTACTS'
3763 include 'COMMON.TORSION'
3764 include 'COMMON.VECTORS'
3765 include 'COMMON.FFIELD'
3766 include 'COMMON.CONTROL'
3768 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3769 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3770 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3771 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3772 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3773 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3774 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3775 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3776 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3777 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3778 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3781 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3783 C Fourth-order contributions
3791 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3792 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3793 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3794 c write(iout,*)"WCHODZE W PROGRAM"
3799 iti1=itortyp(itype(i+1))
3800 iti2=itortyp(itype(i+2))
3801 iti3=itortyp(itype(i+3))
3802 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3803 call transpose2(EUg(1,1,i+1),e1t(1,1))
3804 call transpose2(Eug(1,1,i+2),e2t(1,1))
3805 call transpose2(Eug(1,1,i+3),e3t(1,1))
3806 C Ematrix derivative in theta
3807 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3808 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3809 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3810 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3811 c eta1 in derivative theta
3812 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3813 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3814 c auxgvec is derivative of Ub2 so i+3 theta
3815 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3816 c auxalary matrix of E i+1
3817 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3820 s1=scalar2(b1(1,i+2),auxvec(1))
3821 c derivative of theta i+2 with constant i+3
3822 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3823 c derivative of theta i+2 with constant i+2
3824 gs32=scalar2(b1(1,i+2),auxgvec(1))
3825 c derivative of E matix in theta of i+1
3826 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3828 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3829 c ea31 in derivative theta
3830 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3831 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3832 c auxilary matrix auxgvec of Ub2 with constant E matirx
3833 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3834 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3835 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3839 s2=scalar2(b1(1,i+1),auxvec(1))
3840 c derivative of theta i+1 with constant i+3
3841 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3842 c derivative of theta i+2 with constant i+1
3843 gs21=scalar2(b1(1,i+1),auxgvec(1))
3844 c derivative of theta i+3 with constant i+1
3845 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3846 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3848 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3849 c two derivatives over diffetent matrices
3850 c gtae3e2 is derivative over i+3
3851 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3852 c ae3gte2 is derivative over i+2
3853 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3854 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3855 c three possible derivative over theta E matices
3857 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3859 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3861 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3862 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3864 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3865 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3866 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3868 eello_turn4=eello_turn4-(s1+s2+s3)
3870 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3871 & -(gs13+gsE13+gsEE1)*wturn4
3872 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3873 & -(gs23+gs21+gsEE2)*wturn4
3874 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3875 & -(gs32+gsE31+gsEE3)*wturn4
3876 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3879 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3880 & 'eturn4',i,j,-(s1+s2+s3)
3881 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3882 c & ' eello_turn4_num',8*eello_turn4_num
3883 C Derivatives in gamma(i)
3884 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3885 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3886 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3887 s1=scalar2(b1(1,i+2),auxvec(1))
3888 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3889 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3890 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3891 C Derivatives in gamma(i+1)
3892 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3893 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3894 s2=scalar2(b1(1,i+1),auxvec(1))
3895 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3896 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3897 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3898 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3899 C Derivatives in gamma(i+2)
3900 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3901 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3902 s1=scalar2(b1(1,i+2),auxvec(1))
3903 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3904 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3905 s2=scalar2(b1(1,i+1),auxvec(1))
3906 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3907 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3908 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3909 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3910 C Cartesian derivatives
3911 C Derivatives of this turn contributions in DC(i+2)
3912 if (j.lt.nres-1) then
3914 a_temp(1,1)=agg(l,1)
3915 a_temp(1,2)=agg(l,2)
3916 a_temp(2,1)=agg(l,3)
3917 a_temp(2,2)=agg(l,4)
3918 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3919 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3920 s1=scalar2(b1(1,i+2),auxvec(1))
3921 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3922 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3923 s2=scalar2(b1(1,i+1),auxvec(1))
3924 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3925 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3926 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3928 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3931 C Remaining derivatives of this turn contribution
3933 a_temp(1,1)=aggi(l,1)
3934 a_temp(1,2)=aggi(l,2)
3935 a_temp(2,1)=aggi(l,3)
3936 a_temp(2,2)=aggi(l,4)
3937 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3938 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3939 s1=scalar2(b1(1,i+2),auxvec(1))
3940 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3941 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3942 s2=scalar2(b1(1,i+1),auxvec(1))
3943 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3944 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3945 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3946 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3947 a_temp(1,1)=aggi1(l,1)
3948 a_temp(1,2)=aggi1(l,2)
3949 a_temp(2,1)=aggi1(l,3)
3950 a_temp(2,2)=aggi1(l,4)
3951 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3952 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3953 s1=scalar2(b1(1,i+2),auxvec(1))
3954 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3955 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3956 s2=scalar2(b1(1,i+1),auxvec(1))
3957 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3958 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3959 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3960 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3961 a_temp(1,1)=aggj(l,1)
3962 a_temp(1,2)=aggj(l,2)
3963 a_temp(2,1)=aggj(l,3)
3964 a_temp(2,2)=aggj(l,4)
3965 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3966 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3967 s1=scalar2(b1(1,i+2),auxvec(1))
3968 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3969 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3970 s2=scalar2(b1(1,i+1),auxvec(1))
3971 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3972 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3973 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3974 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3975 a_temp(1,1)=aggj1(l,1)
3976 a_temp(1,2)=aggj1(l,2)
3977 a_temp(2,1)=aggj1(l,3)
3978 a_temp(2,2)=aggj1(l,4)
3979 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3980 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,i+2),auxvec(1))
3982 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3983 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3984 s2=scalar2(b1(1,i+1),auxvec(1))
3985 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3986 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3988 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3989 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3993 C-----------------------------------------------------------------------------
3994 subroutine vecpr(u,v,w)
3995 implicit real*8(a-h,o-z)
3996 dimension u(3),v(3),w(3)
3997 w(1)=u(2)*v(3)-u(3)*v(2)
3998 w(2)=-u(1)*v(3)+u(3)*v(1)
3999 w(3)=u(1)*v(2)-u(2)*v(1)
4002 C-----------------------------------------------------------------------------
4003 subroutine unormderiv(u,ugrad,unorm,ungrad)
4004 C This subroutine computes the derivatives of a normalized vector u, given
4005 C the derivatives computed without normalization conditions, ugrad. Returns
4008 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4009 double precision vec(3)
4010 double precision scalar
4012 c write (2,*) 'ugrad',ugrad
4015 vec(i)=scalar(ugrad(1,i),u(1))
4017 c write (2,*) 'vec',vec
4020 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4023 c write (2,*) 'ungrad',ungrad
4026 C-----------------------------------------------------------------------------
4027 subroutine escp_soft_sphere(evdw2,evdw2_14)
4029 C This subroutine calculates the excluded-volume interaction energy between
4030 C peptide-group centers and side chains and its gradient in virtual-bond and
4031 C side-chain vectors.
4033 implicit real*8 (a-h,o-z)
4034 include 'DIMENSIONS'
4035 include 'COMMON.GEO'
4036 include 'COMMON.VAR'
4037 include 'COMMON.LOCAL'
4038 include 'COMMON.CHAIN'
4039 include 'COMMON.DERIV'
4040 include 'COMMON.INTERACT'
4041 include 'COMMON.FFIELD'
4042 include 'COMMON.IOUNITS'
4043 include 'COMMON.CONTROL'
4048 cd print '(a)','Enter ESCP'
4049 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4050 do i=iatscp_s,iatscp_e
4051 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4053 xi=0.5D0*(c(1,i)+c(1,i+1))
4054 yi=0.5D0*(c(2,i)+c(2,i+1))
4055 zi=0.5D0*(c(3,i)+c(3,i+1))
4057 do iint=1,nscp_gr(i)
4059 do j=iscpstart(i,iint),iscpend(i,iint)
4060 if (itype(j).eq.ntyp1) cycle
4061 itypj=iabs(itype(j))
4062 C Uncomment following three lines for SC-p interactions
4066 C Uncomment following three lines for Ca-p interactions
4070 rij=xj*xj+yj*yj+zj*zj
4073 if (rij.lt.r0ijsq) then
4074 evdwij=0.25d0*(rij-r0ijsq)**2
4082 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4087 cgrad if (j.lt.i) then
4088 cd write (iout,*) 'j<i'
4089 C Uncomment following three lines for SC-p interactions
4091 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4094 cd write (iout,*) 'j>i'
4096 cgrad ggg(k)=-ggg(k)
4097 C Uncomment following line for SC-p interactions
4098 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4102 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4104 cgrad kstart=min0(i+1,j)
4105 cgrad kend=max0(i-1,j-1)
4106 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4107 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4108 cgrad do k=kstart,kend
4110 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4114 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4115 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4123 C-----------------------------------------------------------------------------
4124 subroutine escp(evdw2,evdw2_14)
4126 C This subroutine calculates the excluded-volume interaction energy between
4127 C peptide-group centers and side chains and its gradient in virtual-bond and
4128 C side-chain vectors.
4130 implicit real*8 (a-h,o-z)
4131 include 'DIMENSIONS'
4132 include 'COMMON.GEO'
4133 include 'COMMON.VAR'
4134 include 'COMMON.LOCAL'
4135 include 'COMMON.CHAIN'
4136 include 'COMMON.DERIV'
4137 include 'COMMON.INTERACT'
4138 include 'COMMON.FFIELD'
4139 include 'COMMON.IOUNITS'
4140 include 'COMMON.CONTROL'
4144 cd print '(a)','Enter ESCP'
4145 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4146 do i=iatscp_s,iatscp_e
4147 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4149 xi=0.5D0*(c(1,i)+c(1,i+1))
4150 yi=0.5D0*(c(2,i)+c(2,i+1))
4151 zi=0.5D0*(c(3,i)+c(3,i+1))
4153 do iint=1,nscp_gr(i)
4155 do j=iscpstart(i,iint),iscpend(i,iint)
4156 itypj=iabs(itype(j))
4157 if (itypj.eq.ntyp1) cycle
4158 C Uncomment following three lines for SC-p interactions
4162 C Uncomment following three lines for Ca-p interactions
4166 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4168 e1=fac*fac*aad(itypj,iteli)
4169 e2=fac*bad(itypj,iteli)
4170 if (iabs(j-i) .le. 2) then
4173 evdw2_14=evdw2_14+e1+e2
4177 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4178 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4181 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4183 fac=-(evdwij+e1)*rrij
4187 cgrad if (j.lt.i) then
4188 cd write (iout,*) 'j<i'
4189 C Uncomment following three lines for SC-p interactions
4191 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4194 cd write (iout,*) 'j>i'
4196 cgrad ggg(k)=-ggg(k)
4197 C Uncomment following line for SC-p interactions
4198 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4199 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4203 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4205 cgrad kstart=min0(i+1,j)
4206 cgrad kend=max0(i-1,j-1)
4207 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4208 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4209 cgrad do k=kstart,kend
4211 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4215 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4216 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4224 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4225 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4226 gradx_scp(j,i)=expon*gradx_scp(j,i)
4229 C******************************************************************************
4233 C To save time the factor EXPON has been extracted from ALL components
4234 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4237 C******************************************************************************
4240 C--------------------------------------------------------------------------
4241 subroutine edis(ehpb)
4243 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4245 implicit real*8 (a-h,o-z)
4246 include 'DIMENSIONS'
4247 include 'COMMON.SBRIDGE'
4248 include 'COMMON.CHAIN'
4249 include 'COMMON.DERIV'
4250 include 'COMMON.VAR'
4251 include 'COMMON.INTERACT'
4252 include 'COMMON.IOUNITS'
4255 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4256 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4257 if (link_end.eq.0) return
4258 do i=link_start,link_end
4259 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4260 C CA-CA distance used in regularization of structure.
4263 C iii and jjj point to the residues for which the distance is assigned.
4264 if (ii.gt.nres) then
4271 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4272 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4273 C distance and angle dependent SS bond potential.
4274 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4275 & iabs(itype(jjj)).eq.1) then
4276 call ssbond_ene(iii,jjj,eij)
4278 cd write (iout,*) "eij",eij
4280 C Calculate the distance between the two points and its difference from the
4284 C Get the force constant corresponding to this distance.
4286 C Calculate the contribution to energy.
4287 ehpb=ehpb+waga*rdis*rdis
4289 C Evaluate gradient.
4292 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4293 cd & ' waga=',waga,' fac=',fac
4295 ggg(j)=fac*(c(j,jj)-c(j,ii))
4297 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4298 C If this is a SC-SC distance, we need to calculate the contributions to the
4299 C Cartesian gradient in the SC vectors (ghpbx).
4302 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4303 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4306 cgrad do j=iii,jjj-1
4308 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4312 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4313 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4320 C--------------------------------------------------------------------------
4321 subroutine ssbond_ene(i,j,eij)
4323 C Calculate the distance and angle dependent SS-bond potential energy
4324 C using a free-energy function derived based on RHF/6-31G** ab initio
4325 C calculations of diethyl disulfide.
4327 C A. Liwo and U. Kozlowska, 11/24/03
4329 implicit real*8 (a-h,o-z)
4330 include 'DIMENSIONS'
4331 include 'COMMON.SBRIDGE'
4332 include 'COMMON.CHAIN'
4333 include 'COMMON.DERIV'
4334 include 'COMMON.LOCAL'
4335 include 'COMMON.INTERACT'
4336 include 'COMMON.VAR'
4337 include 'COMMON.IOUNITS'
4338 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4339 itypi=iabs(itype(i))
4343 dxi=dc_norm(1,nres+i)
4344 dyi=dc_norm(2,nres+i)
4345 dzi=dc_norm(3,nres+i)
4346 c dsci_inv=dsc_inv(itypi)
4347 dsci_inv=vbld_inv(nres+i)
4348 itypj=iabs(itype(j))
4349 c dscj_inv=dsc_inv(itypj)
4350 dscj_inv=vbld_inv(nres+j)
4354 dxj=dc_norm(1,nres+j)
4355 dyj=dc_norm(2,nres+j)
4356 dzj=dc_norm(3,nres+j)
4357 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4362 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4363 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4364 om12=dxi*dxj+dyi*dyj+dzi*dzj
4366 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4367 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4373 deltat12=om2-om1+2.0d0
4375 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4376 & +akct*deltad*deltat12
4377 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4378 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4379 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4380 c & " deltat12",deltat12," eij",eij
4381 ed=2*akcm*deltad+akct*deltat12
4383 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4384 eom1=-2*akth*deltat1-pom1-om2*pom2
4385 eom2= 2*akth*deltat2+pom1-om1*pom2
4388 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4389 ghpbx(k,i)=ghpbx(k,i)-ggk
4390 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4391 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4392 ghpbx(k,j)=ghpbx(k,j)+ggk
4393 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4394 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4395 ghpbc(k,i)=ghpbc(k,i)-ggk
4396 ghpbc(k,j)=ghpbc(k,j)+ggk
4399 C Calculate the components of the gradient in DC and X
4403 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4408 C--------------------------------------------------------------------------
4409 subroutine ebond(estr)
4411 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4413 implicit real*8 (a-h,o-z)
4414 include 'DIMENSIONS'
4415 include 'COMMON.LOCAL'
4416 include 'COMMON.GEO'
4417 include 'COMMON.INTERACT'
4418 include 'COMMON.DERIV'
4419 include 'COMMON.VAR'
4420 include 'COMMON.CHAIN'
4421 include 'COMMON.IOUNITS'
4422 include 'COMMON.NAMES'
4423 include 'COMMON.FFIELD'
4424 include 'COMMON.CONTROL'
4425 include 'COMMON.SETUP'
4426 double precision u(3),ud(3)
4429 do i=ibondp_start,ibondp_end
4430 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4431 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4433 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4434 & *dc(j,i-1)/vbld(i)
4436 if (energy_dec) write(iout,*)
4437 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4439 diff = vbld(i)-vbldp0
4440 if (energy_dec) write (iout,*)
4441 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4444 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4446 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4449 estr=0.5d0*AKP*estr+estr1
4451 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4453 do i=ibond_start,ibond_end
4455 if (iti.ne.10 .and. iti.ne.ntyp1) then
4458 diff=vbld(i+nres)-vbldsc0(1,iti)
4459 if (energy_dec) write (iout,*)
4460 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4461 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4462 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4464 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4468 diff=vbld(i+nres)-vbldsc0(j,iti)
4469 ud(j)=aksc(j,iti)*diff
4470 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4484 uprod2=uprod2*u(k)*u(k)
4488 usumsqder=usumsqder+ud(j)*uprod2
4490 estr=estr+uprod/usum
4492 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4500 C--------------------------------------------------------------------------
4501 subroutine ebend(etheta)
4503 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4504 C angles gamma and its derivatives in consecutive thetas and gammas.
4506 implicit real*8 (a-h,o-z)
4507 include 'DIMENSIONS'
4508 include 'COMMON.LOCAL'
4509 include 'COMMON.GEO'
4510 include 'COMMON.INTERACT'
4511 include 'COMMON.DERIV'
4512 include 'COMMON.VAR'
4513 include 'COMMON.CHAIN'
4514 include 'COMMON.IOUNITS'
4515 include 'COMMON.NAMES'
4516 include 'COMMON.FFIELD'
4517 include 'COMMON.CONTROL'
4518 common /calcthet/ term1,term2,termm,diffak,ratak,
4519 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4520 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4521 double precision y(2),z(2)
4523 c time11=dexp(-2*time)
4526 c write (*,'(a,i2)') 'EBEND ICG=',icg
4527 do i=ithet_start,ithet_end
4528 if (itype(i-1).eq.ntyp1) cycle
4529 C Zero the energy function and its derivative at 0 or pi.
4530 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4532 ichir1=isign(1,itype(i-2))
4533 ichir2=isign(1,itype(i))
4534 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4535 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4536 if (itype(i-1).eq.10) then
4537 itype1=isign(10,itype(i-2))
4538 ichir11=isign(1,itype(i-2))
4539 ichir12=isign(1,itype(i-2))
4540 itype2=isign(10,itype(i))
4541 ichir21=isign(1,itype(i))
4542 ichir22=isign(1,itype(i))
4545 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4548 if (phii.ne.phii) phii=150.0
4558 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4561 if (phii1.ne.phii1) phii1=150.0
4573 C Calculate the "mean" value of theta from the part of the distribution
4574 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4575 C In following comments this theta will be referred to as t_c.
4576 thet_pred_mean=0.0d0
4578 athetk=athet(k,it,ichir1,ichir2)
4579 bthetk=bthet(k,it,ichir1,ichir2)
4581 athetk=athet(k,itype1,ichir11,ichir12)
4582 bthetk=bthet(k,itype2,ichir21,ichir22)
4584 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4586 dthett=thet_pred_mean*ssd
4587 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4588 C Derivatives of the "mean" values in gamma1 and gamma2.
4589 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4590 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4591 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4592 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4594 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4595 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4596 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4597 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4599 if (theta(i).gt.pi-delta) then
4600 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4602 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4603 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4604 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4606 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4608 else if (theta(i).lt.delta) then
4609 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4610 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4611 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4613 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4614 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4617 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4620 etheta=etheta+ethetai
4621 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4623 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4624 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4625 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4627 C Ufff.... We've done all this!!!
4630 C---------------------------------------------------------------------------
4631 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4633 implicit real*8 (a-h,o-z)
4634 include 'DIMENSIONS'
4635 include 'COMMON.LOCAL'
4636 include 'COMMON.IOUNITS'
4637 common /calcthet/ term1,term2,termm,diffak,ratak,
4638 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4639 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4640 C Calculate the contributions to both Gaussian lobes.
4641 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4642 C The "polynomial part" of the "standard deviation" of this part of
4646 sig=sig*thet_pred_mean+polthet(j,it)
4648 C Derivative of the "interior part" of the "standard deviation of the"
4649 C gamma-dependent Gaussian lobe in t_c.
4650 sigtc=3*polthet(3,it)
4652 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4655 C Set the parameters of both Gaussian lobes of the distribution.
4656 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4657 fac=sig*sig+sigc0(it)
4660 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4661 sigsqtc=-4.0D0*sigcsq*sigtc
4662 c print *,i,sig,sigtc,sigsqtc
4663 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4664 sigtc=-sigtc/(fac*fac)
4665 C Following variable is sigma(t_c)**(-2)
4666 sigcsq=sigcsq*sigcsq
4668 sig0inv=1.0D0/sig0i**2
4669 delthec=thetai-thet_pred_mean
4670 delthe0=thetai-theta0i
4671 term1=-0.5D0*sigcsq*delthec*delthec
4672 term2=-0.5D0*sig0inv*delthe0*delthe0
4673 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4674 C NaNs in taking the logarithm. We extract the largest exponent which is added
4675 C to the energy (this being the log of the distribution) at the end of energy
4676 C term evaluation for this virtual-bond angle.
4677 if (term1.gt.term2) then
4679 term2=dexp(term2-termm)
4683 term1=dexp(term1-termm)
4686 C The ratio between the gamma-independent and gamma-dependent lobes of
4687 C the distribution is a Gaussian function of thet_pred_mean too.
4688 diffak=gthet(2,it)-thet_pred_mean
4689 ratak=diffak/gthet(3,it)**2
4690 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4691 C Let's differentiate it in thet_pred_mean NOW.
4693 C Now put together the distribution terms to make complete distribution.
4694 termexp=term1+ak*term2
4695 termpre=sigc+ak*sig0i
4696 C Contribution of the bending energy from this theta is just the -log of
4697 C the sum of the contributions from the two lobes and the pre-exponential
4698 C factor. Simple enough, isn't it?
4699 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4700 C NOW the derivatives!!!
4701 C 6/6/97 Take into account the deformation.
4702 E_theta=(delthec*sigcsq*term1
4703 & +ak*delthe0*sig0inv*term2)/termexp
4704 E_tc=((sigtc+aktc*sig0i)/termpre
4705 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4706 & aktc*term2)/termexp)
4709 c-----------------------------------------------------------------------------
4710 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4711 implicit real*8 (a-h,o-z)
4712 include 'DIMENSIONS'
4713 include 'COMMON.LOCAL'
4714 include 'COMMON.IOUNITS'
4715 common /calcthet/ term1,term2,termm,diffak,ratak,
4716 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4717 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4718 delthec=thetai-thet_pred_mean
4719 delthe0=thetai-theta0i
4720 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4721 t3 = thetai-thet_pred_mean
4725 t14 = t12+t6*sigsqtc
4727 t21 = thetai-theta0i
4733 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4734 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4735 & *(-t12*t9-ak*sig0inv*t27)
4739 C--------------------------------------------------------------------------
4740 subroutine ebend(etheta)
4742 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4743 C angles gamma and its derivatives in consecutive thetas and gammas.
4744 C ab initio-derived potentials from
4745 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4747 implicit real*8 (a-h,o-z)
4748 include 'DIMENSIONS'
4749 include 'COMMON.LOCAL'
4750 include 'COMMON.GEO'
4751 include 'COMMON.INTERACT'
4752 include 'COMMON.DERIV'
4753 include 'COMMON.VAR'
4754 include 'COMMON.CHAIN'
4755 include 'COMMON.IOUNITS'
4756 include 'COMMON.NAMES'
4757 include 'COMMON.FFIELD'
4758 include 'COMMON.CONTROL'
4759 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4760 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4761 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4762 & sinph1ph2(maxdouble,maxdouble)
4763 logical lprn /.false./, lprn1 /.false./
4765 do i=ithet_start,ithet_end
4766 if (itype(i-1).eq.ntyp1) cycle
4767 if (iabs(itype(i+1)).eq.20) iblock=2
4768 if (iabs(itype(i+1)).ne.20) iblock=1
4772 theti2=0.5d0*theta(i)
4773 ityp2=ithetyp((itype(i-1)))
4775 coskt(k)=dcos(k*theti2)
4776 sinkt(k)=dsin(k*theti2)
4778 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4781 if (phii.ne.phii) phii=150.0
4785 ityp1=ithetyp((itype(i-2)))
4786 C propagation of chirality for glycine type
4788 cosph1(k)=dcos(k*phii)
4789 sinph1(k)=dsin(k*phii)
4799 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4802 if (phii1.ne.phii1) phii1=150.0
4807 ityp3=ithetyp((itype(i)))
4809 cosph2(k)=dcos(k*phii1)
4810 sinph2(k)=dsin(k*phii1)
4820 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4823 ccl=cosph1(l)*cosph2(k-l)
4824 ssl=sinph1(l)*sinph2(k-l)
4825 scl=sinph1(l)*cosph2(k-l)
4826 csl=cosph1(l)*sinph2(k-l)
4827 cosph1ph2(l,k)=ccl-ssl
4828 cosph1ph2(k,l)=ccl+ssl
4829 sinph1ph2(l,k)=scl+csl
4830 sinph1ph2(k,l)=scl-csl
4834 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4835 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4836 write (iout,*) "coskt and sinkt"
4838 write (iout,*) k,coskt(k),sinkt(k)
4842 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4843 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4846 & write (iout,*) "k",k,"
4847 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4848 & " ethetai",ethetai
4851 write (iout,*) "cosph and sinph"
4853 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4855 write (iout,*) "cosph1ph2 and sinph2ph2"
4858 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4859 & sinph1ph2(l,k),sinph1ph2(k,l)
4862 write(iout,*) "ethetai",ethetai
4866 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4867 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4868 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4869 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4870 ethetai=ethetai+sinkt(m)*aux
4871 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4872 dephii=dephii+k*sinkt(m)*(
4873 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4874 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4875 dephii1=dephii1+k*sinkt(m)*(
4876 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4877 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4879 & write (iout,*) "m",m," k",k," bbthet",
4880 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4881 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4882 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4883 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4887 & write(iout,*) "ethetai",ethetai
4891 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4892 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4893 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4894 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4895 ethetai=ethetai+sinkt(m)*aux
4896 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4897 dephii=dephii+l*sinkt(m)*(
4898 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4899 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4900 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4901 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4902 dephii1=dephii1+(k-l)*sinkt(m)*(
4903 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4904 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4905 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4906 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4908 write (iout,*) "m",m," k",k," l",l," ffthet",
4909 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4910 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4911 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4912 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4913 & " ethetai",ethetai
4914 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4915 & cosph1ph2(k,l)*sinkt(m),
4916 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4924 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4925 & i,theta(i)*rad2deg,phii*rad2deg,
4926 & phii1*rad2deg,ethetai
4928 etheta=etheta+ethetai
4929 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4930 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4931 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
4937 c-----------------------------------------------------------------------------
4938 subroutine esc(escloc)
4939 C Calculate the local energy of a side chain and its derivatives in the
4940 C corresponding virtual-bond valence angles THETA and the spherical angles
4942 implicit real*8 (a-h,o-z)
4943 include 'DIMENSIONS'
4944 include 'COMMON.GEO'
4945 include 'COMMON.LOCAL'
4946 include 'COMMON.VAR'
4947 include 'COMMON.INTERACT'
4948 include 'COMMON.DERIV'
4949 include 'COMMON.CHAIN'
4950 include 'COMMON.IOUNITS'
4951 include 'COMMON.NAMES'
4952 include 'COMMON.FFIELD'
4953 include 'COMMON.CONTROL'
4954 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4955 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4956 common /sccalc/ time11,time12,time112,theti,it,nlobit
4959 c write (iout,'(a)') 'ESC'
4960 do i=loc_start,loc_end
4962 if (it.eq.ntyp1) cycle
4963 if (it.eq.10) goto 1
4964 nlobit=nlob(iabs(it))
4965 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4966 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4967 theti=theta(i+1)-pipol
4972 if (x(2).gt.pi-delta) then
4976 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4978 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4979 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4981 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4982 & ddersc0(1),dersc(1))
4983 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4984 & ddersc0(3),dersc(3))
4986 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4988 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4989 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4990 & dersc0(2),esclocbi,dersc02)
4991 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4993 call splinthet(x(2),0.5d0*delta,ss,ssd)
4998 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5000 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5001 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5003 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5005 c write (iout,*) escloci
5006 else if (x(2).lt.delta) then
5010 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5012 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5013 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5015 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5016 & ddersc0(1),dersc(1))
5017 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5018 & ddersc0(3),dersc(3))
5020 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5022 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5023 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5024 & dersc0(2),esclocbi,dersc02)
5025 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5030 call splinthet(x(2),0.5d0*delta,ss,ssd)
5032 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5034 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5035 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5037 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5038 c write (iout,*) escloci
5040 call enesc(x,escloci,dersc,ddummy,.false.)
5043 escloc=escloc+escloci
5044 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5045 & 'escloc',i,escloci
5046 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5048 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5050 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5051 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5056 C---------------------------------------------------------------------------
5057 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5058 implicit real*8 (a-h,o-z)
5059 include 'DIMENSIONS'
5060 include 'COMMON.GEO'
5061 include 'COMMON.LOCAL'
5062 include 'COMMON.IOUNITS'
5063 common /sccalc/ time11,time12,time112,theti,it,nlobit
5064 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5065 double precision contr(maxlob,-1:1)
5067 c write (iout,*) 'it=',it,' nlobit=',nlobit
5071 if (mixed) ddersc(j)=0.0d0
5075 C Because of periodicity of the dependence of the SC energy in omega we have
5076 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5077 C To avoid underflows, first compute & store the exponents.
5085 z(k)=x(k)-censc(k,j,it)
5090 Axk=Axk+gaussc(l,k,j,it)*z(l)
5096 expfac=expfac+Ax(k,j,iii)*z(k)
5104 C As in the case of ebend, we want to avoid underflows in exponentiation and
5105 C subsequent NaNs and INFs in energy calculation.
5106 C Find the largest exponent
5110 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5114 cd print *,'it=',it,' emin=',emin
5116 C Compute the contribution to SC energy and derivatives
5121 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5122 if(adexp.ne.adexp) adexp=1.0
5125 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5127 cd print *,'j=',j,' expfac=',expfac
5128 escloc_i=escloc_i+expfac
5130 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5134 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5135 & +gaussc(k,2,j,it))*expfac
5142 dersc(1)=dersc(1)/cos(theti)**2
5143 ddersc(1)=ddersc(1)/cos(theti)**2
5146 escloci=-(dlog(escloc_i)-emin)
5148 dersc(j)=dersc(j)/escloc_i
5152 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5157 C------------------------------------------------------------------------------
5158 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5159 implicit real*8 (a-h,o-z)
5160 include 'DIMENSIONS'
5161 include 'COMMON.GEO'
5162 include 'COMMON.LOCAL'
5163 include 'COMMON.IOUNITS'
5164 common /sccalc/ time11,time12,time112,theti,it,nlobit
5165 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5166 double precision contr(maxlob)
5177 z(k)=x(k)-censc(k,j,it)
5183 Axk=Axk+gaussc(l,k,j,it)*z(l)
5189 expfac=expfac+Ax(k,j)*z(k)
5194 C As in the case of ebend, we want to avoid underflows in exponentiation and
5195 C subsequent NaNs and INFs in energy calculation.
5196 C Find the largest exponent
5199 if (emin.gt.contr(j)) emin=contr(j)
5203 C Compute the contribution to SC energy and derivatives
5207 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5208 escloc_i=escloc_i+expfac
5210 dersc(k)=dersc(k)+Ax(k,j)*expfac
5212 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5213 & +gaussc(1,2,j,it))*expfac
5217 dersc(1)=dersc(1)/cos(theti)**2
5218 dersc12=dersc12/cos(theti)**2
5219 escloci=-(dlog(escloc_i)-emin)
5221 dersc(j)=dersc(j)/escloc_i
5223 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5227 c----------------------------------------------------------------------------------
5228 subroutine esc(escloc)
5229 C Calculate the local energy of a side chain and its derivatives in the
5230 C corresponding virtual-bond valence angles THETA and the spherical angles
5231 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5232 C added by Urszula Kozlowska. 07/11/2007
5234 implicit real*8 (a-h,o-z)
5235 include 'DIMENSIONS'
5236 include 'COMMON.GEO'
5237 include 'COMMON.LOCAL'
5238 include 'COMMON.VAR'
5239 include 'COMMON.SCROT'
5240 include 'COMMON.INTERACT'
5241 include 'COMMON.DERIV'
5242 include 'COMMON.CHAIN'
5243 include 'COMMON.IOUNITS'
5244 include 'COMMON.NAMES'
5245 include 'COMMON.FFIELD'
5246 include 'COMMON.CONTROL'
5247 include 'COMMON.VECTORS'
5248 double precision x_prime(3),y_prime(3),z_prime(3)
5249 & , sumene,dsc_i,dp2_i,x(65),
5250 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5251 & de_dxx,de_dyy,de_dzz,de_dt
5252 double precision s1_t,s1_6_t,s2_t,s2_6_t
5254 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5255 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5256 & dt_dCi(3),dt_dCi1(3)
5257 common /sccalc/ time11,time12,time112,theti,it,nlobit
5260 do i=loc_start,loc_end
5261 if (itype(i).eq.ntyp1) cycle
5262 costtab(i+1) =dcos(theta(i+1))
5263 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5264 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5265 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5266 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5267 cosfac=dsqrt(cosfac2)
5268 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5269 sinfac=dsqrt(sinfac2)
5271 if (it.eq.10) goto 1
5273 C Compute the axes of tghe local cartesian coordinates system; store in
5274 c x_prime, y_prime and z_prime
5281 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5282 C & dc_norm(3,i+nres)
5284 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5285 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5288 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5291 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5292 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5293 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5294 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5295 c & " xy",scalar(x_prime(1),y_prime(1)),
5296 c & " xz",scalar(x_prime(1),z_prime(1)),
5297 c & " yy",scalar(y_prime(1),y_prime(1)),
5298 c & " yz",scalar(y_prime(1),z_prime(1)),
5299 c & " zz",scalar(z_prime(1),z_prime(1))
5301 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5302 C to local coordinate system. Store in xx, yy, zz.
5308 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5309 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5310 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5317 C Compute the energy of the ith side cbain
5319 c write (2,*) "xx",xx," yy",yy," zz",zz
5322 x(j) = sc_parmin(j,it)
5325 Cc diagnostics - remove later
5327 yy1 = dsin(alph(2))*dcos(omeg(2))
5328 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5329 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5330 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5332 C," --- ", xx_w,yy_w,zz_w
5335 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5336 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5338 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5339 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5341 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5342 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5343 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5344 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5345 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5347 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5348 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5349 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5350 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5351 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5353 dsc_i = 0.743d0+x(61)
5355 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5356 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5357 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5358 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5359 s1=(1+x(63))/(0.1d0 + dscp1)
5360 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5361 s2=(1+x(65))/(0.1d0 + dscp2)
5362 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5363 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5364 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5365 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5367 c & dscp1,dscp2,sumene
5368 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5369 escloc = escloc + sumene
5370 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5375 C This section to check the numerical derivatives of the energy of ith side
5376 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5377 C #define DEBUG in the code to turn it on.
5379 write (2,*) "sumene =",sumene
5383 write (2,*) xx,yy,zz
5384 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5385 de_dxx_num=(sumenep-sumene)/aincr
5387 write (2,*) "xx+ sumene from enesc=",sumenep
5390 write (2,*) xx,yy,zz
5391 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5392 de_dyy_num=(sumenep-sumene)/aincr
5394 write (2,*) "yy+ sumene from enesc=",sumenep
5397 write (2,*) xx,yy,zz
5398 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5399 de_dzz_num=(sumenep-sumene)/aincr
5401 write (2,*) "zz+ sumene from enesc=",sumenep
5402 costsave=cost2tab(i+1)
5403 sintsave=sint2tab(i+1)
5404 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5405 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5406 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5407 de_dt_num=(sumenep-sumene)/aincr
5408 write (2,*) " t+ sumene from enesc=",sumenep
5409 cost2tab(i+1)=costsave
5410 sint2tab(i+1)=sintsave
5411 C End of diagnostics section.
5414 C Compute the gradient of esc
5416 c zz=zz*dsign(1.0,dfloat(itype(i)))
5417 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5418 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5419 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5420 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5421 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5422 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5423 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5424 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5425 pom1=(sumene3*sint2tab(i+1)+sumene1)
5426 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5427 pom2=(sumene4*cost2tab(i+1)+sumene2)
5428 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5429 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5430 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5431 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5433 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5434 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5435 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5437 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5438 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5439 & +(pom1+pom2)*pom_dx
5441 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5444 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5445 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5446 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5448 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5449 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5450 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5451 & +x(59)*zz**2 +x(60)*xx*zz
5452 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5453 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5454 & +(pom1-pom2)*pom_dy
5456 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5459 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5460 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5461 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5462 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5463 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5464 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5465 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5466 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5468 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5471 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5472 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5473 & +pom1*pom_dt1+pom2*pom_dt2
5475 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5480 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5481 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5482 cosfac2xx=cosfac2*xx
5483 sinfac2yy=sinfac2*yy
5485 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5487 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5489 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5490 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5491 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5492 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5493 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5494 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5495 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5496 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5497 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5498 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5502 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5503 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5504 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5505 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5508 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5509 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5510 dZZ_XYZ(k)=vbld_inv(i+nres)*
5511 & (z_prime(k)-zz*dC_norm(k,i+nres))
5513 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5514 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5518 dXX_Ctab(k,i)=dXX_Ci(k)
5519 dXX_C1tab(k,i)=dXX_Ci1(k)
5520 dYY_Ctab(k,i)=dYY_Ci(k)
5521 dYY_C1tab(k,i)=dYY_Ci1(k)
5522 dZZ_Ctab(k,i)=dZZ_Ci(k)
5523 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5524 dXX_XYZtab(k,i)=dXX_XYZ(k)
5525 dYY_XYZtab(k,i)=dYY_XYZ(k)
5526 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5530 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5531 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5532 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5533 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5534 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5536 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5537 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5538 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5539 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5540 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5541 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5542 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5543 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5545 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5546 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5548 C to check gradient call subroutine check_grad
5554 c------------------------------------------------------------------------------
5555 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5557 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5558 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5559 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5560 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5562 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5563 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5565 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5566 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5567 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5568 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5569 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5571 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5572 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5573 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5574 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5575 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5577 dsc_i = 0.743d0+x(61)
5579 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5580 & *(xx*cost2+yy*sint2))
5581 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5582 & *(xx*cost2-yy*sint2))
5583 s1=(1+x(63))/(0.1d0 + dscp1)
5584 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5585 s2=(1+x(65))/(0.1d0 + dscp2)
5586 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5587 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5588 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5593 c------------------------------------------------------------------------------
5594 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5596 C This procedure calculates two-body contact function g(rij) and its derivative:
5599 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5602 C where x=(rij-r0ij)/delta
5604 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5607 double precision rij,r0ij,eps0ij,fcont,fprimcont
5608 double precision x,x2,x4,delta
5612 if (x.lt.-1.0D0) then
5615 else if (x.le.1.0D0) then
5618 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5619 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5626 c------------------------------------------------------------------------------
5627 subroutine splinthet(theti,delta,ss,ssder)
5628 implicit real*8 (a-h,o-z)
5629 include 'DIMENSIONS'
5630 include 'COMMON.VAR'
5631 include 'COMMON.GEO'
5634 if (theti.gt.pipol) then
5635 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5637 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5642 c------------------------------------------------------------------------------
5643 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5645 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5646 double precision ksi,ksi2,ksi3,a1,a2,a3
5647 a1=fprim0*delta/(f1-f0)
5653 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5654 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5657 c------------------------------------------------------------------------------
5658 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5660 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5661 double precision ksi,ksi2,ksi3,a1,a2,a3
5666 a2=3*(f1x-f0x)-2*fprim0x*delta
5667 a3=fprim0x*delta-2*(f1x-f0x)
5668 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5671 C-----------------------------------------------------------------------------
5673 C-----------------------------------------------------------------------------
5674 subroutine etor(etors,edihcnstr)
5675 implicit real*8 (a-h,o-z)
5676 include 'DIMENSIONS'
5677 include 'COMMON.VAR'
5678 include 'COMMON.GEO'
5679 include 'COMMON.LOCAL'
5680 include 'COMMON.TORSION'
5681 include 'COMMON.INTERACT'
5682 include 'COMMON.DERIV'
5683 include 'COMMON.CHAIN'
5684 include 'COMMON.NAMES'
5685 include 'COMMON.IOUNITS'
5686 include 'COMMON.FFIELD'
5687 include 'COMMON.TORCNSTR'
5688 include 'COMMON.CONTROL'
5690 C Set lprn=.true. for debugging
5694 do i=iphi_start,iphi_end
5696 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5697 & .or. itype(i).eq.ntyp1) cycle
5698 itori=itortyp(itype(i-2))
5699 itori1=itortyp(itype(i-1))
5702 C Proline-Proline pair is a special case...
5703 if (itori.eq.3 .and. itori1.eq.3) then
5704 if (phii.gt.-dwapi3) then
5706 fac=1.0D0/(1.0D0-cosphi)
5707 etorsi=v1(1,3,3)*fac
5708 etorsi=etorsi+etorsi
5709 etors=etors+etorsi-v1(1,3,3)
5710 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5711 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5714 v1ij=v1(j+1,itori,itori1)
5715 v2ij=v2(j+1,itori,itori1)
5718 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5719 if (energy_dec) etors_ii=etors_ii+
5720 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5721 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5725 v1ij=v1(j,itori,itori1)
5726 v2ij=v2(j,itori,itori1)
5729 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5730 if (energy_dec) etors_ii=etors_ii+
5731 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5732 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5735 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5738 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5739 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5740 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5741 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5742 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5744 ! 6/20/98 - dihedral angle constraints
5747 itori=idih_constr(i)
5750 if (difi.gt.drange(i)) then
5752 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5753 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5754 else if (difi.lt.-drange(i)) then
5756 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5757 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5759 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5760 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5762 ! write (iout,*) 'edihcnstr',edihcnstr
5765 c------------------------------------------------------------------------------
5766 subroutine etor_d(etors_d)
5770 c----------------------------------------------------------------------------
5772 subroutine etor(etors,edihcnstr)
5773 implicit real*8 (a-h,o-z)
5774 include 'DIMENSIONS'
5775 include 'COMMON.VAR'
5776 include 'COMMON.GEO'
5777 include 'COMMON.LOCAL'
5778 include 'COMMON.TORSION'
5779 include 'COMMON.INTERACT'
5780 include 'COMMON.DERIV'
5781 include 'COMMON.CHAIN'
5782 include 'COMMON.NAMES'
5783 include 'COMMON.IOUNITS'
5784 include 'COMMON.FFIELD'
5785 include 'COMMON.TORCNSTR'
5786 include 'COMMON.CONTROL'
5788 C Set lprn=.true. for debugging
5792 do i=iphi_start,iphi_end
5793 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5794 & .or. itype(i).eq.ntyp1) cycle
5796 if (iabs(itype(i)).eq.20) then
5801 itori=itortyp(itype(i-2))
5802 itori1=itortyp(itype(i-1))
5805 C Regular cosine and sine terms
5806 do j=1,nterm(itori,itori1,iblock)
5807 v1ij=v1(j,itori,itori1,iblock)
5808 v2ij=v2(j,itori,itori1,iblock)
5811 etors=etors+v1ij*cosphi+v2ij*sinphi
5812 if (energy_dec) etors_ii=etors_ii+
5813 & v1ij*cosphi+v2ij*sinphi
5814 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5818 C E = SUM ----------------------------------- - v1
5819 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5821 cosphi=dcos(0.5d0*phii)
5822 sinphi=dsin(0.5d0*phii)
5823 do j=1,nlor(itori,itori1,iblock)
5824 vl1ij=vlor1(j,itori,itori1)
5825 vl2ij=vlor2(j,itori,itori1)
5826 vl3ij=vlor3(j,itori,itori1)
5827 pom=vl2ij*cosphi+vl3ij*sinphi
5828 pom1=1.0d0/(pom*pom+1.0d0)
5829 etors=etors+vl1ij*pom1
5830 if (energy_dec) etors_ii=etors_ii+
5833 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5835 C Subtract the constant term
5836 etors=etors-v0(itori,itori1,iblock)
5837 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5838 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5840 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5841 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5842 & (v1(j,itori,itori1,iblock),j=1,6),
5843 & (v2(j,itori,itori1,iblock),j=1,6)
5844 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5845 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5847 ! 6/20/98 - dihedral angle constraints
5849 c do i=1,ndih_constr
5850 do i=idihconstr_start,idihconstr_end
5851 itori=idih_constr(i)
5853 difi=pinorm(phii-phi0(i))
5854 if (difi.gt.drange(i)) then
5856 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5857 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5858 else if (difi.lt.-drange(i)) then
5860 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5861 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5865 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5866 cd & rad2deg*phi0(i), rad2deg*drange(i),
5867 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5869 cd write (iout,*) 'edihcnstr',edihcnstr
5872 c----------------------------------------------------------------------------
5873 subroutine etor_d(etors_d)
5874 C 6/23/01 Compute double torsional energy
5875 implicit real*8 (a-h,o-z)
5876 include 'DIMENSIONS'
5877 include 'COMMON.VAR'
5878 include 'COMMON.GEO'
5879 include 'COMMON.LOCAL'
5880 include 'COMMON.TORSION'
5881 include 'COMMON.INTERACT'
5882 include 'COMMON.DERIV'
5883 include 'COMMON.CHAIN'
5884 include 'COMMON.NAMES'
5885 include 'COMMON.IOUNITS'
5886 include 'COMMON.FFIELD'
5887 include 'COMMON.TORCNSTR'
5889 C Set lprn=.true. for debugging
5893 c write(iout,*) "a tu??"
5894 do i=iphid_start,iphid_end
5895 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5896 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5897 itori=itortyp(itype(i-2))
5898 itori1=itortyp(itype(i-1))
5899 itori2=itortyp(itype(i))
5905 if (iabs(itype(i+1)).eq.20) iblock=2
5907 C Regular cosine and sine terms
5908 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5909 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5910 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5911 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5912 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5913 cosphi1=dcos(j*phii)
5914 sinphi1=dsin(j*phii)
5915 cosphi2=dcos(j*phii1)
5916 sinphi2=dsin(j*phii1)
5917 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5918 & v2cij*cosphi2+v2sij*sinphi2
5919 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5920 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5922 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5924 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5925 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5926 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5927 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5928 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5929 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5930 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5931 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5932 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5933 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5934 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5935 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5936 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5937 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5940 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5941 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5946 c------------------------------------------------------------------------------
5947 subroutine eback_sc_corr(esccor)
5948 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5949 c conformational states; temporarily implemented as differences
5950 c between UNRES torsional potentials (dependent on three types of
5951 c residues) and the torsional potentials dependent on all 20 types
5952 c of residues computed from AM1 energy surfaces of terminally-blocked
5953 c amino-acid residues.
5954 implicit real*8 (a-h,o-z)
5955 include 'DIMENSIONS'
5956 include 'COMMON.VAR'
5957 include 'COMMON.GEO'
5958 include 'COMMON.LOCAL'
5959 include 'COMMON.TORSION'
5960 include 'COMMON.SCCOR'
5961 include 'COMMON.INTERACT'
5962 include 'COMMON.DERIV'
5963 include 'COMMON.CHAIN'
5964 include 'COMMON.NAMES'
5965 include 'COMMON.IOUNITS'
5966 include 'COMMON.FFIELD'
5967 include 'COMMON.CONTROL'
5969 C Set lprn=.true. for debugging
5972 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5974 do i=itau_start,itau_end
5975 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5977 isccori=isccortyp(itype(i-2))
5978 isccori1=isccortyp(itype(i-1))
5979 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5981 do intertyp=1,3 !intertyp
5982 cc Added 09 May 2012 (Adasko)
5983 cc Intertyp means interaction type of backbone mainchain correlation:
5984 c 1 = SC...Ca...Ca...Ca
5985 c 2 = Ca...Ca...Ca...SC
5986 c 3 = SC...Ca...Ca...SCi
5988 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5989 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5990 & (itype(i-1).eq.ntyp1)))
5991 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5992 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5993 & .or.(itype(i).eq.ntyp1)))
5994 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5995 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5996 & (itype(i-3).eq.ntyp1)))) cycle
5997 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5998 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6000 do j=1,nterm_sccor(isccori,isccori1)
6001 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6002 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6003 cosphi=dcos(j*tauangle(intertyp,i))
6004 sinphi=dsin(j*tauangle(intertyp,i))
6005 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6006 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6008 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6009 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6011 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6012 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6013 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6014 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6015 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6021 c----------------------------------------------------------------------------
6022 subroutine multibody(ecorr)
6023 C This subroutine calculates multi-body contributions to energy following
6024 C the idea of Skolnick et al. If side chains I and J make a contact and
6025 C at the same time side chains I+1 and J+1 make a contact, an extra
6026 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6027 implicit real*8 (a-h,o-z)
6028 include 'DIMENSIONS'
6029 include 'COMMON.IOUNITS'
6030 include 'COMMON.DERIV'
6031 include 'COMMON.INTERACT'
6032 include 'COMMON.CONTACTS'
6033 double precision gx(3),gx1(3)
6036 C Set lprn=.true. for debugging
6040 write (iout,'(a)') 'Contact function values:'
6042 write (iout,'(i2,20(1x,i2,f10.5))')
6043 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6058 num_conti=num_cont(i)
6059 num_conti1=num_cont(i1)
6064 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6065 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6066 cd & ' ishift=',ishift
6067 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6068 C The system gains extra energy.
6069 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6070 endif ! j1==j+-ishift
6079 c------------------------------------------------------------------------------
6080 double precision function esccorr(i,j,k,l,jj,kk)
6081 implicit real*8 (a-h,o-z)
6082 include 'DIMENSIONS'
6083 include 'COMMON.IOUNITS'
6084 include 'COMMON.DERIV'
6085 include 'COMMON.INTERACT'
6086 include 'COMMON.CONTACTS'
6087 double precision gx(3),gx1(3)
6092 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6093 C Calculate the multi-body contribution to energy.
6094 C Calculate multi-body contributions to the gradient.
6095 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6096 cd & k,l,(gacont(m,kk,k),m=1,3)
6098 gx(m) =ekl*gacont(m,jj,i)
6099 gx1(m)=eij*gacont(m,kk,k)
6100 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6101 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6102 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6103 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6107 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6112 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6118 c------------------------------------------------------------------------------
6119 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6120 C This subroutine calculates multi-body contributions to hydrogen-bonding
6121 implicit real*8 (a-h,o-z)
6122 include 'DIMENSIONS'
6123 include 'COMMON.IOUNITS'
6126 parameter (max_cont=maxconts)
6127 parameter (max_dim=26)
6128 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6129 double precision zapas(max_dim,maxconts,max_fg_procs),
6130 & zapas_recv(max_dim,maxconts,max_fg_procs)
6131 common /przechowalnia/ zapas
6132 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6133 & status_array(MPI_STATUS_SIZE,maxconts*2)
6135 include 'COMMON.SETUP'
6136 include 'COMMON.FFIELD'
6137 include 'COMMON.DERIV'
6138 include 'COMMON.INTERACT'
6139 include 'COMMON.CONTACTS'
6140 include 'COMMON.CONTROL'
6141 include 'COMMON.LOCAL'
6142 double precision gx(3),gx1(3),time00
6145 C Set lprn=.true. for debugging
6150 if (nfgtasks.le.1) goto 30
6152 write (iout,'(a)') 'Contact function values before RECEIVE:'
6154 write (iout,'(2i3,50(1x,i2,f5.2))')
6155 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6156 & j=1,num_cont_hb(i))
6160 do i=1,ntask_cont_from
6163 do i=1,ntask_cont_to
6166 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6168 C Make the list of contacts to send to send to other procesors
6169 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6171 do i=iturn3_start,iturn3_end
6172 c write (iout,*) "make contact list turn3",i," num_cont",
6174 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6176 do i=iturn4_start,iturn4_end
6177 c write (iout,*) "make contact list turn4",i," num_cont",
6179 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6183 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6185 do j=1,num_cont_hb(i)
6188 iproc=iint_sent_local(k,jjc,ii)
6189 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6190 if (iproc.gt.0) then
6191 ncont_sent(iproc)=ncont_sent(iproc)+1
6192 nn=ncont_sent(iproc)
6194 zapas(2,nn,iproc)=jjc
6195 zapas(3,nn,iproc)=facont_hb(j,i)
6196 zapas(4,nn,iproc)=ees0p(j,i)
6197 zapas(5,nn,iproc)=ees0m(j,i)
6198 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6199 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6200 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6201 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6202 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6203 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6204 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6205 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6206 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6207 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6208 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6209 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6210 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6211 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6212 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6213 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6214 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6215 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6216 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6217 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6218 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6225 & "Numbers of contacts to be sent to other processors",
6226 & (ncont_sent(i),i=1,ntask_cont_to)
6227 write (iout,*) "Contacts sent"
6228 do ii=1,ntask_cont_to
6230 iproc=itask_cont_to(ii)
6231 write (iout,*) nn," contacts to processor",iproc,
6232 & " of CONT_TO_COMM group"
6234 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6242 CorrelID1=nfgtasks+fg_rank+1
6244 C Receive the numbers of needed contacts from other processors
6245 do ii=1,ntask_cont_from
6246 iproc=itask_cont_from(ii)
6248 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6249 & FG_COMM,req(ireq),IERR)
6251 c write (iout,*) "IRECV ended"
6253 C Send the number of contacts needed by other processors
6254 do ii=1,ntask_cont_to
6255 iproc=itask_cont_to(ii)
6257 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6258 & FG_COMM,req(ireq),IERR)
6260 c write (iout,*) "ISEND ended"
6261 c write (iout,*) "number of requests (nn)",ireq
6264 & call MPI_Waitall(ireq,req,status_array,ierr)
6266 c & "Numbers of contacts to be received from other processors",
6267 c & (ncont_recv(i),i=1,ntask_cont_from)
6271 do ii=1,ntask_cont_from
6272 iproc=itask_cont_from(ii)
6274 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6275 c & " of CONT_TO_COMM group"
6279 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6280 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6281 c write (iout,*) "ireq,req",ireq,req(ireq)
6284 C Send the contacts to processors that need them
6285 do ii=1,ntask_cont_to
6286 iproc=itask_cont_to(ii)
6288 c write (iout,*) nn," contacts to processor",iproc,
6289 c & " of CONT_TO_COMM group"
6292 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6293 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6294 c write (iout,*) "ireq,req",ireq,req(ireq)
6296 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6300 c write (iout,*) "number of requests (contacts)",ireq
6301 c write (iout,*) "req",(req(i),i=1,4)
6304 & call MPI_Waitall(ireq,req,status_array,ierr)
6305 do iii=1,ntask_cont_from
6306 iproc=itask_cont_from(iii)
6309 write (iout,*) "Received",nn," contacts from processor",iproc,
6310 & " of CONT_FROM_COMM group"
6313 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6318 ii=zapas_recv(1,i,iii)
6319 c Flag the received contacts to prevent double-counting
6320 jj=-zapas_recv(2,i,iii)
6321 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6323 nnn=num_cont_hb(ii)+1
6326 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6327 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6328 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6329 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6330 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6331 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6332 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6333 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6334 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6335 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6336 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6337 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6338 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6339 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6340 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6341 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6342 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6343 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6344 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6345 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6346 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6347 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6348 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6349 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6354 write (iout,'(a)') 'Contact function values after receive:'
6356 write (iout,'(2i3,50(1x,i3,f5.2))')
6357 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6358 & j=1,num_cont_hb(i))
6365 write (iout,'(a)') 'Contact function values:'
6367 write (iout,'(2i3,50(1x,i3,f5.2))')
6368 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6369 & j=1,num_cont_hb(i))
6373 C Remove the loop below after debugging !!!
6380 C Calculate the local-electrostatic correlation terms
6381 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6383 num_conti=num_cont_hb(i)
6384 num_conti1=num_cont_hb(i+1)
6391 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6392 c & ' jj=',jj,' kk=',kk
6393 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6394 & .or. j.lt.0 .and. j1.gt.0) .and.
6395 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6396 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6397 C The system gains extra energy.
6398 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6399 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6400 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6402 else if (j1.eq.j) then
6403 C Contacts I-J and I-(J+1) occur simultaneously.
6404 C The system loses extra energy.
6405 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6410 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6411 c & ' jj=',jj,' kk=',kk
6413 C Contacts I-J and (I+1)-J occur simultaneously.
6414 C The system loses extra energy.
6415 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6422 c------------------------------------------------------------------------------
6423 subroutine add_hb_contact(ii,jj,itask)
6424 implicit real*8 (a-h,o-z)
6425 include "DIMENSIONS"
6426 include "COMMON.IOUNITS"
6429 parameter (max_cont=maxconts)
6430 parameter (max_dim=26)
6431 include "COMMON.CONTACTS"
6432 double precision zapas(max_dim,maxconts,max_fg_procs),
6433 & zapas_recv(max_dim,maxconts,max_fg_procs)
6434 common /przechowalnia/ zapas
6435 integer i,j,ii,jj,iproc,itask(4),nn
6436 c write (iout,*) "itask",itask
6439 if (iproc.gt.0) then
6440 do j=1,num_cont_hb(ii)
6442 c write (iout,*) "i",ii," j",jj," jjc",jjc
6444 ncont_sent(iproc)=ncont_sent(iproc)+1
6445 nn=ncont_sent(iproc)
6446 zapas(1,nn,iproc)=ii
6447 zapas(2,nn,iproc)=jjc
6448 zapas(3,nn,iproc)=facont_hb(j,ii)
6449 zapas(4,nn,iproc)=ees0p(j,ii)
6450 zapas(5,nn,iproc)=ees0m(j,ii)
6451 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6452 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6453 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6454 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6455 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6456 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6457 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6458 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6459 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6460 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6461 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6462 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6463 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6464 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6465 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6466 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6467 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6468 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6469 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6470 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6471 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6479 c------------------------------------------------------------------------------
6480 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6482 C This subroutine calculates multi-body contributions to hydrogen-bonding
6483 implicit real*8 (a-h,o-z)
6484 include 'DIMENSIONS'
6485 include 'COMMON.IOUNITS'
6488 parameter (max_cont=maxconts)
6489 parameter (max_dim=70)
6490 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6491 double precision zapas(max_dim,maxconts,max_fg_procs),
6492 & zapas_recv(max_dim,maxconts,max_fg_procs)
6493 common /przechowalnia/ zapas
6494 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6495 & status_array(MPI_STATUS_SIZE,maxconts*2)
6497 include 'COMMON.SETUP'
6498 include 'COMMON.FFIELD'
6499 include 'COMMON.DERIV'
6500 include 'COMMON.LOCAL'
6501 include 'COMMON.INTERACT'
6502 include 'COMMON.CONTACTS'
6503 include 'COMMON.CHAIN'
6504 include 'COMMON.CONTROL'
6505 double precision gx(3),gx1(3)
6506 integer num_cont_hb_old(maxres)
6508 double precision eello4,eello5,eelo6,eello_turn6
6509 external eello4,eello5,eello6,eello_turn6
6510 C Set lprn=.true. for debugging
6515 num_cont_hb_old(i)=num_cont_hb(i)
6519 if (nfgtasks.le.1) goto 30
6521 write (iout,'(a)') 'Contact function values before RECEIVE:'
6523 write (iout,'(2i3,50(1x,i2,f5.2))')
6524 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6525 & j=1,num_cont_hb(i))
6529 do i=1,ntask_cont_from
6532 do i=1,ntask_cont_to
6535 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6537 C Make the list of contacts to send to send to other procesors
6538 do i=iturn3_start,iturn3_end
6539 c write (iout,*) "make contact list turn3",i," num_cont",
6541 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6543 do i=iturn4_start,iturn4_end
6544 c write (iout,*) "make contact list turn4",i," num_cont",
6546 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6550 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6552 do j=1,num_cont_hb(i)
6555 iproc=iint_sent_local(k,jjc,ii)
6556 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6557 if (iproc.ne.0) then
6558 ncont_sent(iproc)=ncont_sent(iproc)+1
6559 nn=ncont_sent(iproc)
6561 zapas(2,nn,iproc)=jjc
6562 zapas(3,nn,iproc)=d_cont(j,i)
6566 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6571 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6579 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6590 & "Numbers of contacts to be sent to other processors",
6591 & (ncont_sent(i),i=1,ntask_cont_to)
6592 write (iout,*) "Contacts sent"
6593 do ii=1,ntask_cont_to
6595 iproc=itask_cont_to(ii)
6596 write (iout,*) nn," contacts to processor",iproc,
6597 & " of CONT_TO_COMM group"
6599 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6607 CorrelID1=nfgtasks+fg_rank+1
6609 C Receive the numbers of needed contacts from other processors
6610 do ii=1,ntask_cont_from
6611 iproc=itask_cont_from(ii)
6613 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6614 & FG_COMM,req(ireq),IERR)
6616 c write (iout,*) "IRECV ended"
6618 C Send the number of contacts needed by other processors
6619 do ii=1,ntask_cont_to
6620 iproc=itask_cont_to(ii)
6622 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6623 & FG_COMM,req(ireq),IERR)
6625 c write (iout,*) "ISEND ended"
6626 c write (iout,*) "number of requests (nn)",ireq
6629 & call MPI_Waitall(ireq,req,status_array,ierr)
6631 c & "Numbers of contacts to be received from other processors",
6632 c & (ncont_recv(i),i=1,ntask_cont_from)
6636 do ii=1,ntask_cont_from
6637 iproc=itask_cont_from(ii)
6639 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6640 c & " of CONT_TO_COMM group"
6644 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6645 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6646 c write (iout,*) "ireq,req",ireq,req(ireq)
6649 C Send the contacts to processors that need them
6650 do ii=1,ntask_cont_to
6651 iproc=itask_cont_to(ii)
6653 c write (iout,*) nn," contacts to processor",iproc,
6654 c & " of CONT_TO_COMM group"
6657 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6658 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6659 c write (iout,*) "ireq,req",ireq,req(ireq)
6661 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6665 c write (iout,*) "number of requests (contacts)",ireq
6666 c write (iout,*) "req",(req(i),i=1,4)
6669 & call MPI_Waitall(ireq,req,status_array,ierr)
6670 do iii=1,ntask_cont_from
6671 iproc=itask_cont_from(iii)
6674 write (iout,*) "Received",nn," contacts from processor",iproc,
6675 & " of CONT_FROM_COMM group"
6678 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6683 ii=zapas_recv(1,i,iii)
6684 c Flag the received contacts to prevent double-counting
6685 jj=-zapas_recv(2,i,iii)
6686 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6688 nnn=num_cont_hb(ii)+1
6691 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6695 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6700 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6708 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6717 write (iout,'(a)') 'Contact function values after receive:'
6719 write (iout,'(2i3,50(1x,i3,5f6.3))')
6720 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6721 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6728 write (iout,'(a)') 'Contact function values:'
6730 write (iout,'(2i3,50(1x,i2,5f6.3))')
6731 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6732 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6738 C Remove the loop below after debugging !!!
6745 C Calculate the dipole-dipole interaction energies
6746 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6747 do i=iatel_s,iatel_e+1
6748 num_conti=num_cont_hb(i)
6757 C Calculate the local-electrostatic correlation terms
6758 c write (iout,*) "gradcorr5 in eello5 before loop"
6760 c write (iout,'(i5,3f10.5)')
6761 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6763 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6764 c write (iout,*) "corr loop i",i
6766 num_conti=num_cont_hb(i)
6767 num_conti1=num_cont_hb(i+1)
6774 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6775 c & ' jj=',jj,' kk=',kk
6776 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6777 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6778 & .or. j.lt.0 .and. j1.gt.0) .and.
6779 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6780 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6781 C The system gains extra energy.
6783 sqd1=dsqrt(d_cont(jj,i))
6784 sqd2=dsqrt(d_cont(kk,i1))
6785 sred_geom = sqd1*sqd2
6786 IF (sred_geom.lt.cutoff_corr) THEN
6787 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6789 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6790 cd & ' jj=',jj,' kk=',kk
6791 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6792 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6794 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6795 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6798 cd write (iout,*) 'sred_geom=',sred_geom,
6799 cd & ' ekont=',ekont,' fprim=',fprimcont,
6800 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6801 cd write (iout,*) "g_contij",g_contij
6802 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6803 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6804 call calc_eello(i,jp,i+1,jp1,jj,kk)
6805 if (wcorr4.gt.0.0d0)
6806 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6807 if (energy_dec.and.wcorr4.gt.0.0d0)
6808 1 write (iout,'(a6,4i5,0pf7.3)')
6809 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6810 c write (iout,*) "gradcorr5 before eello5"
6812 c write (iout,'(i5,3f10.5)')
6813 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6815 if (wcorr5.gt.0.0d0)
6816 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6817 c write (iout,*) "gradcorr5 after eello5"
6819 c write (iout,'(i5,3f10.5)')
6820 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6822 if (energy_dec.and.wcorr5.gt.0.0d0)
6823 1 write (iout,'(a6,4i5,0pf7.3)')
6824 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6825 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6826 cd write(2,*)'ijkl',i,jp,i+1,jp1
6827 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6828 & .or. wturn6.eq.0.0d0))then
6829 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6830 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6831 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6832 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6833 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6834 cd & 'ecorr6=',ecorr6
6835 cd write (iout,'(4e15.5)') sred_geom,
6836 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6837 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6838 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6839 else if (wturn6.gt.0.0d0
6840 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6841 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6842 eturn6=eturn6+eello_turn6(i,jj,kk)
6843 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6844 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6845 cd write (2,*) 'multibody_eello:eturn6',eturn6
6854 num_cont_hb(i)=num_cont_hb_old(i)
6856 c write (iout,*) "gradcorr5 in eello5"
6858 c write (iout,'(i5,3f10.5)')
6859 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6863 c------------------------------------------------------------------------------
6864 subroutine add_hb_contact_eello(ii,jj,itask)
6865 implicit real*8 (a-h,o-z)
6866 include "DIMENSIONS"
6867 include "COMMON.IOUNITS"
6870 parameter (max_cont=maxconts)
6871 parameter (max_dim=70)
6872 include "COMMON.CONTACTS"
6873 double precision zapas(max_dim,maxconts,max_fg_procs),
6874 & zapas_recv(max_dim,maxconts,max_fg_procs)
6875 common /przechowalnia/ zapas
6876 integer i,j,ii,jj,iproc,itask(4),nn
6877 c write (iout,*) "itask",itask
6880 if (iproc.gt.0) then
6881 do j=1,num_cont_hb(ii)
6883 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6885 ncont_sent(iproc)=ncont_sent(iproc)+1
6886 nn=ncont_sent(iproc)
6887 zapas(1,nn,iproc)=ii
6888 zapas(2,nn,iproc)=jjc
6889 zapas(3,nn,iproc)=d_cont(j,ii)
6893 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6898 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6906 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6918 c------------------------------------------------------------------------------
6919 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6920 implicit real*8 (a-h,o-z)
6921 include 'DIMENSIONS'
6922 include 'COMMON.IOUNITS'
6923 include 'COMMON.DERIV'
6924 include 'COMMON.INTERACT'
6925 include 'COMMON.CONTACTS'
6926 double precision gx(3),gx1(3)
6936 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6937 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6938 C Following 4 lines for diagnostics.
6943 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6944 c & 'Contacts ',i,j,
6945 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6946 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6948 C Calculate the multi-body contribution to energy.
6949 c ecorr=ecorr+ekont*ees
6950 C Calculate multi-body contributions to the gradient.
6951 coeffpees0pij=coeffp*ees0pij
6952 coeffmees0mij=coeffm*ees0mij
6953 coeffpees0pkl=coeffp*ees0pkl
6954 coeffmees0mkl=coeffm*ees0mkl
6956 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6957 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6958 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6959 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6960 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6961 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6962 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6963 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6964 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6965 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6966 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6967 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6968 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6969 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6970 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6971 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6972 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6973 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6974 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6975 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6976 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6977 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6978 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6979 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6980 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6985 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6986 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6987 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6988 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6993 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6994 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6995 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6996 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6999 c write (iout,*) "ehbcorr",ekont*ees
7004 C---------------------------------------------------------------------------
7005 subroutine dipole(i,j,jj)
7006 implicit real*8 (a-h,o-z)
7007 include 'DIMENSIONS'
7008 include 'COMMON.IOUNITS'
7009 include 'COMMON.CHAIN'
7010 include 'COMMON.FFIELD'
7011 include 'COMMON.DERIV'
7012 include 'COMMON.INTERACT'
7013 include 'COMMON.CONTACTS'
7014 include 'COMMON.TORSION'
7015 include 'COMMON.VAR'
7016 include 'COMMON.GEO'
7017 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7019 iti1 = itortyp(itype(i+1))
7020 if (j.lt.nres-1) then
7021 itj1 = itortyp(itype(j+1))
7026 dipi(iii,1)=Ub2(iii,i)
7027 dipderi(iii)=Ub2der(iii,i)
7028 dipi(iii,2)=b1(iii,i+1)
7029 dipj(iii,1)=Ub2(iii,j)
7030 dipderj(iii)=Ub2der(iii,j)
7031 dipj(iii,2)=b1(iii,j+1)
7035 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7038 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7045 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7049 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7054 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7055 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7057 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7059 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7061 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7066 C---------------------------------------------------------------------------
7067 subroutine calc_eello(i,j,k,l,jj,kk)
7069 C This subroutine computes matrices and vectors needed to calculate
7070 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7072 implicit real*8 (a-h,o-z)
7073 include 'DIMENSIONS'
7074 include 'COMMON.IOUNITS'
7075 include 'COMMON.CHAIN'
7076 include 'COMMON.DERIV'
7077 include 'COMMON.INTERACT'
7078 include 'COMMON.CONTACTS'
7079 include 'COMMON.TORSION'
7080 include 'COMMON.VAR'
7081 include 'COMMON.GEO'
7082 include 'COMMON.FFIELD'
7083 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7084 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7087 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7088 cd & ' jj=',jj,' kk=',kk
7089 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7090 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7091 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7094 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7095 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7098 call transpose2(aa1(1,1),aa1t(1,1))
7099 call transpose2(aa2(1,1),aa2t(1,1))
7102 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7103 & aa1tder(1,1,lll,kkk))
7104 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7105 & aa2tder(1,1,lll,kkk))
7109 C parallel orientation of the two CA-CA-CA frames.
7111 iti=itortyp(itype(i))
7115 itk1=itortyp(itype(k+1))
7116 itj=itortyp(itype(j))
7117 if (l.lt.nres-1) then
7118 itl1=itortyp(itype(l+1))
7122 C A1 kernel(j+1) A2T
7124 cd write (iout,'(3f10.5,5x,3f10.5)')
7125 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7127 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7128 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7129 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7130 C Following matrices are needed only for 6-th order cumulants
7131 IF (wcorr6.gt.0.0d0) THEN
7132 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7133 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7134 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7135 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7136 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7137 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7138 & ADtEAderx(1,1,1,1,1,1))
7140 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7141 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7142 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7143 & ADtEA1derx(1,1,1,1,1,1))
7145 C End 6-th order cumulants
7148 cd write (2,*) 'In calc_eello6'
7150 cd write (2,*) 'iii=',iii
7152 cd write (2,*) 'kkk=',kkk
7154 cd write (2,'(3(2f10.5),5x)')
7155 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7160 call transpose2(EUgder(1,1,k),auxmat(1,1))
7161 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7162 call transpose2(EUg(1,1,k),auxmat(1,1))
7163 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7164 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7168 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7169 & EAEAderx(1,1,lll,kkk,iii,1))
7173 C A1T kernel(i+1) A2
7174 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7175 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7176 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7177 C Following matrices are needed only for 6-th order cumulants
7178 IF (wcorr6.gt.0.0d0) THEN
7179 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7180 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7181 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7182 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7183 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7184 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7185 & ADtEAderx(1,1,1,1,1,2))
7186 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7187 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7188 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7189 & ADtEA1derx(1,1,1,1,1,2))
7191 C End 6-th order cumulants
7192 call transpose2(EUgder(1,1,l),auxmat(1,1))
7193 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7194 call transpose2(EUg(1,1,l),auxmat(1,1))
7195 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7196 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7200 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7201 & EAEAderx(1,1,lll,kkk,iii,2))
7206 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7207 C They are needed only when the fifth- or the sixth-order cumulants are
7209 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7210 call transpose2(AEA(1,1,1),auxmat(1,1))
7211 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7212 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7213 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7214 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7215 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7216 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7217 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7218 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7219 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7220 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7221 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7222 call transpose2(AEA(1,1,2),auxmat(1,1))
7223 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7224 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7225 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7226 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7227 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7228 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7229 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7230 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7231 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7232 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7233 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7234 C Calculate the Cartesian derivatives of the vectors.
7238 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7239 call matvec2(auxmat(1,1),b1(1,i),
7240 & AEAb1derx(1,lll,kkk,iii,1,1))
7241 call matvec2(auxmat(1,1),Ub2(1,i),
7242 & AEAb2derx(1,lll,kkk,iii,1,1))
7243 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7244 & AEAb1derx(1,lll,kkk,iii,2,1))
7245 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7246 & AEAb2derx(1,lll,kkk,iii,2,1))
7247 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7248 call matvec2(auxmat(1,1),b1(1,j),
7249 & AEAb1derx(1,lll,kkk,iii,1,2))
7250 call matvec2(auxmat(1,1),Ub2(1,j),
7251 & AEAb2derx(1,lll,kkk,iii,1,2))
7252 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7253 & AEAb1derx(1,lll,kkk,iii,2,2))
7254 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7255 & AEAb2derx(1,lll,kkk,iii,2,2))
7262 C Antiparallel orientation of the two CA-CA-CA frames.
7264 iti=itortyp(itype(i))
7268 itk1=itortyp(itype(k+1))
7269 itl=itortyp(itype(l))
7270 itj=itortyp(itype(j))
7271 if (j.lt.nres-1) then
7272 itj1=itortyp(itype(j+1))
7276 C A2 kernel(j-1)T A1T
7277 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7278 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7279 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7280 C Following matrices are needed only for 6-th order cumulants
7281 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7282 & j.eq.i+4 .and. l.eq.i+3)) THEN
7283 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7284 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7285 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7286 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7287 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7288 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7289 & ADtEAderx(1,1,1,1,1,1))
7290 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7291 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7292 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7293 & ADtEA1derx(1,1,1,1,1,1))
7295 C End 6-th order cumulants
7296 call transpose2(EUgder(1,1,k),auxmat(1,1))
7297 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7298 call transpose2(EUg(1,1,k),auxmat(1,1))
7299 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7300 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7304 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7305 & EAEAderx(1,1,lll,kkk,iii,1))
7309 C A2T kernel(i+1)T A1
7310 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7311 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7312 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7313 C Following matrices are needed only for 6-th order cumulants
7314 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7315 & j.eq.i+4 .and. l.eq.i+3)) THEN
7316 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7317 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7318 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7319 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7320 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7321 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7322 & ADtEAderx(1,1,1,1,1,2))
7323 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7324 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7325 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7326 & ADtEA1derx(1,1,1,1,1,2))
7328 C End 6-th order cumulants
7329 call transpose2(EUgder(1,1,j),auxmat(1,1))
7330 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7331 call transpose2(EUg(1,1,j),auxmat(1,1))
7332 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7333 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7337 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7338 & EAEAderx(1,1,lll,kkk,iii,2))
7343 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7344 C They are needed only when the fifth- or the sixth-order cumulants are
7346 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7347 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7348 call transpose2(AEA(1,1,1),auxmat(1,1))
7349 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7350 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7351 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7352 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7353 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7354 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7355 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7356 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7357 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7358 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7359 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7360 call transpose2(AEA(1,1,2),auxmat(1,1))
7361 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7362 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7363 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7364 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7365 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7366 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7367 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7368 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7369 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7370 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7371 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7372 C Calculate the Cartesian derivatives of the vectors.
7376 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7377 call matvec2(auxmat(1,1),b1(1,i),
7378 & AEAb1derx(1,lll,kkk,iii,1,1))
7379 call matvec2(auxmat(1,1),Ub2(1,i),
7380 & AEAb2derx(1,lll,kkk,iii,1,1))
7381 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7382 & AEAb1derx(1,lll,kkk,iii,2,1))
7383 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7384 & AEAb2derx(1,lll,kkk,iii,2,1))
7385 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7386 call matvec2(auxmat(1,1),b1(1,l),
7387 & AEAb1derx(1,lll,kkk,iii,1,2))
7388 call matvec2(auxmat(1,1),Ub2(1,l),
7389 & AEAb2derx(1,lll,kkk,iii,1,2))
7390 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7391 & AEAb1derx(1,lll,kkk,iii,2,2))
7392 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7393 & AEAb2derx(1,lll,kkk,iii,2,2))
7402 C---------------------------------------------------------------------------
7403 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7404 & KK,KKderg,AKA,AKAderg,AKAderx)
7408 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7409 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7410 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7415 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7417 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7420 cd if (lprn) write (2,*) 'In kernel'
7422 cd if (lprn) write (2,*) 'kkk=',kkk
7424 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7425 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7427 cd write (2,*) 'lll=',lll
7428 cd write (2,*) 'iii=1'
7430 cd write (2,'(3(2f10.5),5x)')
7431 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7434 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7435 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7437 cd write (2,*) 'lll=',lll
7438 cd write (2,*) 'iii=2'
7440 cd write (2,'(3(2f10.5),5x)')
7441 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7448 C---------------------------------------------------------------------------
7449 double precision function eello4(i,j,k,l,jj,kk)
7450 implicit real*8 (a-h,o-z)
7451 include 'DIMENSIONS'
7452 include 'COMMON.IOUNITS'
7453 include 'COMMON.CHAIN'
7454 include 'COMMON.DERIV'
7455 include 'COMMON.INTERACT'
7456 include 'COMMON.CONTACTS'
7457 include 'COMMON.TORSION'
7458 include 'COMMON.VAR'
7459 include 'COMMON.GEO'
7460 double precision pizda(2,2),ggg1(3),ggg2(3)
7461 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7465 cd print *,'eello4:',i,j,k,l,jj,kk
7466 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7467 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7468 cold eij=facont_hb(jj,i)
7469 cold ekl=facont_hb(kk,k)
7471 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7472 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7473 gcorr_loc(k-1)=gcorr_loc(k-1)
7474 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7476 gcorr_loc(l-1)=gcorr_loc(l-1)
7477 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7479 gcorr_loc(j-1)=gcorr_loc(j-1)
7480 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7485 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7486 & -EAEAderx(2,2,lll,kkk,iii,1)
7487 cd derx(lll,kkk,iii)=0.0d0
7491 cd gcorr_loc(l-1)=0.0d0
7492 cd gcorr_loc(j-1)=0.0d0
7493 cd gcorr_loc(k-1)=0.0d0
7495 cd write (iout,*)'Contacts have occurred for peptide groups',
7496 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7497 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7498 if (j.lt.nres-1) then
7505 if (l.lt.nres-1) then
7513 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7514 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7515 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7516 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7517 cgrad ghalf=0.5d0*ggg1(ll)
7518 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7519 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7520 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7521 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7522 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7523 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7524 cgrad ghalf=0.5d0*ggg2(ll)
7525 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7526 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7527 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7528 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7529 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7530 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7534 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7539 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7544 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7549 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7553 cd write (2,*) iii,gcorr_loc(iii)
7556 cd write (2,*) 'ekont',ekont
7557 cd write (iout,*) 'eello4',ekont*eel4
7560 C---------------------------------------------------------------------------
7561 double precision function eello5(i,j,k,l,jj,kk)
7562 implicit real*8 (a-h,o-z)
7563 include 'DIMENSIONS'
7564 include 'COMMON.IOUNITS'
7565 include 'COMMON.CHAIN'
7566 include 'COMMON.DERIV'
7567 include 'COMMON.INTERACT'
7568 include 'COMMON.CONTACTS'
7569 include 'COMMON.TORSION'
7570 include 'COMMON.VAR'
7571 include 'COMMON.GEO'
7572 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7573 double precision ggg1(3),ggg2(3)
7574 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7579 C /l\ / \ \ / \ / \ / C
7580 C / \ / \ \ / \ / \ / C
7581 C j| o |l1 | o | o| o | | o |o C
7582 C \ |/k\| |/ \| / |/ \| |/ \| C
7583 C \i/ \ / \ / / \ / \ C
7585 C (I) (II) (III) (IV) C
7587 C eello5_1 eello5_2 eello5_3 eello5_4 C
7589 C Antiparallel chains C
7592 C /j\ / \ \ / \ / \ / C
7593 C / \ / \ \ / \ / \ / C
7594 C j1| o |l | o | o| o | | o |o C
7595 C \ |/k\| |/ \| / |/ \| |/ \| C
7596 C \i/ \ / \ / / \ / \ C
7598 C (I) (II) (III) (IV) C
7600 C eello5_1 eello5_2 eello5_3 eello5_4 C
7602 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7604 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7605 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7610 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7612 itk=itortyp(itype(k))
7613 itl=itortyp(itype(l))
7614 itj=itortyp(itype(j))
7619 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7620 cd & eel5_3_num,eel5_4_num)
7624 derx(lll,kkk,iii)=0.0d0
7628 cd eij=facont_hb(jj,i)
7629 cd ekl=facont_hb(kk,k)
7631 cd write (iout,*)'Contacts have occurred for peptide groups',
7632 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7634 C Contribution from the graph I.
7635 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7636 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7637 call transpose2(EUg(1,1,k),auxmat(1,1))
7638 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7639 vv(1)=pizda(1,1)-pizda(2,2)
7640 vv(2)=pizda(1,2)+pizda(2,1)
7641 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7642 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7643 C Explicit gradient in virtual-dihedral angles.
7644 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7645 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7646 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7647 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7648 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7649 vv(1)=pizda(1,1)-pizda(2,2)
7650 vv(2)=pizda(1,2)+pizda(2,1)
7651 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7652 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7653 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7654 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7655 vv(1)=pizda(1,1)-pizda(2,2)
7656 vv(2)=pizda(1,2)+pizda(2,1)
7658 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7659 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7662 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7663 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7664 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7666 C Cartesian gradient
7670 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7672 vv(1)=pizda(1,1)-pizda(2,2)
7673 vv(2)=pizda(1,2)+pizda(2,1)
7674 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7675 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7676 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7682 C Contribution from graph II
7683 call transpose2(EE(1,1,itk),auxmat(1,1))
7684 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7685 vv(1)=pizda(1,1)+pizda(2,2)
7686 vv(2)=pizda(2,1)-pizda(1,2)
7687 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7688 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7689 C Explicit gradient in virtual-dihedral angles.
7690 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7691 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7692 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7693 vv(1)=pizda(1,1)+pizda(2,2)
7694 vv(2)=pizda(2,1)-pizda(1,2)
7696 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7697 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7698 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7700 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7701 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7702 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7704 C Cartesian gradient
7708 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7710 vv(1)=pizda(1,1)+pizda(2,2)
7711 vv(2)=pizda(2,1)-pizda(1,2)
7712 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7713 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7714 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7722 C Parallel orientation
7723 C Contribution from graph III
7724 call transpose2(EUg(1,1,l),auxmat(1,1))
7725 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7726 vv(1)=pizda(1,1)-pizda(2,2)
7727 vv(2)=pizda(1,2)+pizda(2,1)
7728 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7729 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7730 C Explicit gradient in virtual-dihedral angles.
7731 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7732 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7733 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7734 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7735 vv(1)=pizda(1,1)-pizda(2,2)
7736 vv(2)=pizda(1,2)+pizda(2,1)
7737 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7738 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7739 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7740 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7741 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7742 vv(1)=pizda(1,1)-pizda(2,2)
7743 vv(2)=pizda(1,2)+pizda(2,1)
7744 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7745 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7746 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7747 C Cartesian gradient
7751 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7753 vv(1)=pizda(1,1)-pizda(2,2)
7754 vv(2)=pizda(1,2)+pizda(2,1)
7755 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7756 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7757 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7762 C Contribution from graph IV
7764 call transpose2(EE(1,1,itl),auxmat(1,1))
7765 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7766 vv(1)=pizda(1,1)+pizda(2,2)
7767 vv(2)=pizda(2,1)-pizda(1,2)
7768 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7769 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7770 C Explicit gradient in virtual-dihedral angles.
7771 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7772 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7773 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7774 vv(1)=pizda(1,1)+pizda(2,2)
7775 vv(2)=pizda(2,1)-pizda(1,2)
7776 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7777 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7778 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7779 C Cartesian gradient
7783 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7785 vv(1)=pizda(1,1)+pizda(2,2)
7786 vv(2)=pizda(2,1)-pizda(1,2)
7787 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7788 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7789 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7794 C Antiparallel orientation
7795 C Contribution from graph III
7797 call transpose2(EUg(1,1,j),auxmat(1,1))
7798 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7799 vv(1)=pizda(1,1)-pizda(2,2)
7800 vv(2)=pizda(1,2)+pizda(2,1)
7801 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7802 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7803 C Explicit gradient in virtual-dihedral angles.
7804 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7805 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7806 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7807 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7808 vv(1)=pizda(1,1)-pizda(2,2)
7809 vv(2)=pizda(1,2)+pizda(2,1)
7810 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7811 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7812 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7813 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7814 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7815 vv(1)=pizda(1,1)-pizda(2,2)
7816 vv(2)=pizda(1,2)+pizda(2,1)
7817 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7818 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7819 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7820 C Cartesian gradient
7824 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7826 vv(1)=pizda(1,1)-pizda(2,2)
7827 vv(2)=pizda(1,2)+pizda(2,1)
7828 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7829 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7830 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7835 C Contribution from graph IV
7837 call transpose2(EE(1,1,itj),auxmat(1,1))
7838 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7839 vv(1)=pizda(1,1)+pizda(2,2)
7840 vv(2)=pizda(2,1)-pizda(1,2)
7841 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7842 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7843 C Explicit gradient in virtual-dihedral angles.
7844 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7845 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7846 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7847 vv(1)=pizda(1,1)+pizda(2,2)
7848 vv(2)=pizda(2,1)-pizda(1,2)
7849 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7850 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7851 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7852 C Cartesian gradient
7856 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7858 vv(1)=pizda(1,1)+pizda(2,2)
7859 vv(2)=pizda(2,1)-pizda(1,2)
7860 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7861 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7862 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7868 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7869 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7870 cd write (2,*) 'ijkl',i,j,k,l
7871 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7872 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7874 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7875 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7876 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7877 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7878 if (j.lt.nres-1) then
7885 if (l.lt.nres-1) then
7895 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7896 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7897 C summed up outside the subrouine as for the other subroutines
7898 C handling long-range interactions. The old code is commented out
7899 C with "cgrad" to keep track of changes.
7901 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7902 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7903 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7904 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7905 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7906 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7907 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7908 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7909 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7910 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7912 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7913 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7914 cgrad ghalf=0.5d0*ggg1(ll)
7916 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7917 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7918 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7919 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7920 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7921 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7922 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7923 cgrad ghalf=0.5d0*ggg2(ll)
7925 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7926 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7927 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7928 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7929 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7930 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7935 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7936 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7941 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7942 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7948 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7953 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7957 cd write (2,*) iii,g_corr5_loc(iii)
7960 cd write (2,*) 'ekont',ekont
7961 cd write (iout,*) 'eello5',ekont*eel5
7964 c--------------------------------------------------------------------------
7965 double precision function eello6(i,j,k,l,jj,kk)
7966 implicit real*8 (a-h,o-z)
7967 include 'DIMENSIONS'
7968 include 'COMMON.IOUNITS'
7969 include 'COMMON.CHAIN'
7970 include 'COMMON.DERIV'
7971 include 'COMMON.INTERACT'
7972 include 'COMMON.CONTACTS'
7973 include 'COMMON.TORSION'
7974 include 'COMMON.VAR'
7975 include 'COMMON.GEO'
7976 include 'COMMON.FFIELD'
7977 double precision ggg1(3),ggg2(3)
7978 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7983 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7991 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7992 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7996 derx(lll,kkk,iii)=0.0d0
8000 cd eij=facont_hb(jj,i)
8001 cd ekl=facont_hb(kk,k)
8007 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8008 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8009 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8010 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8011 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8012 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8014 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8015 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8016 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8017 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8018 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8019 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8023 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8025 C If turn contributions are considered, they will be handled separately.
8026 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8027 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8028 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8029 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8030 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8031 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8032 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8034 if (j.lt.nres-1) then
8041 if (l.lt.nres-1) then
8049 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8050 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8051 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8052 cgrad ghalf=0.5d0*ggg1(ll)
8054 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8055 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8056 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8057 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8058 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8059 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8060 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8061 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8062 cgrad ghalf=0.5d0*ggg2(ll)
8063 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8065 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8066 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8067 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8068 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8069 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8070 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8075 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8076 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8081 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8082 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8088 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8093 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8097 cd write (2,*) iii,g_corr6_loc(iii)
8100 cd write (2,*) 'ekont',ekont
8101 cd write (iout,*) 'eello6',ekont*eel6
8104 c--------------------------------------------------------------------------
8105 double precision function eello6_graph1(i,j,k,l,imat,swap)
8106 implicit real*8 (a-h,o-z)
8107 include 'DIMENSIONS'
8108 include 'COMMON.IOUNITS'
8109 include 'COMMON.CHAIN'
8110 include 'COMMON.DERIV'
8111 include 'COMMON.INTERACT'
8112 include 'COMMON.CONTACTS'
8113 include 'COMMON.TORSION'
8114 include 'COMMON.VAR'
8115 include 'COMMON.GEO'
8116 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8120 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8122 C Parallel Antiparallel C
8128 C \ j|/k\| / \ |/k\|l / C
8133 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8134 itk=itortyp(itype(k))
8135 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8136 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8137 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8138 call transpose2(EUgC(1,1,k),auxmat(1,1))
8139 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8140 vv1(1)=pizda1(1,1)-pizda1(2,2)
8141 vv1(2)=pizda1(1,2)+pizda1(2,1)
8142 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8143 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8144 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8145 s5=scalar2(vv(1),Dtobr2(1,i))
8146 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8147 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8148 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8149 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8150 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8151 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8152 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8153 & +scalar2(vv(1),Dtobr2der(1,i)))
8154 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8155 vv1(1)=pizda1(1,1)-pizda1(2,2)
8156 vv1(2)=pizda1(1,2)+pizda1(2,1)
8157 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8158 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8160 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8161 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8162 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8163 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8164 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8166 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8167 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8168 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8169 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8170 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8172 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8173 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8174 vv1(1)=pizda1(1,1)-pizda1(2,2)
8175 vv1(2)=pizda1(1,2)+pizda1(2,1)
8176 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8177 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8178 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8179 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8188 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8189 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8190 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8191 call transpose2(EUgC(1,1,k),auxmat(1,1))
8192 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8194 vv1(1)=pizda1(1,1)-pizda1(2,2)
8195 vv1(2)=pizda1(1,2)+pizda1(2,1)
8196 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8197 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8198 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8199 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8200 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8201 s5=scalar2(vv(1),Dtobr2(1,i))
8202 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8208 c----------------------------------------------------------------------------
8209 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8210 implicit real*8 (a-h,o-z)
8211 include 'DIMENSIONS'
8212 include 'COMMON.IOUNITS'
8213 include 'COMMON.CHAIN'
8214 include 'COMMON.DERIV'
8215 include 'COMMON.INTERACT'
8216 include 'COMMON.CONTACTS'
8217 include 'COMMON.TORSION'
8218 include 'COMMON.VAR'
8219 include 'COMMON.GEO'
8221 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8222 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8225 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8227 C Parallel Antiparallel C
8233 C \ j|/k\| \ |/k\|l C
8238 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8239 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8240 C AL 7/4/01 s1 would occur in the sixth-order moment,
8241 C but not in a cluster cumulant
8243 s1=dip(1,jj,i)*dip(1,kk,k)
8245 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8246 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8247 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8248 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8249 call transpose2(EUg(1,1,k),auxmat(1,1))
8250 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8251 vv(1)=pizda(1,1)-pizda(2,2)
8252 vv(2)=pizda(1,2)+pizda(2,1)
8253 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8254 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8256 eello6_graph2=-(s1+s2+s3+s4)
8258 eello6_graph2=-(s2+s3+s4)
8261 C Derivatives in gamma(i-1)
8264 s1=dipderg(1,jj,i)*dip(1,kk,k)
8266 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8267 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8268 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8269 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8271 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8273 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8275 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8277 C Derivatives in gamma(k-1)
8279 s1=dip(1,jj,i)*dipderg(1,kk,k)
8281 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8282 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8283 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8284 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8285 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8286 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8287 vv(1)=pizda(1,1)-pizda(2,2)
8288 vv(2)=pizda(1,2)+pizda(2,1)
8289 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8291 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8293 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8295 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8296 C Derivatives in gamma(j-1) or gamma(l-1)
8299 s1=dipderg(3,jj,i)*dip(1,kk,k)
8301 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8302 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8303 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8304 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8305 vv(1)=pizda(1,1)-pizda(2,2)
8306 vv(2)=pizda(1,2)+pizda(2,1)
8307 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8310 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8312 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8315 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8316 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8318 C Derivatives in gamma(l-1) or gamma(j-1)
8321 s1=dip(1,jj,i)*dipderg(3,kk,k)
8323 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8324 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8325 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8326 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8327 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8328 vv(1)=pizda(1,1)-pizda(2,2)
8329 vv(2)=pizda(1,2)+pizda(2,1)
8330 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8333 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8335 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8338 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8339 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8341 C Cartesian derivatives.
8343 write (2,*) 'In eello6_graph2'
8345 write (2,*) 'iii=',iii
8347 write (2,*) 'kkk=',kkk
8349 write (2,'(3(2f10.5),5x)')
8350 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8360 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8362 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8365 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8367 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8368 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8370 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8371 call transpose2(EUg(1,1,k),auxmat(1,1))
8372 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8374 vv(1)=pizda(1,1)-pizda(2,2)
8375 vv(2)=pizda(1,2)+pizda(2,1)
8376 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8377 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8379 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8381 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8384 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8386 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8393 c----------------------------------------------------------------------------
8394 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8395 implicit real*8 (a-h,o-z)
8396 include 'DIMENSIONS'
8397 include 'COMMON.IOUNITS'
8398 include 'COMMON.CHAIN'
8399 include 'COMMON.DERIV'
8400 include 'COMMON.INTERACT'
8401 include 'COMMON.CONTACTS'
8402 include 'COMMON.TORSION'
8403 include 'COMMON.VAR'
8404 include 'COMMON.GEO'
8405 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8407 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8409 C Parallel Antiparallel C
8415 C j|/k\| / |/k\|l / C
8420 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8422 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8423 C energy moment and not to the cluster cumulant.
8424 iti=itortyp(itype(i))
8425 if (j.lt.nres-1) then
8426 itj1=itortyp(itype(j+1))
8430 itk=itortyp(itype(k))
8431 itk1=itortyp(itype(k+1))
8432 if (l.lt.nres-1) then
8433 itl1=itortyp(itype(l+1))
8438 s1=dip(4,jj,i)*dip(4,kk,k)
8440 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8441 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8442 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8443 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8444 call transpose2(EE(1,1,itk),auxmat(1,1))
8445 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8446 vv(1)=pizda(1,1)+pizda(2,2)
8447 vv(2)=pizda(2,1)-pizda(1,2)
8448 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8449 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8450 cd & "sum",-(s2+s3+s4)
8452 eello6_graph3=-(s1+s2+s3+s4)
8454 eello6_graph3=-(s2+s3+s4)
8457 C Derivatives in gamma(k-1)
8458 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8459 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8460 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8461 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8462 C Derivatives in gamma(l-1)
8463 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8464 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8465 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8466 vv(1)=pizda(1,1)+pizda(2,2)
8467 vv(2)=pizda(2,1)-pizda(1,2)
8468 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8469 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8470 C Cartesian derivatives.
8476 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8478 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8481 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8483 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8484 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8486 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8487 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8489 vv(1)=pizda(1,1)+pizda(2,2)
8490 vv(2)=pizda(2,1)-pizda(1,2)
8491 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8493 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8495 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8498 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8500 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8502 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8508 c----------------------------------------------------------------------------
8509 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8510 implicit real*8 (a-h,o-z)
8511 include 'DIMENSIONS'
8512 include 'COMMON.IOUNITS'
8513 include 'COMMON.CHAIN'
8514 include 'COMMON.DERIV'
8515 include 'COMMON.INTERACT'
8516 include 'COMMON.CONTACTS'
8517 include 'COMMON.TORSION'
8518 include 'COMMON.VAR'
8519 include 'COMMON.GEO'
8520 include 'COMMON.FFIELD'
8521 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8522 & auxvec1(2),auxmat1(2,2)
8524 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8526 C Parallel Antiparallel C
8532 C \ j|/k\| \ |/k\|l C
8537 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8539 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8540 C energy moment and not to the cluster cumulant.
8541 cd write (2,*) 'eello_graph4: wturn6',wturn6
8542 iti=itortyp(itype(i))
8543 itj=itortyp(itype(j))
8544 if (j.lt.nres-1) then
8545 itj1=itortyp(itype(j+1))
8549 itk=itortyp(itype(k))
8550 if (k.lt.nres-1) then
8551 itk1=itortyp(itype(k+1))
8555 itl=itortyp(itype(l))
8556 if (l.lt.nres-1) then
8557 itl1=itortyp(itype(l+1))
8561 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8562 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8563 cd & ' itl',itl,' itl1',itl1
8566 s1=dip(3,jj,i)*dip(3,kk,k)
8568 s1=dip(2,jj,j)*dip(2,kk,l)
8571 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8572 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8574 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8575 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8577 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8578 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8580 call transpose2(EUg(1,1,k),auxmat(1,1))
8581 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8582 vv(1)=pizda(1,1)-pizda(2,2)
8583 vv(2)=pizda(2,1)+pizda(1,2)
8584 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8585 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8587 eello6_graph4=-(s1+s2+s3+s4)
8589 eello6_graph4=-(s2+s3+s4)
8591 C Derivatives in gamma(i-1)
8595 s1=dipderg(2,jj,i)*dip(3,kk,k)
8597 s1=dipderg(4,jj,j)*dip(2,kk,l)
8600 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8602 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8603 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8605 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8606 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8608 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8609 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8610 cd write (2,*) 'turn6 derivatives'
8612 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8614 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8618 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8620 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8624 C Derivatives in gamma(k-1)
8627 s1=dip(3,jj,i)*dipderg(2,kk,k)
8629 s1=dip(2,jj,j)*dipderg(4,kk,l)
8632 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8633 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8635 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8636 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8638 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8639 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8641 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8642 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8643 vv(1)=pizda(1,1)-pizda(2,2)
8644 vv(2)=pizda(2,1)+pizda(1,2)
8645 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8646 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8648 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8650 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8654 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8656 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8659 C Derivatives in gamma(j-1) or gamma(l-1)
8660 if (l.eq.j+1 .and. l.gt.1) then
8661 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8662 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8663 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8664 vv(1)=pizda(1,1)-pizda(2,2)
8665 vv(2)=pizda(2,1)+pizda(1,2)
8666 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8667 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8668 else if (j.gt.1) then
8669 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8670 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8671 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8672 vv(1)=pizda(1,1)-pizda(2,2)
8673 vv(2)=pizda(2,1)+pizda(1,2)
8674 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8675 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8676 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8678 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8681 C Cartesian derivatives.
8688 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8690 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8694 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8696 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8700 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8702 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8704 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8705 & b1(1,j+1),auxvec(1))
8706 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8708 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8709 & b1(1,l+1),auxvec(1))
8710 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8712 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8714 vv(1)=pizda(1,1)-pizda(2,2)
8715 vv(2)=pizda(2,1)+pizda(1,2)
8716 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8718 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8720 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8723 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8726 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8729 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8731 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8733 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8737 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8739 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8742 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8744 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8752 c----------------------------------------------------------------------------
8753 double precision function eello_turn6(i,jj,kk)
8754 implicit real*8 (a-h,o-z)
8755 include 'DIMENSIONS'
8756 include 'COMMON.IOUNITS'
8757 include 'COMMON.CHAIN'
8758 include 'COMMON.DERIV'
8759 include 'COMMON.INTERACT'
8760 include 'COMMON.CONTACTS'
8761 include 'COMMON.TORSION'
8762 include 'COMMON.VAR'
8763 include 'COMMON.GEO'
8764 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8765 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8767 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8768 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8769 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8770 C the respective energy moment and not to the cluster cumulant.
8779 iti=itortyp(itype(i))
8780 itk=itortyp(itype(k))
8781 itk1=itortyp(itype(k+1))
8782 itl=itortyp(itype(l))
8783 itj=itortyp(itype(j))
8784 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8785 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8786 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8791 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8793 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8797 derx_turn(lll,kkk,iii)=0.0d0
8804 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8806 cd write (2,*) 'eello6_5',eello6_5
8808 call transpose2(AEA(1,1,1),auxmat(1,1))
8809 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8810 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8811 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8813 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8814 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8815 s2 = scalar2(b1(1,k),vtemp1(1))
8817 call transpose2(AEA(1,1,2),atemp(1,1))
8818 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8819 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8820 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8822 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8823 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8824 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8826 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8827 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8828 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8829 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8830 ss13 = scalar2(b1(1,k),vtemp4(1))
8831 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8833 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8839 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8840 C Derivatives in gamma(i+2)
8844 call transpose2(AEA(1,1,1),auxmatd(1,1))
8845 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8846 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8847 call transpose2(AEAderg(1,1,2),atempd(1,1))
8848 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8849 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8851 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8852 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8853 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8859 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8860 C Derivatives in gamma(i+3)
8862 call transpose2(AEA(1,1,1),auxmatd(1,1))
8863 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8864 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8865 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8867 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8868 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8869 s2d = scalar2(b1(1,k),vtemp1d(1))
8871 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8872 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8874 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8876 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8877 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8878 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8886 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8887 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8889 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8890 & -0.5d0*ekont*(s2d+s12d)
8892 C Derivatives in gamma(i+4)
8893 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8894 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8895 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8897 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8898 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8899 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8907 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8909 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8911 C Derivatives in gamma(i+5)
8913 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8914 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8915 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8917 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8918 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8919 s2d = scalar2(b1(1,k),vtemp1d(1))
8921 call transpose2(AEA(1,1,2),atempd(1,1))
8922 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8923 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8925 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8926 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8928 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8929 ss13d = scalar2(b1(1,k),vtemp4d(1))
8930 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8938 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8939 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8941 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8942 & -0.5d0*ekont*(s2d+s12d)
8944 C Cartesian derivatives
8949 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8950 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8951 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8953 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8954 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8956 s2d = scalar2(b1(1,k),vtemp1d(1))
8958 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8959 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8960 s8d = -(atempd(1,1)+atempd(2,2))*
8961 & scalar2(cc(1,1,itl),vtemp2(1))
8963 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8965 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8966 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8973 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8976 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8980 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8981 & - 0.5d0*(s8d+s12d)
8983 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8992 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8994 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8995 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8996 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8997 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8998 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9000 ss13d = scalar2(b1(1,k),vtemp4d(1))
9001 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9002 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9006 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9007 cd & 16*eel_turn6_num
9009 if (j.lt.nres-1) then
9016 if (l.lt.nres-1) then
9024 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9025 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9026 cgrad ghalf=0.5d0*ggg1(ll)
9028 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9029 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9030 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9031 & +ekont*derx_turn(ll,2,1)
9032 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9033 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9034 & +ekont*derx_turn(ll,4,1)
9035 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9036 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9037 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9038 cgrad ghalf=0.5d0*ggg2(ll)
9040 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9041 & +ekont*derx_turn(ll,2,2)
9042 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9043 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9044 & +ekont*derx_turn(ll,4,2)
9045 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9046 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9047 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9052 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9057 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9063 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9068 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9072 cd write (2,*) iii,g_corr6_loc(iii)
9074 eello_turn6=ekont*eel_turn6
9075 cd write (2,*) 'ekont',ekont
9076 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9080 C-----------------------------------------------------------------------------
9081 double precision function scalar(u,v)
9082 !DIR$ INLINEALWAYS scalar
9084 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9087 double precision u(3),v(3)
9088 cd double precision sc
9096 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9099 crc-------------------------------------------------
9100 SUBROUTINE MATVEC2(A1,V1,V2)
9101 !DIR$ INLINEALWAYS MATVEC2
9103 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9105 implicit real*8 (a-h,o-z)
9106 include 'DIMENSIONS'
9107 DIMENSION A1(2,2),V1(2),V2(2)
9111 c 3 VI=VI+A1(I,K)*V1(K)
9115 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9116 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9121 C---------------------------------------
9122 SUBROUTINE MATMAT2(A1,A2,A3)
9124 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9126 implicit real*8 (a-h,o-z)
9127 include 'DIMENSIONS'
9128 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9129 c DIMENSION AI3(2,2)
9133 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9139 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9140 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9141 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9142 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9150 c-------------------------------------------------------------------------
9151 double precision function scalar2(u,v)
9152 !DIR$ INLINEALWAYS scalar2
9154 double precision u(2),v(2)
9157 scalar2=u(1)*v(1)+u(2)*v(2)
9161 C-----------------------------------------------------------------------------
9163 subroutine transpose2(a,at)
9164 !DIR$ INLINEALWAYS transpose2
9166 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9169 double precision a(2,2),at(2,2)
9176 c--------------------------------------------------------------------------
9177 subroutine transpose(n,a,at)
9180 double precision a(n,n),at(n,n)
9188 C---------------------------------------------------------------------------
9189 subroutine prodmat3(a1,a2,kk,transp,prod)
9190 !DIR$ INLINEALWAYS prodmat3
9192 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9196 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9198 crc double precision auxmat(2,2),prod_(2,2)
9201 crc call transpose2(kk(1,1),auxmat(1,1))
9202 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9203 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9205 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9206 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9207 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9208 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9209 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9210 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9211 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9212 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9215 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9216 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9218 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9219 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9220 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9221 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9222 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9223 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9224 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9225 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9228 c call transpose2(a2(1,1),a2t(1,1))
9231 crc print *,((prod_(i,j),i=1,2),j=1,2)
9232 crc print *,((prod(i,j),i=1,2),j=1,2)