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)
2302 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2303 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2304 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2305 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2306 b1tilde(1,i-2)=b1(1,i-2)
2307 b1tilde(2,i-2)=-b1(2,i-2)
2308 b2tilde(1,i-2)=b2(1,i-2)
2309 b2tilde(2,i-2)=-b2(2,i-2)
2310 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2311 write (iout,*) 'theta=', theta(i-1)
2314 do i=ivec_start+2,ivec_end+2
2319 if (i .lt. nres+1) then
2356 if (i .gt. 3 .and. i .lt. nres+1) then
2357 obrot_der(1,i-2)=-sin1
2358 obrot_der(2,i-2)= cos1
2359 Ugder(1,1,i-2)= sin1
2360 Ugder(1,2,i-2)=-cos1
2361 Ugder(2,1,i-2)=-cos1
2362 Ugder(2,2,i-2)=-sin1
2365 obrot2_der(1,i-2)=-dwasin2
2366 obrot2_der(2,i-2)= dwacos2
2367 Ug2der(1,1,i-2)= dwasin2
2368 Ug2der(1,2,i-2)=-dwacos2
2369 Ug2der(2,1,i-2)=-dwacos2
2370 Ug2der(2,2,i-2)=-dwasin2
2372 obrot_der(1,i-2)=0.0d0
2373 obrot_der(2,i-2)=0.0d0
2374 Ugder(1,1,i-2)=0.0d0
2375 Ugder(1,2,i-2)=0.0d0
2376 Ugder(2,1,i-2)=0.0d0
2377 Ugder(2,2,i-2)=0.0d0
2378 obrot2_der(1,i-2)=0.0d0
2379 obrot2_der(2,i-2)=0.0d0
2380 Ug2der(1,1,i-2)=0.0d0
2381 Ug2der(1,2,i-2)=0.0d0
2382 Ug2der(2,1,i-2)=0.0d0
2383 Ug2der(2,2,i-2)=0.0d0
2385 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2387 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2388 iti = itortyp(itype(i-2))
2392 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2393 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2394 iti1 = itortyp(itype(i-1))
2399 cd write (iout,*) '*******i',i,' iti1',iti
2400 cd write (iout,*) 'b1',b1(:,iti)
2401 cd write (iout,*) 'b2',b2(:,iti)
2402 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2403 c if (i .gt. iatel_s+2) then
2404 if (i .gt. nnt+2) then
2405 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2407 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2408 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2410 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2411 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2413 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2414 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2415 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2416 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2417 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2428 DtUg2(l,k,i-2)=0.0d0
2432 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2433 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2435 muder(k,i-2)=Ub2der(k,i-2)
2437 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2438 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2439 if (itype(i-1).le.ntyp) then
2440 iti1 = itortyp(itype(i-1))
2448 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2450 cd write (iout,*) 'mu ',mu(:,i-2)
2451 cd write (iout,*) 'mu1',mu1(:,i-2)
2452 cd write (iout,*) 'mu2',mu2(:,i-2)
2453 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2455 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2456 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2457 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2458 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2459 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2460 C Vectors and matrices dependent on a single virtual-bond dihedral.
2461 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2462 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2463 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2464 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2465 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2466 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2467 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2468 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2469 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2472 C Matrices dependent on two consecutive virtual-bond dihedrals.
2473 C The order of matrices is from left to right.
2474 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2476 c do i=max0(ivec_start,2),ivec_end
2478 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2479 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2480 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2481 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2482 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2483 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2484 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2485 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2488 #if defined(MPI) && defined(PARMAT)
2490 c if (fg_rank.eq.0) then
2491 write (iout,*) "Arrays UG and UGDER before GATHER"
2493 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2494 & ((ug(l,k,i),l=1,2),k=1,2),
2495 & ((ugder(l,k,i),l=1,2),k=1,2)
2497 write (iout,*) "Arrays UG2 and UG2DER"
2499 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2500 & ((ug2(l,k,i),l=1,2),k=1,2),
2501 & ((ug2der(l,k,i),l=1,2),k=1,2)
2503 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2505 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2506 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2507 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2509 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2511 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2512 & costab(i),sintab(i),costab2(i),sintab2(i)
2514 write (iout,*) "Array MUDER"
2516 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2520 if (nfgtasks.gt.1) then
2522 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2523 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2524 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2526 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2527 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2529 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2530 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2532 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2533 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2535 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2536 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2538 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2539 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2541 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2542 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2544 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2545 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2546 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2547 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2548 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2549 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2550 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2551 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2552 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2553 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2554 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2555 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2556 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2558 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2559 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2561 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2562 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2564 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2565 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2567 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2568 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2570 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2571 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2573 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2574 & ivec_count(fg_rank1),
2575 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2577 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2578 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2580 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2581 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2583 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2584 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2586 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2587 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2589 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2590 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2592 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2593 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2595 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2596 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2598 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2599 & ivec_count(fg_rank1),
2600 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2602 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2603 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2605 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2606 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2608 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2609 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2611 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2612 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2614 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2615 & ivec_count(fg_rank1),
2616 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2618 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2619 & ivec_count(fg_rank1),
2620 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2622 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2623 & ivec_count(fg_rank1),
2624 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2625 & MPI_MAT2,FG_COMM1,IERR)
2626 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2627 & ivec_count(fg_rank1),
2628 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2629 & MPI_MAT2,FG_COMM1,IERR)
2632 c Passes matrix info through the ring
2635 if (irecv.lt.0) irecv=nfgtasks1-1
2638 if (inext.ge.nfgtasks1) inext=0
2640 c write (iout,*) "isend",isend," irecv",irecv
2642 lensend=lentyp(isend)
2643 lenrecv=lentyp(irecv)
2644 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2645 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2646 c & MPI_ROTAT1(lensend),inext,2200+isend,
2647 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2648 c & iprev,2200+irecv,FG_COMM,status,IERR)
2649 c write (iout,*) "Gather ROTAT1"
2651 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2652 c & MPI_ROTAT2(lensend),inext,3300+isend,
2653 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2654 c & iprev,3300+irecv,FG_COMM,status,IERR)
2655 c write (iout,*) "Gather ROTAT2"
2657 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2658 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2659 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2660 & iprev,4400+irecv,FG_COMM,status,IERR)
2661 c write (iout,*) "Gather ROTAT_OLD"
2663 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2664 & MPI_PRECOMP11(lensend),inext,5500+isend,
2665 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2666 & iprev,5500+irecv,FG_COMM,status,IERR)
2667 c write (iout,*) "Gather PRECOMP11"
2669 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2670 & MPI_PRECOMP12(lensend),inext,6600+isend,
2671 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2672 & iprev,6600+irecv,FG_COMM,status,IERR)
2673 c write (iout,*) "Gather PRECOMP12"
2675 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2677 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2678 & MPI_ROTAT2(lensend),inext,7700+isend,
2679 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2680 & iprev,7700+irecv,FG_COMM,status,IERR)
2681 c write (iout,*) "Gather PRECOMP21"
2683 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2684 & MPI_PRECOMP22(lensend),inext,8800+isend,
2685 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2686 & iprev,8800+irecv,FG_COMM,status,IERR)
2687 c write (iout,*) "Gather PRECOMP22"
2689 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2690 & MPI_PRECOMP23(lensend),inext,9900+isend,
2691 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2692 & MPI_PRECOMP23(lenrecv),
2693 & iprev,9900+irecv,FG_COMM,status,IERR)
2694 c write (iout,*) "Gather PRECOMP23"
2699 if (irecv.lt.0) irecv=nfgtasks1-1
2702 time_gather=time_gather+MPI_Wtime()-time00
2705 c if (fg_rank.eq.0) then
2706 write (iout,*) "Arrays UG and UGDER"
2708 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2709 & ((ug(l,k,i),l=1,2),k=1,2),
2710 & ((ugder(l,k,i),l=1,2),k=1,2)
2712 write (iout,*) "Arrays UG2 and UG2DER"
2714 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2715 & ((ug2(l,k,i),l=1,2),k=1,2),
2716 & ((ug2der(l,k,i),l=1,2),k=1,2)
2718 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2720 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2721 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2722 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2724 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2726 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2727 & costab(i),sintab(i),costab2(i),sintab2(i)
2729 write (iout,*) "Array MUDER"
2731 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2737 cd iti = itortyp(itype(i))
2740 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2741 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2746 C--------------------------------------------------------------------------
2747 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2749 C This subroutine calculates the average interaction energy and its gradient
2750 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2751 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2752 C The potential depends both on the distance of peptide-group centers and on
2753 C the orientation of the CA-CA virtual bonds.
2755 implicit real*8 (a-h,o-z)
2759 include 'DIMENSIONS'
2760 include 'COMMON.CONTROL'
2761 include 'COMMON.SETUP'
2762 include 'COMMON.IOUNITS'
2763 include 'COMMON.GEO'
2764 include 'COMMON.VAR'
2765 include 'COMMON.LOCAL'
2766 include 'COMMON.CHAIN'
2767 include 'COMMON.DERIV'
2768 include 'COMMON.INTERACT'
2769 include 'COMMON.CONTACTS'
2770 include 'COMMON.TORSION'
2771 include 'COMMON.VECTORS'
2772 include 'COMMON.FFIELD'
2773 include 'COMMON.TIME1'
2774 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2775 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2776 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2777 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2778 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2779 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2781 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2783 double precision scal_el /1.0d0/
2785 double precision scal_el /0.5d0/
2788 C 13-go grudnia roku pamietnego...
2789 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2790 & 0.0d0,1.0d0,0.0d0,
2791 & 0.0d0,0.0d0,1.0d0/
2792 cd write(iout,*) 'In EELEC'
2794 cd write(iout,*) 'Type',i
2795 cd write(iout,*) 'B1',B1(:,i)
2796 cd write(iout,*) 'B2',B2(:,i)
2797 cd write(iout,*) 'CC',CC(:,:,i)
2798 cd write(iout,*) 'DD',DD(:,:,i)
2799 cd write(iout,*) 'EE',EE(:,:,i)
2801 cd call check_vecgrad
2803 if (icheckgrad.eq.1) then
2805 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2807 dc_norm(k,i)=dc(k,i)*fac
2809 c write (iout,*) 'i',i,' fac',fac
2812 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2813 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2814 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2815 c call vec_and_deriv
2821 time_mat=time_mat+MPI_Wtime()-time01
2825 cd write (iout,*) 'i=',i
2827 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2830 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2831 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2844 cd print '(a)','Enter EELEC'
2845 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2847 gel_loc_loc(i)=0.0d0
2852 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2854 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2856 do i=iturn3_start,iturn3_end
2857 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2858 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2862 dx_normi=dc_norm(1,i)
2863 dy_normi=dc_norm(2,i)
2864 dz_normi=dc_norm(3,i)
2865 xmedi=c(1,i)+0.5d0*dxi
2866 ymedi=c(2,i)+0.5d0*dyi
2867 zmedi=c(3,i)+0.5d0*dzi
2870 c call eelecij(i,i+2,ees,evdw1,eel_loc)
2871 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2872 num_cont_hb(i)=num_conti
2874 do i=iturn4_start,iturn4_end
2875 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2876 & .or. itype(i+3).eq.ntyp1
2877 & .or. itype(i+4).eq.ntyp1) cycle
2881 dx_normi=dc_norm(1,i)
2882 dy_normi=dc_norm(2,i)
2883 dz_normi=dc_norm(3,i)
2884 xmedi=c(1,i)+0.5d0*dxi
2885 ymedi=c(2,i)+0.5d0*dyi
2886 zmedi=c(3,i)+0.5d0*dzi
2887 num_conti=num_cont_hb(i)
2889 c call eelecij(i,i+3,ees,evdw1,eel_loc)
2890 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2891 & call eturn4(i,eello_turn4)
2892 num_cont_hb(i)=num_conti
2895 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2897 c do i=iatel_s,iatel_e
2899 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2903 dx_normi=dc_norm(1,i)
2904 dy_normi=dc_norm(2,i)
2905 dz_normi=dc_norm(3,i)
2906 xmedi=c(1,i)+0.5d0*dxi
2907 ymedi=c(2,i)+0.5d0*dyi
2908 zmedi=c(3,i)+0.5d0*dzi
2909 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2910 num_conti=num_cont_hb(i)
2911 c do j=ielstart(i),ielend(i)
2913 write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
2914 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2915 call eelecij(i,j,ees,evdw1,eel_loc)
2917 num_cont_hb(i)=num_conti
2919 c write (iout,*) "Number of loop steps in EELEC:",ind
2921 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2922 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2924 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2925 ccc eel_loc=eel_loc+eello_turn3
2926 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2929 C-------------------------------------------------------------------------------
2930 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2931 implicit real*8 (a-h,o-z)
2932 include 'DIMENSIONS'
2936 include 'COMMON.CONTROL'
2937 include 'COMMON.IOUNITS'
2938 include 'COMMON.GEO'
2939 include 'COMMON.VAR'
2940 include 'COMMON.LOCAL'
2941 include 'COMMON.CHAIN'
2942 include 'COMMON.DERIV'
2943 include 'COMMON.INTERACT'
2944 include 'COMMON.CONTACTS'
2945 include 'COMMON.TORSION'
2946 include 'COMMON.VECTORS'
2947 include 'COMMON.FFIELD'
2948 include 'COMMON.TIME1'
2949 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2950 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2951 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2952 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2953 & gmuij2(4),gmuji2(4)
2954 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2955 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2957 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2959 double precision scal_el /1.0d0/
2961 double precision scal_el /0.5d0/
2964 C 13-go grudnia roku pamietnego...
2965 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2966 & 0.0d0,1.0d0,0.0d0,
2967 & 0.0d0,0.0d0,1.0d0/
2968 c time00=MPI_Wtime()
2969 cd write (iout,*) "eelecij",i,j
2973 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2974 aaa=app(iteli,itelj)
2975 bbb=bpp(iteli,itelj)
2976 ael6i=ael6(iteli,itelj)
2977 ael3i=ael3(iteli,itelj)
2981 dx_normj=dc_norm(1,j)
2982 dy_normj=dc_norm(2,j)
2983 dz_normj=dc_norm(3,j)
2984 xj=c(1,j)+0.5D0*dxj-xmedi
2985 yj=c(2,j)+0.5D0*dyj-ymedi
2986 zj=c(3,j)+0.5D0*dzj-zmedi
2987 rij=xj*xj+yj*yj+zj*zj
2993 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2994 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2995 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2996 fac=cosa-3.0D0*cosb*cosg
2998 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2999 if (j.eq.i+2) ev1=scal_el*ev1
3004 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3007 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3008 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3011 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3012 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3013 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3014 cd & xmedi,ymedi,zmedi,xj,yj,zj
3016 if (energy_dec) then
3017 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3019 &,iteli,itelj,aaa,evdw1
3020 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3024 C Calculate contributions to the Cartesian gradient.
3027 facvdw=-6*rrmij*(ev1+evdwij)
3028 facel=-3*rrmij*(el1+eesij)
3034 * Radial derivatives. First process both termini of the fragment (i,j)
3040 c ghalf=0.5D0*ggg(k)
3041 c gelc(k,i)=gelc(k,i)+ghalf
3042 c gelc(k,j)=gelc(k,j)+ghalf
3044 c 9/28/08 AL Gradient compotents will be summed only at the end
3046 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3047 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3050 * Loop over residues i+1 thru j-1.
3054 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3061 c ghalf=0.5D0*ggg(k)
3062 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3063 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3065 c 9/28/08 AL Gradient compotents will be summed only at the end
3067 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3068 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3071 * Loop over residues i+1 thru j-1.
3075 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3082 fac=-3*rrmij*(facvdw+facvdw+facel)
3087 * Radial derivatives. First process both termini of the fragment (i,j)
3093 c ghalf=0.5D0*ggg(k)
3094 c gelc(k,i)=gelc(k,i)+ghalf
3095 c gelc(k,j)=gelc(k,j)+ghalf
3097 c 9/28/08 AL Gradient compotents will be summed only at the end
3099 gelc_long(k,j)=gelc(k,j)+ggg(k)
3100 gelc_long(k,i)=gelc(k,i)-ggg(k)
3103 * Loop over residues i+1 thru j-1.
3107 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3110 c 9/28/08 AL Gradient compotents will be summed only at the end
3115 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3116 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3122 ecosa=2.0D0*fac3*fac1+fac4
3125 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3126 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3128 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3129 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3131 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3132 cd & (dcosg(k),k=1,3)
3134 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3137 c ghalf=0.5D0*ggg(k)
3138 c gelc(k,i)=gelc(k,i)+ghalf
3139 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3140 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3141 c gelc(k,j)=gelc(k,j)+ghalf
3142 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3143 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3147 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3152 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3153 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3155 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3156 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3157 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3158 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3160 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3161 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3162 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3164 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3165 C energy of a peptide unit is assumed in the form of a second-order
3166 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3167 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3168 C are computed for EVERY pair of non-contiguous peptide groups.
3171 if (j.lt.nres-1) then
3183 muij(kkk)=mu(k,i)*mu(l,j)
3185 gmuij1(kkk)=gtb1(k,i)*mu(l,j)
3186 write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(k,i),k,i
3187 gmuij2(kkk)=gUb2(k,i-1)*mu(l,j)
3188 gmuji1(kkk)=mu(k,i)*gtb1(l,j)
3189 write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(l,j),l,j
3190 gmuji2(kkk)=mu(k,i)*gUb2(l,j-1)
3194 cd write (iout,*) 'EELEC: i',i,' j',j
3195 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3196 cd write(iout,*) 'muij',muij
3197 ury=scalar(uy(1,i),erij)
3198 urz=scalar(uz(1,i),erij)
3199 vry=scalar(uy(1,j),erij)
3200 vrz=scalar(uz(1,j),erij)
3201 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3202 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3203 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3204 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3205 fac=dsqrt(-ael6i)*r3ij
3210 cd write (iout,'(4i5,4f10.5)')
3211 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3212 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3213 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3214 cd & uy(:,j),uz(:,j)
3215 cd write (iout,'(4f10.5)')
3216 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3217 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3218 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3219 cd write (iout,'(9f10.5/)')
3220 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3221 C Derivatives of the elements of A in virtual-bond vectors
3222 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3224 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3225 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3226 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3227 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3228 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3229 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3230 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3231 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3232 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3233 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3234 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3235 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3237 C Compute radial contributions to the gradient
3255 C Add the contributions coming from er
3258 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3259 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3260 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3261 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3264 C Derivatives in DC(i)
3265 cgrad ghalf1=0.5d0*agg(k,1)
3266 cgrad ghalf2=0.5d0*agg(k,2)
3267 cgrad ghalf3=0.5d0*agg(k,3)
3268 cgrad ghalf4=0.5d0*agg(k,4)
3269 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3270 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3271 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3272 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3273 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3274 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3275 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3276 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3277 C Derivatives in DC(i+1)
3278 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3279 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3280 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3281 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3282 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3283 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3284 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3285 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3286 C Derivatives in DC(j)
3287 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3288 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3289 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3290 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3291 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3292 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3293 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3294 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3295 C Derivatives in DC(j+1) or DC(nres-1)
3296 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3297 & -3.0d0*vryg(k,3)*ury)
3298 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3299 & -3.0d0*vrzg(k,3)*ury)
3300 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3301 & -3.0d0*vryg(k,3)*urz)
3302 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3303 & -3.0d0*vrzg(k,3)*urz)
3304 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3306 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3319 aggi(k,l)=-aggi(k,l)
3320 aggi1(k,l)=-aggi1(k,l)
3321 aggj(k,l)=-aggj(k,l)
3322 aggj1(k,l)=-aggj1(k,l)
3325 if (j.lt.nres-1) then
3331 aggi(k,l)=-aggi(k,l)
3332 aggi1(k,l)=-aggi1(k,l)
3333 aggj(k,l)=-aggj(k,l)
3334 aggj1(k,l)=-aggj1(k,l)
3345 aggi(k,l)=-aggi(k,l)
3346 aggi1(k,l)=-aggi1(k,l)
3347 aggj(k,l)=-aggj(k,l)
3348 aggj1(k,l)=-aggj1(k,l)
3353 IF (wel_loc.gt.0.0d0) THEN
3354 C Contribution to the local-electrostatic energy coming from the i-j pair
3355 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3357 C Calculate patrial derivative for theta angle
3359 geel_loc_ij=a22*gmuij1(1)
3363 write(iout,*) "derivative over thatai"
3364 write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3366 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3367 & geel_loc_ij*wel_loc
3368 write(iout,*) "derivative over thatai-1"
3369 write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3371 geel_loc_ij=a22*gmuij2(1)+a23*gmuij2(2)+a32*gmuij2(3)
3373 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3374 & geel_loc_ij*wel_loc
3375 geel_loc_ji=a22*gmuji1(1)+a23*gmuji1(2)+a32*gmuji1(3)
3377 write(iout,*) "derivative over thataj"
3378 write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3381 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3382 & geel_loc_ji*wel_loc
3383 geel_loc_ji=a22*gmuji2(1)+a23*gmuji2(2)+a32*gmuji2(3)
3385 write(iout,*) "derivative over thataj-1"
3386 write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3388 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3389 & geel_loc_ji*wel_loc
3391 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3393 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3394 & 'eelloc',i,j,eel_loc_ij
3395 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3397 eel_loc=eel_loc+eel_loc_ij
3398 C Partial derivatives in virtual-bond dihedral angles gamma
3400 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3401 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3402 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3403 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3404 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3405 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3406 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3408 ggg(l)=agg(l,1)*muij(1)+
3409 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3410 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3411 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3412 cgrad ghalf=0.5d0*ggg(l)
3413 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3414 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3418 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3421 C Remaining derivatives of eello
3423 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3424 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3425 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3426 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3427 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3428 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3429 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3430 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3433 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3434 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3435 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3436 & .and. num_conti.le.maxconts) then
3437 c write (iout,*) i,j," entered corr"
3439 C Calculate the contact function. The ith column of the array JCONT will
3440 C contain the numbers of atoms that make contacts with the atom I (of numbers
3441 C greater than I). The arrays FACONT and GACONT will contain the values of
3442 C the contact function and its derivative.
3443 c r0ij=1.02D0*rpp(iteli,itelj)
3444 c r0ij=1.11D0*rpp(iteli,itelj)
3445 r0ij=2.20D0*rpp(iteli,itelj)
3446 c r0ij=1.55D0*rpp(iteli,itelj)
3447 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3448 if (fcont.gt.0.0D0) then
3449 num_conti=num_conti+1
3450 if (num_conti.gt.maxconts) then
3451 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3452 & ' will skip next contacts for this conf.'
3454 jcont_hb(num_conti,i)=j
3455 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3456 cd & " jcont_hb",jcont_hb(num_conti,i)
3457 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3458 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3459 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3461 d_cont(num_conti,i)=rij
3462 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3463 C --- Electrostatic-interaction matrix ---
3464 a_chuj(1,1,num_conti,i)=a22
3465 a_chuj(1,2,num_conti,i)=a23
3466 a_chuj(2,1,num_conti,i)=a32
3467 a_chuj(2,2,num_conti,i)=a33
3468 C --- Gradient of rij
3470 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3477 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3478 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3479 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3480 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3481 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3486 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3487 C Calculate contact energies
3489 wij=cosa-3.0D0*cosb*cosg
3492 c fac3=dsqrt(-ael6i)/r0ij**3
3493 fac3=dsqrt(-ael6i)*r3ij
3494 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3495 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3496 if (ees0tmp.gt.0) then
3497 ees0pij=dsqrt(ees0tmp)
3501 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3502 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3503 if (ees0tmp.gt.0) then
3504 ees0mij=dsqrt(ees0tmp)
3509 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3510 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3511 C Diagnostics. Comment out or remove after debugging!
3512 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3513 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3514 c ees0m(num_conti,i)=0.0D0
3516 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3517 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3518 C Angular derivatives of the contact function
3519 ees0pij1=fac3/ees0pij
3520 ees0mij1=fac3/ees0mij
3521 fac3p=-3.0D0*fac3*rrmij
3522 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3523 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3525 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3526 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3527 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3528 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3529 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3530 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3531 ecosap=ecosa1+ecosa2
3532 ecosbp=ecosb1+ecosb2
3533 ecosgp=ecosg1+ecosg2
3534 ecosam=ecosa1-ecosa2
3535 ecosbm=ecosb1-ecosb2
3536 ecosgm=ecosg1-ecosg2
3545 facont_hb(num_conti,i)=fcont
3546 fprimcont=fprimcont/rij
3547 cd facont_hb(num_conti,i)=1.0D0
3548 C Following line is for diagnostics.
3551 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3552 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3555 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3556 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3558 gggp(1)=gggp(1)+ees0pijp*xj
3559 gggp(2)=gggp(2)+ees0pijp*yj
3560 gggp(3)=gggp(3)+ees0pijp*zj
3561 gggm(1)=gggm(1)+ees0mijp*xj
3562 gggm(2)=gggm(2)+ees0mijp*yj
3563 gggm(3)=gggm(3)+ees0mijp*zj
3564 C Derivatives due to the contact function
3565 gacont_hbr(1,num_conti,i)=fprimcont*xj
3566 gacont_hbr(2,num_conti,i)=fprimcont*yj
3567 gacont_hbr(3,num_conti,i)=fprimcont*zj
3570 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3571 c following the change of gradient-summation algorithm.
3573 cgrad ghalfp=0.5D0*gggp(k)
3574 cgrad ghalfm=0.5D0*gggm(k)
3575 gacontp_hb1(k,num_conti,i)=!ghalfp
3576 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3577 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3578 gacontp_hb2(k,num_conti,i)=!ghalfp
3579 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3580 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3581 gacontp_hb3(k,num_conti,i)=gggp(k)
3582 gacontm_hb1(k,num_conti,i)=!ghalfm
3583 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3584 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3585 gacontm_hb2(k,num_conti,i)=!ghalfm
3586 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3587 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3588 gacontm_hb3(k,num_conti,i)=gggm(k)
3590 C Diagnostics. Comment out or remove after debugging!
3592 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3593 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3594 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3595 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3596 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3597 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3600 endif ! num_conti.le.maxconts
3603 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3606 ghalf=0.5d0*agg(l,k)
3607 aggi(l,k)=aggi(l,k)+ghalf
3608 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3609 aggj(l,k)=aggj(l,k)+ghalf
3612 if (j.eq.nres-1 .and. i.lt.j-2) then
3615 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3620 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3623 C-----------------------------------------------------------------------------
3624 subroutine eturn3(i,eello_turn3)
3625 C Third- and fourth-order contributions from turns
3626 implicit real*8 (a-h,o-z)
3627 include 'DIMENSIONS'
3628 include 'COMMON.IOUNITS'
3629 include 'COMMON.GEO'
3630 include 'COMMON.VAR'
3631 include 'COMMON.LOCAL'
3632 include 'COMMON.CHAIN'
3633 include 'COMMON.DERIV'
3634 include 'COMMON.INTERACT'
3635 include 'COMMON.CONTACTS'
3636 include 'COMMON.TORSION'
3637 include 'COMMON.VECTORS'
3638 include 'COMMON.FFIELD'
3639 include 'COMMON.CONTROL'
3641 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3642 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3643 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3644 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3645 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3646 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3647 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3650 c write (iout,*) "eturn3",i,j,j1,j2
3655 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3657 C Third-order contributions
3664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3665 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3666 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3667 call transpose2(auxmat(1,1),auxmat1(1,1))
3668 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3669 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3670 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3671 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3672 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3673 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3674 cd & ' eello_turn3_num',4*eello_turn3_num
3675 C Derivatives in gamma(i)
3676 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3677 call transpose2(auxmat2(1,1),auxmat3(1,1))
3678 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3679 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3680 C Derivatives in gamma(i+1)
3681 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3682 call transpose2(auxmat2(1,1),auxmat3(1,1))
3683 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3684 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3685 & +0.5d0*(pizda(1,1)+pizda(2,2))
3686 C Cartesian derivatives
3688 c ghalf1=0.5d0*agg(l,1)
3689 c ghalf2=0.5d0*agg(l,2)
3690 c ghalf3=0.5d0*agg(l,3)
3691 c ghalf4=0.5d0*agg(l,4)
3692 a_temp(1,1)=aggi(l,1)!+ghalf1
3693 a_temp(1,2)=aggi(l,2)!+ghalf2
3694 a_temp(2,1)=aggi(l,3)!+ghalf3
3695 a_temp(2,2)=aggi(l,4)!+ghalf4
3696 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3697 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3698 & +0.5d0*(pizda(1,1)+pizda(2,2))
3699 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3700 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3701 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3702 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3703 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3704 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3705 & +0.5d0*(pizda(1,1)+pizda(2,2))
3706 a_temp(1,1)=aggj(l,1)!+ghalf1
3707 a_temp(1,2)=aggj(l,2)!+ghalf2
3708 a_temp(2,1)=aggj(l,3)!+ghalf3
3709 a_temp(2,2)=aggj(l,4)!+ghalf4
3710 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3711 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3712 & +0.5d0*(pizda(1,1)+pizda(2,2))
3713 a_temp(1,1)=aggj1(l,1)
3714 a_temp(1,2)=aggj1(l,2)
3715 a_temp(2,1)=aggj1(l,3)
3716 a_temp(2,2)=aggj1(l,4)
3717 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3718 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3719 & +0.5d0*(pizda(1,1)+pizda(2,2))
3723 C-------------------------------------------------------------------------------
3724 subroutine eturn4(i,eello_turn4)
3725 C Third- and fourth-order contributions from turns
3726 implicit real*8 (a-h,o-z)
3727 include 'DIMENSIONS'
3728 include 'COMMON.IOUNITS'
3729 include 'COMMON.GEO'
3730 include 'COMMON.VAR'
3731 include 'COMMON.LOCAL'
3732 include 'COMMON.CHAIN'
3733 include 'COMMON.DERIV'
3734 include 'COMMON.INTERACT'
3735 include 'COMMON.CONTACTS'
3736 include 'COMMON.TORSION'
3737 include 'COMMON.VECTORS'
3738 include 'COMMON.FFIELD'
3739 include 'COMMON.CONTROL'
3741 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3742 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3743 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2)
3744 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3745 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3746 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3747 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3750 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3752 C Fourth-order contributions
3760 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3761 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3762 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3767 iti1=itortyp(itype(i+1))
3768 iti2=itortyp(itype(i+2))
3769 iti3=itortyp(itype(i+3))
3770 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3771 call transpose2(EUg(1,1,i+1),e1t(1,1))
3772 call transpose2(Eug(1,1,i+2),e2t(1,1))
3773 call transpose2(Eug(1,1,i+3),e3t(1,1))
3774 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3775 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3776 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3779 s1=scalar2(b1(1,i+2),auxvec(1))
3780 c gs1=scalar2(gtb1(1,i+2),auxgvec(1))
3781 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3782 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3783 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3786 s2=scalar2(b1(1,i+1),auxvec(1))
3787 c gs2=scalar2(gtb1(1,i+1),auxgvec(1))
3788 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),ggb1(1,i+2),
3790 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3791 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3792 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3793 eello_turn4=eello_turn4-(s1+s2+s3)
3795 c geel_loc_ij=-(gs1+gs2)
3796 c gloc(nphi+i,icg)=gloc(nphi+i,icg)-
3798 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3801 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3802 & 'eturn4',i,j,-(s1+s2+s3)
3803 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3804 cd & ' eello_turn4_num',8*eello_turn4_num
3805 C Derivatives in gamma(i)
3806 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3807 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3808 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3809 s1=scalar2(b1(1,i+2),auxvec(1))
3810 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3811 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3812 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3813 C Derivatives in gamma(i+1)
3814 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3815 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3816 s2=scalar2(b1(1,i+1),auxvec(1))
3817 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3818 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3819 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3820 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3821 C Derivatives in gamma(i+2)
3822 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3823 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3824 s1=scalar2(b1(1,i+2),auxvec(1))
3825 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3826 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3827 s2=scalar2(b1(1,i+1),auxvec(1))
3828 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3829 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3830 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3831 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3832 C Cartesian derivatives
3833 C Derivatives of this turn contributions in DC(i+2)
3834 if (j.lt.nres-1) then
3836 a_temp(1,1)=agg(l,1)
3837 a_temp(1,2)=agg(l,2)
3838 a_temp(2,1)=agg(l,3)
3839 a_temp(2,2)=agg(l,4)
3840 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3841 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3842 s1=scalar2(b1(1,i+2),auxvec(1))
3843 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3844 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3845 s2=scalar2(b1(1,i+1),auxvec(1))
3846 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3847 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3848 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3850 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3853 C Remaining derivatives of this turn contribution
3855 a_temp(1,1)=aggi(l,1)
3856 a_temp(1,2)=aggi(l,2)
3857 a_temp(2,1)=aggi(l,3)
3858 a_temp(2,2)=aggi(l,4)
3859 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3860 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3861 s1=scalar2(b1(1,i+2),auxvec(1))
3862 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3863 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3864 s2=scalar2(b1(1,i+1),auxvec(1))
3865 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3866 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3867 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3868 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3869 a_temp(1,1)=aggi1(l,1)
3870 a_temp(1,2)=aggi1(l,2)
3871 a_temp(2,1)=aggi1(l,3)
3872 a_temp(2,2)=aggi1(l,4)
3873 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3874 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3875 s1=scalar2(b1(1,i+2),auxvec(1))
3876 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3877 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3878 s2=scalar2(b1(1,i+1),auxvec(1))
3879 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3880 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3881 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3882 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3883 a_temp(1,1)=aggj(l,1)
3884 a_temp(1,2)=aggj(l,2)
3885 a_temp(2,1)=aggj(l,3)
3886 a_temp(2,2)=aggj(l,4)
3887 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3888 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3889 s1=scalar2(b1(1,i+2),auxvec(1))
3890 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3891 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3892 s2=scalar2(b1(1,i+1),auxvec(1))
3893 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3894 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3895 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3896 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3897 a_temp(1,1)=aggj1(l,1)
3898 a_temp(1,2)=aggj1(l,2)
3899 a_temp(2,1)=aggj1(l,3)
3900 a_temp(2,2)=aggj1(l,4)
3901 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3902 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3903 s1=scalar2(b1(1,i+2),auxvec(1))
3904 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3905 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3906 s2=scalar2(b1(1,i+1),auxvec(1))
3907 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3908 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3909 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3910 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3911 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3915 C-----------------------------------------------------------------------------
3916 subroutine vecpr(u,v,w)
3917 implicit real*8(a-h,o-z)
3918 dimension u(3),v(3),w(3)
3919 w(1)=u(2)*v(3)-u(3)*v(2)
3920 w(2)=-u(1)*v(3)+u(3)*v(1)
3921 w(3)=u(1)*v(2)-u(2)*v(1)
3924 C-----------------------------------------------------------------------------
3925 subroutine unormderiv(u,ugrad,unorm,ungrad)
3926 C This subroutine computes the derivatives of a normalized vector u, given
3927 C the derivatives computed without normalization conditions, ugrad. Returns
3930 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3931 double precision vec(3)
3932 double precision scalar
3934 c write (2,*) 'ugrad',ugrad
3937 vec(i)=scalar(ugrad(1,i),u(1))
3939 c write (2,*) 'vec',vec
3942 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3945 c write (2,*) 'ungrad',ungrad
3948 C-----------------------------------------------------------------------------
3949 subroutine escp_soft_sphere(evdw2,evdw2_14)
3951 C This subroutine calculates the excluded-volume interaction energy between
3952 C peptide-group centers and side chains and its gradient in virtual-bond and
3953 C side-chain vectors.
3955 implicit real*8 (a-h,o-z)
3956 include 'DIMENSIONS'
3957 include 'COMMON.GEO'
3958 include 'COMMON.VAR'
3959 include 'COMMON.LOCAL'
3960 include 'COMMON.CHAIN'
3961 include 'COMMON.DERIV'
3962 include 'COMMON.INTERACT'
3963 include 'COMMON.FFIELD'
3964 include 'COMMON.IOUNITS'
3965 include 'COMMON.CONTROL'
3970 cd print '(a)','Enter ESCP'
3971 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3972 do i=iatscp_s,iatscp_e
3973 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3975 xi=0.5D0*(c(1,i)+c(1,i+1))
3976 yi=0.5D0*(c(2,i)+c(2,i+1))
3977 zi=0.5D0*(c(3,i)+c(3,i+1))
3979 do iint=1,nscp_gr(i)
3981 do j=iscpstart(i,iint),iscpend(i,iint)
3982 if (itype(j).eq.ntyp1) cycle
3983 itypj=iabs(itype(j))
3984 C Uncomment following three lines for SC-p interactions
3988 C Uncomment following three lines for Ca-p interactions
3992 rij=xj*xj+yj*yj+zj*zj
3995 if (rij.lt.r0ijsq) then
3996 evdwij=0.25d0*(rij-r0ijsq)**2
4004 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4009 cgrad if (j.lt.i) then
4010 cd write (iout,*) 'j<i'
4011 C Uncomment following three lines for SC-p interactions
4013 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4016 cd write (iout,*) 'j>i'
4018 cgrad ggg(k)=-ggg(k)
4019 C Uncomment following line for SC-p interactions
4020 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4024 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4026 cgrad kstart=min0(i+1,j)
4027 cgrad kend=max0(i-1,j-1)
4028 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4029 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4030 cgrad do k=kstart,kend
4032 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4036 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4037 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4045 C-----------------------------------------------------------------------------
4046 subroutine escp(evdw2,evdw2_14)
4048 C This subroutine calculates the excluded-volume interaction energy between
4049 C peptide-group centers and side chains and its gradient in virtual-bond and
4050 C side-chain vectors.
4052 implicit real*8 (a-h,o-z)
4053 include 'DIMENSIONS'
4054 include 'COMMON.GEO'
4055 include 'COMMON.VAR'
4056 include 'COMMON.LOCAL'
4057 include 'COMMON.CHAIN'
4058 include 'COMMON.DERIV'
4059 include 'COMMON.INTERACT'
4060 include 'COMMON.FFIELD'
4061 include 'COMMON.IOUNITS'
4062 include 'COMMON.CONTROL'
4066 cd print '(a)','Enter ESCP'
4067 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4068 do i=iatscp_s,iatscp_e
4069 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4071 xi=0.5D0*(c(1,i)+c(1,i+1))
4072 yi=0.5D0*(c(2,i)+c(2,i+1))
4073 zi=0.5D0*(c(3,i)+c(3,i+1))
4075 do iint=1,nscp_gr(i)
4077 do j=iscpstart(i,iint),iscpend(i,iint)
4078 itypj=iabs(itype(j))
4079 if (itypj.eq.ntyp1) cycle
4080 C Uncomment following three lines for SC-p interactions
4084 C Uncomment following three lines for Ca-p interactions
4088 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4090 e1=fac*fac*aad(itypj,iteli)
4091 e2=fac*bad(itypj,iteli)
4092 if (iabs(j-i) .le. 2) then
4095 evdw2_14=evdw2_14+e1+e2
4099 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4100 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4103 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4105 fac=-(evdwij+e1)*rrij
4109 cgrad if (j.lt.i) then
4110 cd write (iout,*) 'j<i'
4111 C Uncomment following three lines for SC-p interactions
4113 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4116 cd write (iout,*) 'j>i'
4118 cgrad ggg(k)=-ggg(k)
4119 C Uncomment following line for SC-p interactions
4120 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4121 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4125 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4127 cgrad kstart=min0(i+1,j)
4128 cgrad kend=max0(i-1,j-1)
4129 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4130 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4131 cgrad do k=kstart,kend
4133 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4137 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4138 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4146 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4147 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4148 gradx_scp(j,i)=expon*gradx_scp(j,i)
4151 C******************************************************************************
4155 C To save time the factor EXPON has been extracted from ALL components
4156 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4159 C******************************************************************************
4162 C--------------------------------------------------------------------------
4163 subroutine edis(ehpb)
4165 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4167 implicit real*8 (a-h,o-z)
4168 include 'DIMENSIONS'
4169 include 'COMMON.SBRIDGE'
4170 include 'COMMON.CHAIN'
4171 include 'COMMON.DERIV'
4172 include 'COMMON.VAR'
4173 include 'COMMON.INTERACT'
4174 include 'COMMON.IOUNITS'
4177 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4178 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4179 if (link_end.eq.0) return
4180 do i=link_start,link_end
4181 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4182 C CA-CA distance used in regularization of structure.
4185 C iii and jjj point to the residues for which the distance is assigned.
4186 if (ii.gt.nres) then
4193 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4194 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4195 C distance and angle dependent SS bond potential.
4196 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4197 & iabs(itype(jjj)).eq.1) then
4198 call ssbond_ene(iii,jjj,eij)
4200 cd write (iout,*) "eij",eij
4202 C Calculate the distance between the two points and its difference from the
4206 C Get the force constant corresponding to this distance.
4208 C Calculate the contribution to energy.
4209 ehpb=ehpb+waga*rdis*rdis
4211 C Evaluate gradient.
4214 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4215 cd & ' waga=',waga,' fac=',fac
4217 ggg(j)=fac*(c(j,jj)-c(j,ii))
4219 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4220 C If this is a SC-SC distance, we need to calculate the contributions to the
4221 C Cartesian gradient in the SC vectors (ghpbx).
4224 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4225 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4228 cgrad do j=iii,jjj-1
4230 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4234 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4235 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4242 C--------------------------------------------------------------------------
4243 subroutine ssbond_ene(i,j,eij)
4245 C Calculate the distance and angle dependent SS-bond potential energy
4246 C using a free-energy function derived based on RHF/6-31G** ab initio
4247 C calculations of diethyl disulfide.
4249 C A. Liwo and U. Kozlowska, 11/24/03
4251 implicit real*8 (a-h,o-z)
4252 include 'DIMENSIONS'
4253 include 'COMMON.SBRIDGE'
4254 include 'COMMON.CHAIN'
4255 include 'COMMON.DERIV'
4256 include 'COMMON.LOCAL'
4257 include 'COMMON.INTERACT'
4258 include 'COMMON.VAR'
4259 include 'COMMON.IOUNITS'
4260 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4261 itypi=iabs(itype(i))
4265 dxi=dc_norm(1,nres+i)
4266 dyi=dc_norm(2,nres+i)
4267 dzi=dc_norm(3,nres+i)
4268 c dsci_inv=dsc_inv(itypi)
4269 dsci_inv=vbld_inv(nres+i)
4270 itypj=iabs(itype(j))
4271 c dscj_inv=dsc_inv(itypj)
4272 dscj_inv=vbld_inv(nres+j)
4276 dxj=dc_norm(1,nres+j)
4277 dyj=dc_norm(2,nres+j)
4278 dzj=dc_norm(3,nres+j)
4279 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4284 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4285 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4286 om12=dxi*dxj+dyi*dyj+dzi*dzj
4288 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4289 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4295 deltat12=om2-om1+2.0d0
4297 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4298 & +akct*deltad*deltat12
4299 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4300 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4301 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4302 c & " deltat12",deltat12," eij",eij
4303 ed=2*akcm*deltad+akct*deltat12
4305 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4306 eom1=-2*akth*deltat1-pom1-om2*pom2
4307 eom2= 2*akth*deltat2+pom1-om1*pom2
4310 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4311 ghpbx(k,i)=ghpbx(k,i)-ggk
4312 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4313 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4314 ghpbx(k,j)=ghpbx(k,j)+ggk
4315 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4316 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4317 ghpbc(k,i)=ghpbc(k,i)-ggk
4318 ghpbc(k,j)=ghpbc(k,j)+ggk
4321 C Calculate the components of the gradient in DC and X
4325 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4330 C--------------------------------------------------------------------------
4331 subroutine ebond(estr)
4333 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4335 implicit real*8 (a-h,o-z)
4336 include 'DIMENSIONS'
4337 include 'COMMON.LOCAL'
4338 include 'COMMON.GEO'
4339 include 'COMMON.INTERACT'
4340 include 'COMMON.DERIV'
4341 include 'COMMON.VAR'
4342 include 'COMMON.CHAIN'
4343 include 'COMMON.IOUNITS'
4344 include 'COMMON.NAMES'
4345 include 'COMMON.FFIELD'
4346 include 'COMMON.CONTROL'
4347 include 'COMMON.SETUP'
4348 double precision u(3),ud(3)
4351 do i=ibondp_start,ibondp_end
4352 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4353 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4355 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4356 & *dc(j,i-1)/vbld(i)
4358 if (energy_dec) write(iout,*)
4359 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4361 diff = vbld(i)-vbldp0
4362 if (energy_dec) write (iout,*)
4363 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4366 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4368 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4371 estr=0.5d0*AKP*estr+estr1
4373 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4375 do i=ibond_start,ibond_end
4377 if (iti.ne.10 .and. iti.ne.ntyp1) then
4380 diff=vbld(i+nres)-vbldsc0(1,iti)
4381 if (energy_dec) write (iout,*)
4382 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4383 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4384 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4386 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4390 diff=vbld(i+nres)-vbldsc0(j,iti)
4391 ud(j)=aksc(j,iti)*diff
4392 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4406 uprod2=uprod2*u(k)*u(k)
4410 usumsqder=usumsqder+ud(j)*uprod2
4412 estr=estr+uprod/usum
4414 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4422 C--------------------------------------------------------------------------
4423 subroutine ebend(etheta)
4425 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4426 C angles gamma and its derivatives in consecutive thetas and gammas.
4428 implicit real*8 (a-h,o-z)
4429 include 'DIMENSIONS'
4430 include 'COMMON.LOCAL'
4431 include 'COMMON.GEO'
4432 include 'COMMON.INTERACT'
4433 include 'COMMON.DERIV'
4434 include 'COMMON.VAR'
4435 include 'COMMON.CHAIN'
4436 include 'COMMON.IOUNITS'
4437 include 'COMMON.NAMES'
4438 include 'COMMON.FFIELD'
4439 include 'COMMON.CONTROL'
4440 common /calcthet/ term1,term2,termm,diffak,ratak,
4441 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4442 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4443 double precision y(2),z(2)
4445 c time11=dexp(-2*time)
4448 c write (*,'(a,i2)') 'EBEND ICG=',icg
4449 do i=ithet_start,ithet_end
4450 if (itype(i-1).eq.ntyp1) cycle
4451 C Zero the energy function and its derivative at 0 or pi.
4452 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4454 ichir1=isign(1,itype(i-2))
4455 ichir2=isign(1,itype(i))
4456 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4457 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4458 if (itype(i-1).eq.10) then
4459 itype1=isign(10,itype(i-2))
4460 ichir11=isign(1,itype(i-2))
4461 ichir12=isign(1,itype(i-2))
4462 itype2=isign(10,itype(i))
4463 ichir21=isign(1,itype(i))
4464 ichir22=isign(1,itype(i))
4467 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4470 if (phii.ne.phii) phii=150.0
4480 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4483 if (phii1.ne.phii1) phii1=150.0
4495 C Calculate the "mean" value of theta from the part of the distribution
4496 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4497 C In following comments this theta will be referred to as t_c.
4498 thet_pred_mean=0.0d0
4500 athetk=athet(k,it,ichir1,ichir2)
4501 bthetk=bthet(k,it,ichir1,ichir2)
4503 athetk=athet(k,itype1,ichir11,ichir12)
4504 bthetk=bthet(k,itype2,ichir21,ichir22)
4506 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4508 dthett=thet_pred_mean*ssd
4509 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4510 C Derivatives of the "mean" values in gamma1 and gamma2.
4511 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4512 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4513 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4514 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4516 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4517 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4518 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4519 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4521 if (theta(i).gt.pi-delta) then
4522 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4524 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4525 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4526 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4528 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4530 else if (theta(i).lt.delta) then
4531 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4532 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4533 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4535 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4536 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4539 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4542 etheta=etheta+ethetai
4543 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4545 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4546 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4547 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4549 C Ufff.... We've done all this!!!
4552 C---------------------------------------------------------------------------
4553 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4555 implicit real*8 (a-h,o-z)
4556 include 'DIMENSIONS'
4557 include 'COMMON.LOCAL'
4558 include 'COMMON.IOUNITS'
4559 common /calcthet/ term1,term2,termm,diffak,ratak,
4560 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4561 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4562 C Calculate the contributions to both Gaussian lobes.
4563 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4564 C The "polynomial part" of the "standard deviation" of this part of
4568 sig=sig*thet_pred_mean+polthet(j,it)
4570 C Derivative of the "interior part" of the "standard deviation of the"
4571 C gamma-dependent Gaussian lobe in t_c.
4572 sigtc=3*polthet(3,it)
4574 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4577 C Set the parameters of both Gaussian lobes of the distribution.
4578 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4579 fac=sig*sig+sigc0(it)
4582 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4583 sigsqtc=-4.0D0*sigcsq*sigtc
4584 c print *,i,sig,sigtc,sigsqtc
4585 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4586 sigtc=-sigtc/(fac*fac)
4587 C Following variable is sigma(t_c)**(-2)
4588 sigcsq=sigcsq*sigcsq
4590 sig0inv=1.0D0/sig0i**2
4591 delthec=thetai-thet_pred_mean
4592 delthe0=thetai-theta0i
4593 term1=-0.5D0*sigcsq*delthec*delthec
4594 term2=-0.5D0*sig0inv*delthe0*delthe0
4595 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4596 C NaNs in taking the logarithm. We extract the largest exponent which is added
4597 C to the energy (this being the log of the distribution) at the end of energy
4598 C term evaluation for this virtual-bond angle.
4599 if (term1.gt.term2) then
4601 term2=dexp(term2-termm)
4605 term1=dexp(term1-termm)
4608 C The ratio between the gamma-independent and gamma-dependent lobes of
4609 C the distribution is a Gaussian function of thet_pred_mean too.
4610 diffak=gthet(2,it)-thet_pred_mean
4611 ratak=diffak/gthet(3,it)**2
4612 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4613 C Let's differentiate it in thet_pred_mean NOW.
4615 C Now put together the distribution terms to make complete distribution.
4616 termexp=term1+ak*term2
4617 termpre=sigc+ak*sig0i
4618 C Contribution of the bending energy from this theta is just the -log of
4619 C the sum of the contributions from the two lobes and the pre-exponential
4620 C factor. Simple enough, isn't it?
4621 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4622 C NOW the derivatives!!!
4623 C 6/6/97 Take into account the deformation.
4624 E_theta=(delthec*sigcsq*term1
4625 & +ak*delthe0*sig0inv*term2)/termexp
4626 E_tc=((sigtc+aktc*sig0i)/termpre
4627 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4628 & aktc*term2)/termexp)
4631 c-----------------------------------------------------------------------------
4632 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
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 delthec=thetai-thet_pred_mean
4641 delthe0=thetai-theta0i
4642 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4643 t3 = thetai-thet_pred_mean
4647 t14 = t12+t6*sigsqtc
4649 t21 = thetai-theta0i
4655 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4656 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4657 & *(-t12*t9-ak*sig0inv*t27)
4661 C--------------------------------------------------------------------------
4662 subroutine ebend(etheta)
4664 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4665 C angles gamma and its derivatives in consecutive thetas and gammas.
4666 C ab initio-derived potentials from
4667 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4669 implicit real*8 (a-h,o-z)
4670 include 'DIMENSIONS'
4671 include 'COMMON.LOCAL'
4672 include 'COMMON.GEO'
4673 include 'COMMON.INTERACT'
4674 include 'COMMON.DERIV'
4675 include 'COMMON.VAR'
4676 include 'COMMON.CHAIN'
4677 include 'COMMON.IOUNITS'
4678 include 'COMMON.NAMES'
4679 include 'COMMON.FFIELD'
4680 include 'COMMON.CONTROL'
4681 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4682 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4683 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4684 & sinph1ph2(maxdouble,maxdouble)
4685 logical lprn /.false./, lprn1 /.false./
4687 do i=ithet_start,ithet_end
4688 if (itype(i-1).eq.ntyp1) cycle
4689 if (iabs(itype(i+1)).eq.20) iblock=2
4690 if (iabs(itype(i+1)).ne.20) iblock=1
4694 theti2=0.5d0*theta(i)
4695 ityp2=ithetyp((itype(i-1)))
4697 coskt(k)=dcos(k*theti2)
4698 sinkt(k)=dsin(k*theti2)
4700 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4703 if (phii.ne.phii) phii=150.0
4707 ityp1=ithetyp((itype(i-2)))
4708 C propagation of chirality for glycine type
4710 cosph1(k)=dcos(k*phii)
4711 sinph1(k)=dsin(k*phii)
4721 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4724 if (phii1.ne.phii1) phii1=150.0
4729 ityp3=ithetyp((itype(i)))
4731 cosph2(k)=dcos(k*phii1)
4732 sinph2(k)=dsin(k*phii1)
4742 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4745 ccl=cosph1(l)*cosph2(k-l)
4746 ssl=sinph1(l)*sinph2(k-l)
4747 scl=sinph1(l)*cosph2(k-l)
4748 csl=cosph1(l)*sinph2(k-l)
4749 cosph1ph2(l,k)=ccl-ssl
4750 cosph1ph2(k,l)=ccl+ssl
4751 sinph1ph2(l,k)=scl+csl
4752 sinph1ph2(k,l)=scl-csl
4756 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4757 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4758 write (iout,*) "coskt and sinkt"
4760 write (iout,*) k,coskt(k),sinkt(k)
4764 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4765 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4768 & write (iout,*) "k",k,"
4769 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4770 & " ethetai",ethetai
4773 write (iout,*) "cosph and sinph"
4775 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4777 write (iout,*) "cosph1ph2 and sinph2ph2"
4780 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4781 & sinph1ph2(l,k),sinph1ph2(k,l)
4784 write(iout,*) "ethetai",ethetai
4788 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4789 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4790 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4791 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4792 ethetai=ethetai+sinkt(m)*aux
4793 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4794 dephii=dephii+k*sinkt(m)*(
4795 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4796 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4797 dephii1=dephii1+k*sinkt(m)*(
4798 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4799 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4801 & write (iout,*) "m",m," k",k," bbthet",
4802 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4803 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4804 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4805 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4809 & write(iout,*) "ethetai",ethetai
4813 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4814 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4815 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4816 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4817 ethetai=ethetai+sinkt(m)*aux
4818 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4819 dephii=dephii+l*sinkt(m)*(
4820 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4821 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4822 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4823 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4824 dephii1=dephii1+(k-l)*sinkt(m)*(
4825 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4826 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4827 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4828 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4830 write (iout,*) "m",m," k",k," l",l," ffthet",
4831 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4832 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4833 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4834 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4835 & " ethetai",ethetai
4836 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4837 & cosph1ph2(k,l)*sinkt(m),
4838 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4846 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4847 & i,theta(i)*rad2deg,phii*rad2deg,
4848 & phii1*rad2deg,ethetai
4850 etheta=etheta+ethetai
4851 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4852 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4853 gloc(nphi+i-2,icg)=wang*dethetai
4859 c-----------------------------------------------------------------------------
4860 subroutine esc(escloc)
4861 C Calculate the local energy of a side chain and its derivatives in the
4862 C corresponding virtual-bond valence angles THETA and the spherical angles
4864 implicit real*8 (a-h,o-z)
4865 include 'DIMENSIONS'
4866 include 'COMMON.GEO'
4867 include 'COMMON.LOCAL'
4868 include 'COMMON.VAR'
4869 include 'COMMON.INTERACT'
4870 include 'COMMON.DERIV'
4871 include 'COMMON.CHAIN'
4872 include 'COMMON.IOUNITS'
4873 include 'COMMON.NAMES'
4874 include 'COMMON.FFIELD'
4875 include 'COMMON.CONTROL'
4876 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4877 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4878 common /sccalc/ time11,time12,time112,theti,it,nlobit
4881 c write (iout,'(a)') 'ESC'
4882 do i=loc_start,loc_end
4884 if (it.eq.ntyp1) cycle
4885 if (it.eq.10) goto 1
4886 nlobit=nlob(iabs(it))
4887 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4888 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4889 theti=theta(i+1)-pipol
4894 if (x(2).gt.pi-delta) then
4898 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4900 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4901 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4903 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4904 & ddersc0(1),dersc(1))
4905 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4906 & ddersc0(3),dersc(3))
4908 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4910 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4911 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4912 & dersc0(2),esclocbi,dersc02)
4913 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4915 call splinthet(x(2),0.5d0*delta,ss,ssd)
4920 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4922 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4923 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4925 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4927 c write (iout,*) escloci
4928 else if (x(2).lt.delta) then
4932 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4934 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4935 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4937 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4938 & ddersc0(1),dersc(1))
4939 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4940 & ddersc0(3),dersc(3))
4942 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4944 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4945 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4946 & dersc0(2),esclocbi,dersc02)
4947 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4952 call splinthet(x(2),0.5d0*delta,ss,ssd)
4954 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4956 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4957 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4959 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4960 c write (iout,*) escloci
4962 call enesc(x,escloci,dersc,ddummy,.false.)
4965 escloc=escloc+escloci
4966 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4967 & 'escloc',i,escloci
4968 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4970 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4972 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4973 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4978 C---------------------------------------------------------------------------
4979 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4980 implicit real*8 (a-h,o-z)
4981 include 'DIMENSIONS'
4982 include 'COMMON.GEO'
4983 include 'COMMON.LOCAL'
4984 include 'COMMON.IOUNITS'
4985 common /sccalc/ time11,time12,time112,theti,it,nlobit
4986 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4987 double precision contr(maxlob,-1:1)
4989 c write (iout,*) 'it=',it,' nlobit=',nlobit
4993 if (mixed) ddersc(j)=0.0d0
4997 C Because of periodicity of the dependence of the SC energy in omega we have
4998 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4999 C To avoid underflows, first compute & store the exponents.
5007 z(k)=x(k)-censc(k,j,it)
5012 Axk=Axk+gaussc(l,k,j,it)*z(l)
5018 expfac=expfac+Ax(k,j,iii)*z(k)
5026 C As in the case of ebend, we want to avoid underflows in exponentiation and
5027 C subsequent NaNs and INFs in energy calculation.
5028 C Find the largest exponent
5032 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5036 cd print *,'it=',it,' emin=',emin
5038 C Compute the contribution to SC energy and derivatives
5043 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5044 if(adexp.ne.adexp) adexp=1.0
5047 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5049 cd print *,'j=',j,' expfac=',expfac
5050 escloc_i=escloc_i+expfac
5052 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5056 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5057 & +gaussc(k,2,j,it))*expfac
5064 dersc(1)=dersc(1)/cos(theti)**2
5065 ddersc(1)=ddersc(1)/cos(theti)**2
5068 escloci=-(dlog(escloc_i)-emin)
5070 dersc(j)=dersc(j)/escloc_i
5074 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5079 C------------------------------------------------------------------------------
5080 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5081 implicit real*8 (a-h,o-z)
5082 include 'DIMENSIONS'
5083 include 'COMMON.GEO'
5084 include 'COMMON.LOCAL'
5085 include 'COMMON.IOUNITS'
5086 common /sccalc/ time11,time12,time112,theti,it,nlobit
5087 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5088 double precision contr(maxlob)
5099 z(k)=x(k)-censc(k,j,it)
5105 Axk=Axk+gaussc(l,k,j,it)*z(l)
5111 expfac=expfac+Ax(k,j)*z(k)
5116 C As in the case of ebend, we want to avoid underflows in exponentiation and
5117 C subsequent NaNs and INFs in energy calculation.
5118 C Find the largest exponent
5121 if (emin.gt.contr(j)) emin=contr(j)
5125 C Compute the contribution to SC energy and derivatives
5129 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5130 escloc_i=escloc_i+expfac
5132 dersc(k)=dersc(k)+Ax(k,j)*expfac
5134 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5135 & +gaussc(1,2,j,it))*expfac
5139 dersc(1)=dersc(1)/cos(theti)**2
5140 dersc12=dersc12/cos(theti)**2
5141 escloci=-(dlog(escloc_i)-emin)
5143 dersc(j)=dersc(j)/escloc_i
5145 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5149 c----------------------------------------------------------------------------------
5150 subroutine esc(escloc)
5151 C Calculate the local energy of a side chain and its derivatives in the
5152 C corresponding virtual-bond valence angles THETA and the spherical angles
5153 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5154 C added by Urszula Kozlowska. 07/11/2007
5156 implicit real*8 (a-h,o-z)
5157 include 'DIMENSIONS'
5158 include 'COMMON.GEO'
5159 include 'COMMON.LOCAL'
5160 include 'COMMON.VAR'
5161 include 'COMMON.SCROT'
5162 include 'COMMON.INTERACT'
5163 include 'COMMON.DERIV'
5164 include 'COMMON.CHAIN'
5165 include 'COMMON.IOUNITS'
5166 include 'COMMON.NAMES'
5167 include 'COMMON.FFIELD'
5168 include 'COMMON.CONTROL'
5169 include 'COMMON.VECTORS'
5170 double precision x_prime(3),y_prime(3),z_prime(3)
5171 & , sumene,dsc_i,dp2_i,x(65),
5172 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5173 & de_dxx,de_dyy,de_dzz,de_dt
5174 double precision s1_t,s1_6_t,s2_t,s2_6_t
5176 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5177 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5178 & dt_dCi(3),dt_dCi1(3)
5179 common /sccalc/ time11,time12,time112,theti,it,nlobit
5182 do i=loc_start,loc_end
5183 if (itype(i).eq.ntyp1) cycle
5184 costtab(i+1) =dcos(theta(i+1))
5185 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5186 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5187 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5188 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5189 cosfac=dsqrt(cosfac2)
5190 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5191 sinfac=dsqrt(sinfac2)
5193 if (it.eq.10) goto 1
5195 C Compute the axes of tghe local cartesian coordinates system; store in
5196 c x_prime, y_prime and z_prime
5203 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5204 C & dc_norm(3,i+nres)
5206 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5207 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5210 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5213 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5214 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5215 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5216 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5217 c & " xy",scalar(x_prime(1),y_prime(1)),
5218 c & " xz",scalar(x_prime(1),z_prime(1)),
5219 c & " yy",scalar(y_prime(1),y_prime(1)),
5220 c & " yz",scalar(y_prime(1),z_prime(1)),
5221 c & " zz",scalar(z_prime(1),z_prime(1))
5223 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5224 C to local coordinate system. Store in xx, yy, zz.
5230 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5231 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5232 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5239 C Compute the energy of the ith side cbain
5241 c write (2,*) "xx",xx," yy",yy," zz",zz
5244 x(j) = sc_parmin(j,it)
5247 Cc diagnostics - remove later
5249 yy1 = dsin(alph(2))*dcos(omeg(2))
5250 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5251 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5252 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5254 C," --- ", xx_w,yy_w,zz_w
5257 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5258 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5260 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5261 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5263 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5264 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5265 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5266 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5267 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5269 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5270 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5271 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5272 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5273 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5275 dsc_i = 0.743d0+x(61)
5277 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5278 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5279 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5280 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5281 s1=(1+x(63))/(0.1d0 + dscp1)
5282 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5283 s2=(1+x(65))/(0.1d0 + dscp2)
5284 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5285 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5286 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5287 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5289 c & dscp1,dscp2,sumene
5290 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5291 escloc = escloc + sumene
5292 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5297 C This section to check the numerical derivatives of the energy of ith side
5298 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5299 C #define DEBUG in the code to turn it on.
5301 write (2,*) "sumene =",sumene
5305 write (2,*) xx,yy,zz
5306 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5307 de_dxx_num=(sumenep-sumene)/aincr
5309 write (2,*) "xx+ sumene from enesc=",sumenep
5312 write (2,*) xx,yy,zz
5313 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5314 de_dyy_num=(sumenep-sumene)/aincr
5316 write (2,*) "yy+ sumene from enesc=",sumenep
5319 write (2,*) xx,yy,zz
5320 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5321 de_dzz_num=(sumenep-sumene)/aincr
5323 write (2,*) "zz+ sumene from enesc=",sumenep
5324 costsave=cost2tab(i+1)
5325 sintsave=sint2tab(i+1)
5326 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5327 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5328 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5329 de_dt_num=(sumenep-sumene)/aincr
5330 write (2,*) " t+ sumene from enesc=",sumenep
5331 cost2tab(i+1)=costsave
5332 sint2tab(i+1)=sintsave
5333 C End of diagnostics section.
5336 C Compute the gradient of esc
5338 c zz=zz*dsign(1.0,dfloat(itype(i)))
5339 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5340 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5341 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5342 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5343 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5344 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5345 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5346 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5347 pom1=(sumene3*sint2tab(i+1)+sumene1)
5348 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5349 pom2=(sumene4*cost2tab(i+1)+sumene2)
5350 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5351 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5352 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5353 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5355 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5356 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5357 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5359 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5360 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5361 & +(pom1+pom2)*pom_dx
5363 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5366 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5367 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5368 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5370 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5371 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5372 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5373 & +x(59)*zz**2 +x(60)*xx*zz
5374 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5375 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5376 & +(pom1-pom2)*pom_dy
5378 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5381 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5382 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5383 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5384 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5385 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5386 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5387 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5388 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5390 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5393 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5394 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5395 & +pom1*pom_dt1+pom2*pom_dt2
5397 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5402 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5403 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5404 cosfac2xx=cosfac2*xx
5405 sinfac2yy=sinfac2*yy
5407 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5409 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5411 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5412 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5413 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5414 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5415 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5416 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5417 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5418 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5419 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5420 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5424 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5425 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5426 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5427 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5430 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5431 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5432 dZZ_XYZ(k)=vbld_inv(i+nres)*
5433 & (z_prime(k)-zz*dC_norm(k,i+nres))
5435 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5436 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5440 dXX_Ctab(k,i)=dXX_Ci(k)
5441 dXX_C1tab(k,i)=dXX_Ci1(k)
5442 dYY_Ctab(k,i)=dYY_Ci(k)
5443 dYY_C1tab(k,i)=dYY_Ci1(k)
5444 dZZ_Ctab(k,i)=dZZ_Ci(k)
5445 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5446 dXX_XYZtab(k,i)=dXX_XYZ(k)
5447 dYY_XYZtab(k,i)=dYY_XYZ(k)
5448 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5452 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5453 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5454 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5455 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5456 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5458 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5459 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5460 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5461 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5462 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5463 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5464 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5465 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5467 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5468 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5470 C to check gradient call subroutine check_grad
5476 c------------------------------------------------------------------------------
5477 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5479 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5480 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5481 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5482 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5484 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5485 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5487 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5488 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5489 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5490 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5491 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5493 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5494 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5495 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5496 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5497 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5499 dsc_i = 0.743d0+x(61)
5501 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5502 & *(xx*cost2+yy*sint2))
5503 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5504 & *(xx*cost2-yy*sint2))
5505 s1=(1+x(63))/(0.1d0 + dscp1)
5506 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5507 s2=(1+x(65))/(0.1d0 + dscp2)
5508 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5509 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5510 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5515 c------------------------------------------------------------------------------
5516 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5518 C This procedure calculates two-body contact function g(rij) and its derivative:
5521 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5524 C where x=(rij-r0ij)/delta
5526 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5529 double precision rij,r0ij,eps0ij,fcont,fprimcont
5530 double precision x,x2,x4,delta
5534 if (x.lt.-1.0D0) then
5537 else if (x.le.1.0D0) then
5540 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5541 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5548 c------------------------------------------------------------------------------
5549 subroutine splinthet(theti,delta,ss,ssder)
5550 implicit real*8 (a-h,o-z)
5551 include 'DIMENSIONS'
5552 include 'COMMON.VAR'
5553 include 'COMMON.GEO'
5556 if (theti.gt.pipol) then
5557 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5559 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5564 c------------------------------------------------------------------------------
5565 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5567 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5568 double precision ksi,ksi2,ksi3,a1,a2,a3
5569 a1=fprim0*delta/(f1-f0)
5575 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5576 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5579 c------------------------------------------------------------------------------
5580 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5582 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5583 double precision ksi,ksi2,ksi3,a1,a2,a3
5588 a2=3*(f1x-f0x)-2*fprim0x*delta
5589 a3=fprim0x*delta-2*(f1x-f0x)
5590 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5593 C-----------------------------------------------------------------------------
5595 C-----------------------------------------------------------------------------
5596 subroutine etor(etors,edihcnstr)
5597 implicit real*8 (a-h,o-z)
5598 include 'DIMENSIONS'
5599 include 'COMMON.VAR'
5600 include 'COMMON.GEO'
5601 include 'COMMON.LOCAL'
5602 include 'COMMON.TORSION'
5603 include 'COMMON.INTERACT'
5604 include 'COMMON.DERIV'
5605 include 'COMMON.CHAIN'
5606 include 'COMMON.NAMES'
5607 include 'COMMON.IOUNITS'
5608 include 'COMMON.FFIELD'
5609 include 'COMMON.TORCNSTR'
5610 include 'COMMON.CONTROL'
5612 C Set lprn=.true. for debugging
5616 do i=iphi_start,iphi_end
5618 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5619 & .or. itype(i).eq.ntyp1) cycle
5620 itori=itortyp(itype(i-2))
5621 itori1=itortyp(itype(i-1))
5624 C Proline-Proline pair is a special case...
5625 if (itori.eq.3 .and. itori1.eq.3) then
5626 if (phii.gt.-dwapi3) then
5628 fac=1.0D0/(1.0D0-cosphi)
5629 etorsi=v1(1,3,3)*fac
5630 etorsi=etorsi+etorsi
5631 etors=etors+etorsi-v1(1,3,3)
5632 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5633 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5636 v1ij=v1(j+1,itori,itori1)
5637 v2ij=v2(j+1,itori,itori1)
5640 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5641 if (energy_dec) etors_ii=etors_ii+
5642 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5643 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5647 v1ij=v1(j,itori,itori1)
5648 v2ij=v2(j,itori,itori1)
5651 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5652 if (energy_dec) etors_ii=etors_ii+
5653 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5654 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5657 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5660 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5661 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5662 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5663 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5664 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5666 ! 6/20/98 - dihedral angle constraints
5669 itori=idih_constr(i)
5672 if (difi.gt.drange(i)) then
5674 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5675 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5676 else if (difi.lt.-drange(i)) then
5678 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5679 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5681 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5682 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5684 ! write (iout,*) 'edihcnstr',edihcnstr
5687 c------------------------------------------------------------------------------
5688 subroutine etor_d(etors_d)
5692 c----------------------------------------------------------------------------
5694 subroutine etor(etors,edihcnstr)
5695 implicit real*8 (a-h,o-z)
5696 include 'DIMENSIONS'
5697 include 'COMMON.VAR'
5698 include 'COMMON.GEO'
5699 include 'COMMON.LOCAL'
5700 include 'COMMON.TORSION'
5701 include 'COMMON.INTERACT'
5702 include 'COMMON.DERIV'
5703 include 'COMMON.CHAIN'
5704 include 'COMMON.NAMES'
5705 include 'COMMON.IOUNITS'
5706 include 'COMMON.FFIELD'
5707 include 'COMMON.TORCNSTR'
5708 include 'COMMON.CONTROL'
5710 C Set lprn=.true. for debugging
5714 do i=iphi_start,iphi_end
5715 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5716 & .or. itype(i).eq.ntyp1) cycle
5718 if (iabs(itype(i)).eq.20) then
5723 itori=itortyp(itype(i-2))
5724 itori1=itortyp(itype(i-1))
5727 C Regular cosine and sine terms
5728 do j=1,nterm(itori,itori1,iblock)
5729 v1ij=v1(j,itori,itori1,iblock)
5730 v2ij=v2(j,itori,itori1,iblock)
5733 etors=etors+v1ij*cosphi+v2ij*sinphi
5734 if (energy_dec) etors_ii=etors_ii+
5735 & v1ij*cosphi+v2ij*sinphi
5736 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5740 C E = SUM ----------------------------------- - v1
5741 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5743 cosphi=dcos(0.5d0*phii)
5744 sinphi=dsin(0.5d0*phii)
5745 do j=1,nlor(itori,itori1,iblock)
5746 vl1ij=vlor1(j,itori,itori1)
5747 vl2ij=vlor2(j,itori,itori1)
5748 vl3ij=vlor3(j,itori,itori1)
5749 pom=vl2ij*cosphi+vl3ij*sinphi
5750 pom1=1.0d0/(pom*pom+1.0d0)
5751 etors=etors+vl1ij*pom1
5752 if (energy_dec) etors_ii=etors_ii+
5755 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5757 C Subtract the constant term
5758 etors=etors-v0(itori,itori1,iblock)
5759 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5760 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5762 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5763 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5764 & (v1(j,itori,itori1,iblock),j=1,6),
5765 & (v2(j,itori,itori1,iblock),j=1,6)
5766 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5767 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5769 ! 6/20/98 - dihedral angle constraints
5771 c do i=1,ndih_constr
5772 do i=idihconstr_start,idihconstr_end
5773 itori=idih_constr(i)
5775 difi=pinorm(phii-phi0(i))
5776 if (difi.gt.drange(i)) then
5778 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5779 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5780 else if (difi.lt.-drange(i)) then
5782 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5783 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5787 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5788 cd & rad2deg*phi0(i), rad2deg*drange(i),
5789 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5791 cd write (iout,*) 'edihcnstr',edihcnstr
5794 c----------------------------------------------------------------------------
5795 subroutine etor_d(etors_d)
5796 C 6/23/01 Compute double torsional energy
5797 implicit real*8 (a-h,o-z)
5798 include 'DIMENSIONS'
5799 include 'COMMON.VAR'
5800 include 'COMMON.GEO'
5801 include 'COMMON.LOCAL'
5802 include 'COMMON.TORSION'
5803 include 'COMMON.INTERACT'
5804 include 'COMMON.DERIV'
5805 include 'COMMON.CHAIN'
5806 include 'COMMON.NAMES'
5807 include 'COMMON.IOUNITS'
5808 include 'COMMON.FFIELD'
5809 include 'COMMON.TORCNSTR'
5811 C Set lprn=.true. for debugging
5815 c write(iout,*) "a tu??"
5816 do i=iphid_start,iphid_end
5817 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5818 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5819 itori=itortyp(itype(i-2))
5820 itori1=itortyp(itype(i-1))
5821 itori2=itortyp(itype(i))
5827 if (iabs(itype(i+1)).eq.20) iblock=2
5829 C Regular cosine and sine terms
5830 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5831 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5832 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5833 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5834 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5835 cosphi1=dcos(j*phii)
5836 sinphi1=dsin(j*phii)
5837 cosphi2=dcos(j*phii1)
5838 sinphi2=dsin(j*phii1)
5839 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5840 & v2cij*cosphi2+v2sij*sinphi2
5841 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5842 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5844 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5846 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5847 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5848 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5849 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5850 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5851 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5852 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5853 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5854 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5855 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5856 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5857 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5858 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5859 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5862 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5863 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5868 c------------------------------------------------------------------------------
5869 subroutine eback_sc_corr(esccor)
5870 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5871 c conformational states; temporarily implemented as differences
5872 c between UNRES torsional potentials (dependent on three types of
5873 c residues) and the torsional potentials dependent on all 20 types
5874 c of residues computed from AM1 energy surfaces of terminally-blocked
5875 c amino-acid residues.
5876 implicit real*8 (a-h,o-z)
5877 include 'DIMENSIONS'
5878 include 'COMMON.VAR'
5879 include 'COMMON.GEO'
5880 include 'COMMON.LOCAL'
5881 include 'COMMON.TORSION'
5882 include 'COMMON.SCCOR'
5883 include 'COMMON.INTERACT'
5884 include 'COMMON.DERIV'
5885 include 'COMMON.CHAIN'
5886 include 'COMMON.NAMES'
5887 include 'COMMON.IOUNITS'
5888 include 'COMMON.FFIELD'
5889 include 'COMMON.CONTROL'
5891 C Set lprn=.true. for debugging
5894 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5896 do i=itau_start,itau_end
5897 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5899 isccori=isccortyp(itype(i-2))
5900 isccori1=isccortyp(itype(i-1))
5901 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5903 do intertyp=1,3 !intertyp
5904 cc Added 09 May 2012 (Adasko)
5905 cc Intertyp means interaction type of backbone mainchain correlation:
5906 c 1 = SC...Ca...Ca...Ca
5907 c 2 = Ca...Ca...Ca...SC
5908 c 3 = SC...Ca...Ca...SCi
5910 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5911 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5912 & (itype(i-1).eq.ntyp1)))
5913 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5914 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5915 & .or.(itype(i).eq.ntyp1)))
5916 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5917 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5918 & (itype(i-3).eq.ntyp1)))) cycle
5919 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5920 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5922 do j=1,nterm_sccor(isccori,isccori1)
5923 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5924 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5925 cosphi=dcos(j*tauangle(intertyp,i))
5926 sinphi=dsin(j*tauangle(intertyp,i))
5927 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5928 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5930 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5931 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5933 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5934 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5935 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5936 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5937 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5943 c----------------------------------------------------------------------------
5944 subroutine multibody(ecorr)
5945 C This subroutine calculates multi-body contributions to energy following
5946 C the idea of Skolnick et al. If side chains I and J make a contact and
5947 C at the same time side chains I+1 and J+1 make a contact, an extra
5948 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5949 implicit real*8 (a-h,o-z)
5950 include 'DIMENSIONS'
5951 include 'COMMON.IOUNITS'
5952 include 'COMMON.DERIV'
5953 include 'COMMON.INTERACT'
5954 include 'COMMON.CONTACTS'
5955 double precision gx(3),gx1(3)
5958 C Set lprn=.true. for debugging
5962 write (iout,'(a)') 'Contact function values:'
5964 write (iout,'(i2,20(1x,i2,f10.5))')
5965 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5980 num_conti=num_cont(i)
5981 num_conti1=num_cont(i1)
5986 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5987 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5988 cd & ' ishift=',ishift
5989 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5990 C The system gains extra energy.
5991 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5992 endif ! j1==j+-ishift
6001 c------------------------------------------------------------------------------
6002 double precision function esccorr(i,j,k,l,jj,kk)
6003 implicit real*8 (a-h,o-z)
6004 include 'DIMENSIONS'
6005 include 'COMMON.IOUNITS'
6006 include 'COMMON.DERIV'
6007 include 'COMMON.INTERACT'
6008 include 'COMMON.CONTACTS'
6009 double precision gx(3),gx1(3)
6014 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6015 C Calculate the multi-body contribution to energy.
6016 C Calculate multi-body contributions to the gradient.
6017 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6018 cd & k,l,(gacont(m,kk,k),m=1,3)
6020 gx(m) =ekl*gacont(m,jj,i)
6021 gx1(m)=eij*gacont(m,kk,k)
6022 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6023 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6024 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6025 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6029 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6034 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6040 c------------------------------------------------------------------------------
6041 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6042 C This subroutine calculates multi-body contributions to hydrogen-bonding
6043 implicit real*8 (a-h,o-z)
6044 include 'DIMENSIONS'
6045 include 'COMMON.IOUNITS'
6048 parameter (max_cont=maxconts)
6049 parameter (max_dim=26)
6050 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6051 double precision zapas(max_dim,maxconts,max_fg_procs),
6052 & zapas_recv(max_dim,maxconts,max_fg_procs)
6053 common /przechowalnia/ zapas
6054 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6055 & status_array(MPI_STATUS_SIZE,maxconts*2)
6057 include 'COMMON.SETUP'
6058 include 'COMMON.FFIELD'
6059 include 'COMMON.DERIV'
6060 include 'COMMON.INTERACT'
6061 include 'COMMON.CONTACTS'
6062 include 'COMMON.CONTROL'
6063 include 'COMMON.LOCAL'
6064 double precision gx(3),gx1(3),time00
6067 C Set lprn=.true. for debugging
6072 if (nfgtasks.le.1) goto 30
6074 write (iout,'(a)') 'Contact function values before RECEIVE:'
6076 write (iout,'(2i3,50(1x,i2,f5.2))')
6077 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6078 & j=1,num_cont_hb(i))
6082 do i=1,ntask_cont_from
6085 do i=1,ntask_cont_to
6088 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6090 C Make the list of contacts to send to send to other procesors
6091 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6093 do i=iturn3_start,iturn3_end
6094 c write (iout,*) "make contact list turn3",i," num_cont",
6096 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6098 do i=iturn4_start,iturn4_end
6099 c write (iout,*) "make contact list turn4",i," num_cont",
6101 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6105 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6107 do j=1,num_cont_hb(i)
6110 iproc=iint_sent_local(k,jjc,ii)
6111 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6112 if (iproc.gt.0) then
6113 ncont_sent(iproc)=ncont_sent(iproc)+1
6114 nn=ncont_sent(iproc)
6116 zapas(2,nn,iproc)=jjc
6117 zapas(3,nn,iproc)=facont_hb(j,i)
6118 zapas(4,nn,iproc)=ees0p(j,i)
6119 zapas(5,nn,iproc)=ees0m(j,i)
6120 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6121 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6122 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6123 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6124 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6125 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6126 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6127 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6128 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6129 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6130 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6131 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6132 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6133 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6134 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6135 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6136 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6137 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6138 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6139 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6140 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6147 & "Numbers of contacts to be sent to other processors",
6148 & (ncont_sent(i),i=1,ntask_cont_to)
6149 write (iout,*) "Contacts sent"
6150 do ii=1,ntask_cont_to
6152 iproc=itask_cont_to(ii)
6153 write (iout,*) nn," contacts to processor",iproc,
6154 & " of CONT_TO_COMM group"
6156 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6164 CorrelID1=nfgtasks+fg_rank+1
6166 C Receive the numbers of needed contacts from other processors
6167 do ii=1,ntask_cont_from
6168 iproc=itask_cont_from(ii)
6170 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6171 & FG_COMM,req(ireq),IERR)
6173 c write (iout,*) "IRECV ended"
6175 C Send the number of contacts needed by other processors
6176 do ii=1,ntask_cont_to
6177 iproc=itask_cont_to(ii)
6179 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6180 & FG_COMM,req(ireq),IERR)
6182 c write (iout,*) "ISEND ended"
6183 c write (iout,*) "number of requests (nn)",ireq
6186 & call MPI_Waitall(ireq,req,status_array,ierr)
6188 c & "Numbers of contacts to be received from other processors",
6189 c & (ncont_recv(i),i=1,ntask_cont_from)
6193 do ii=1,ntask_cont_from
6194 iproc=itask_cont_from(ii)
6196 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6197 c & " of CONT_TO_COMM group"
6201 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6202 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6203 c write (iout,*) "ireq,req",ireq,req(ireq)
6206 C Send the contacts to processors that need them
6207 do ii=1,ntask_cont_to
6208 iproc=itask_cont_to(ii)
6210 c write (iout,*) nn," contacts to processor",iproc,
6211 c & " of CONT_TO_COMM group"
6214 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6215 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6216 c write (iout,*) "ireq,req",ireq,req(ireq)
6218 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6222 c write (iout,*) "number of requests (contacts)",ireq
6223 c write (iout,*) "req",(req(i),i=1,4)
6226 & call MPI_Waitall(ireq,req,status_array,ierr)
6227 do iii=1,ntask_cont_from
6228 iproc=itask_cont_from(iii)
6231 write (iout,*) "Received",nn," contacts from processor",iproc,
6232 & " of CONT_FROM_COMM group"
6235 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6240 ii=zapas_recv(1,i,iii)
6241 c Flag the received contacts to prevent double-counting
6242 jj=-zapas_recv(2,i,iii)
6243 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6245 nnn=num_cont_hb(ii)+1
6248 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6249 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6250 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6251 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6252 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6253 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6254 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6255 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6256 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6257 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6258 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6259 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6260 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6261 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6262 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6263 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6264 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6265 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6266 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6267 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6268 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6269 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6270 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6271 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6276 write (iout,'(a)') 'Contact function values after receive:'
6278 write (iout,'(2i3,50(1x,i3,f5.2))')
6279 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6280 & j=1,num_cont_hb(i))
6287 write (iout,'(a)') 'Contact function values:'
6289 write (iout,'(2i3,50(1x,i3,f5.2))')
6290 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6291 & j=1,num_cont_hb(i))
6295 C Remove the loop below after debugging !!!
6302 C Calculate the local-electrostatic correlation terms
6303 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6305 num_conti=num_cont_hb(i)
6306 num_conti1=num_cont_hb(i+1)
6313 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6314 c & ' jj=',jj,' kk=',kk
6315 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6316 & .or. j.lt.0 .and. j1.gt.0) .and.
6317 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6318 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6319 C The system gains extra energy.
6320 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6321 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6322 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6324 else if (j1.eq.j) then
6325 C Contacts I-J and I-(J+1) occur simultaneously.
6326 C The system loses extra energy.
6327 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6332 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6333 c & ' jj=',jj,' kk=',kk
6335 C Contacts I-J and (I+1)-J occur simultaneously.
6336 C The system loses extra energy.
6337 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6344 c------------------------------------------------------------------------------
6345 subroutine add_hb_contact(ii,jj,itask)
6346 implicit real*8 (a-h,o-z)
6347 include "DIMENSIONS"
6348 include "COMMON.IOUNITS"
6351 parameter (max_cont=maxconts)
6352 parameter (max_dim=26)
6353 include "COMMON.CONTACTS"
6354 double precision zapas(max_dim,maxconts,max_fg_procs),
6355 & zapas_recv(max_dim,maxconts,max_fg_procs)
6356 common /przechowalnia/ zapas
6357 integer i,j,ii,jj,iproc,itask(4),nn
6358 c write (iout,*) "itask",itask
6361 if (iproc.gt.0) then
6362 do j=1,num_cont_hb(ii)
6364 c write (iout,*) "i",ii," j",jj," jjc",jjc
6366 ncont_sent(iproc)=ncont_sent(iproc)+1
6367 nn=ncont_sent(iproc)
6368 zapas(1,nn,iproc)=ii
6369 zapas(2,nn,iproc)=jjc
6370 zapas(3,nn,iproc)=facont_hb(j,ii)
6371 zapas(4,nn,iproc)=ees0p(j,ii)
6372 zapas(5,nn,iproc)=ees0m(j,ii)
6373 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6374 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6375 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6376 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6377 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6378 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6379 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6380 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6381 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6382 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6383 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6384 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6385 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6386 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6387 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6388 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6389 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6390 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6391 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6392 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6393 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6401 c------------------------------------------------------------------------------
6402 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6404 C This subroutine calculates multi-body contributions to hydrogen-bonding
6405 implicit real*8 (a-h,o-z)
6406 include 'DIMENSIONS'
6407 include 'COMMON.IOUNITS'
6410 parameter (max_cont=maxconts)
6411 parameter (max_dim=70)
6412 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6413 double precision zapas(max_dim,maxconts,max_fg_procs),
6414 & zapas_recv(max_dim,maxconts,max_fg_procs)
6415 common /przechowalnia/ zapas
6416 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6417 & status_array(MPI_STATUS_SIZE,maxconts*2)
6419 include 'COMMON.SETUP'
6420 include 'COMMON.FFIELD'
6421 include 'COMMON.DERIV'
6422 include 'COMMON.LOCAL'
6423 include 'COMMON.INTERACT'
6424 include 'COMMON.CONTACTS'
6425 include 'COMMON.CHAIN'
6426 include 'COMMON.CONTROL'
6427 double precision gx(3),gx1(3)
6428 integer num_cont_hb_old(maxres)
6430 double precision eello4,eello5,eelo6,eello_turn6
6431 external eello4,eello5,eello6,eello_turn6
6432 C Set lprn=.true. for debugging
6437 num_cont_hb_old(i)=num_cont_hb(i)
6441 if (nfgtasks.le.1) goto 30
6443 write (iout,'(a)') 'Contact function values before RECEIVE:'
6445 write (iout,'(2i3,50(1x,i2,f5.2))')
6446 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6447 & j=1,num_cont_hb(i))
6451 do i=1,ntask_cont_from
6454 do i=1,ntask_cont_to
6457 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6459 C Make the list of contacts to send to send to other procesors
6460 do i=iturn3_start,iturn3_end
6461 c write (iout,*) "make contact list turn3",i," num_cont",
6463 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6465 do i=iturn4_start,iturn4_end
6466 c write (iout,*) "make contact list turn4",i," num_cont",
6468 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6472 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6474 do j=1,num_cont_hb(i)
6477 iproc=iint_sent_local(k,jjc,ii)
6478 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6479 if (iproc.ne.0) then
6480 ncont_sent(iproc)=ncont_sent(iproc)+1
6481 nn=ncont_sent(iproc)
6483 zapas(2,nn,iproc)=jjc
6484 zapas(3,nn,iproc)=d_cont(j,i)
6488 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6493 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6501 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6512 & "Numbers of contacts to be sent to other processors",
6513 & (ncont_sent(i),i=1,ntask_cont_to)
6514 write (iout,*) "Contacts sent"
6515 do ii=1,ntask_cont_to
6517 iproc=itask_cont_to(ii)
6518 write (iout,*) nn," contacts to processor",iproc,
6519 & " of CONT_TO_COMM group"
6521 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6529 CorrelID1=nfgtasks+fg_rank+1
6531 C Receive the numbers of needed contacts from other processors
6532 do ii=1,ntask_cont_from
6533 iproc=itask_cont_from(ii)
6535 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6536 & FG_COMM,req(ireq),IERR)
6538 c write (iout,*) "IRECV ended"
6540 C Send the number of contacts needed by other processors
6541 do ii=1,ntask_cont_to
6542 iproc=itask_cont_to(ii)
6544 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6545 & FG_COMM,req(ireq),IERR)
6547 c write (iout,*) "ISEND ended"
6548 c write (iout,*) "number of requests (nn)",ireq
6551 & call MPI_Waitall(ireq,req,status_array,ierr)
6553 c & "Numbers of contacts to be received from other processors",
6554 c & (ncont_recv(i),i=1,ntask_cont_from)
6558 do ii=1,ntask_cont_from
6559 iproc=itask_cont_from(ii)
6561 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6562 c & " of CONT_TO_COMM group"
6566 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6567 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6568 c write (iout,*) "ireq,req",ireq,req(ireq)
6571 C Send the contacts to processors that need them
6572 do ii=1,ntask_cont_to
6573 iproc=itask_cont_to(ii)
6575 c write (iout,*) nn," contacts to processor",iproc,
6576 c & " of CONT_TO_COMM group"
6579 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6580 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6581 c write (iout,*) "ireq,req",ireq,req(ireq)
6583 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6587 c write (iout,*) "number of requests (contacts)",ireq
6588 c write (iout,*) "req",(req(i),i=1,4)
6591 & call MPI_Waitall(ireq,req,status_array,ierr)
6592 do iii=1,ntask_cont_from
6593 iproc=itask_cont_from(iii)
6596 write (iout,*) "Received",nn," contacts from processor",iproc,
6597 & " of CONT_FROM_COMM group"
6600 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6605 ii=zapas_recv(1,i,iii)
6606 c Flag the received contacts to prevent double-counting
6607 jj=-zapas_recv(2,i,iii)
6608 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6610 nnn=num_cont_hb(ii)+1
6613 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6617 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6622 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6630 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6639 write (iout,'(a)') 'Contact function values after receive:'
6641 write (iout,'(2i3,50(1x,i3,5f6.3))')
6642 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6643 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6650 write (iout,'(a)') 'Contact function values:'
6652 write (iout,'(2i3,50(1x,i2,5f6.3))')
6653 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6654 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6660 C Remove the loop below after debugging !!!
6667 C Calculate the dipole-dipole interaction energies
6668 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6669 do i=iatel_s,iatel_e+1
6670 num_conti=num_cont_hb(i)
6679 C Calculate the local-electrostatic correlation terms
6680 c write (iout,*) "gradcorr5 in eello5 before loop"
6682 c write (iout,'(i5,3f10.5)')
6683 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6685 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6686 c write (iout,*) "corr loop i",i
6688 num_conti=num_cont_hb(i)
6689 num_conti1=num_cont_hb(i+1)
6696 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6697 c & ' jj=',jj,' kk=',kk
6698 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6699 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6700 & .or. j.lt.0 .and. j1.gt.0) .and.
6701 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6702 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6703 C The system gains extra energy.
6705 sqd1=dsqrt(d_cont(jj,i))
6706 sqd2=dsqrt(d_cont(kk,i1))
6707 sred_geom = sqd1*sqd2
6708 IF (sred_geom.lt.cutoff_corr) THEN
6709 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6711 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6712 cd & ' jj=',jj,' kk=',kk
6713 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6714 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6716 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6717 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6720 cd write (iout,*) 'sred_geom=',sred_geom,
6721 cd & ' ekont=',ekont,' fprim=',fprimcont,
6722 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6723 cd write (iout,*) "g_contij",g_contij
6724 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6725 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6726 call calc_eello(i,jp,i+1,jp1,jj,kk)
6727 if (wcorr4.gt.0.0d0)
6728 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6729 if (energy_dec.and.wcorr4.gt.0.0d0)
6730 1 write (iout,'(a6,4i5,0pf7.3)')
6731 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6732 c write (iout,*) "gradcorr5 before eello5"
6734 c write (iout,'(i5,3f10.5)')
6735 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6737 if (wcorr5.gt.0.0d0)
6738 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6739 c write (iout,*) "gradcorr5 after eello5"
6741 c write (iout,'(i5,3f10.5)')
6742 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6744 if (energy_dec.and.wcorr5.gt.0.0d0)
6745 1 write (iout,'(a6,4i5,0pf7.3)')
6746 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6747 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6748 cd write(2,*)'ijkl',i,jp,i+1,jp1
6749 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6750 & .or. wturn6.eq.0.0d0))then
6751 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6752 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6753 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6754 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6755 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6756 cd & 'ecorr6=',ecorr6
6757 cd write (iout,'(4e15.5)') sred_geom,
6758 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6759 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6760 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6761 else if (wturn6.gt.0.0d0
6762 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6763 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6764 eturn6=eturn6+eello_turn6(i,jj,kk)
6765 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6766 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6767 cd write (2,*) 'multibody_eello:eturn6',eturn6
6776 num_cont_hb(i)=num_cont_hb_old(i)
6778 c write (iout,*) "gradcorr5 in eello5"
6780 c write (iout,'(i5,3f10.5)')
6781 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6785 c------------------------------------------------------------------------------
6786 subroutine add_hb_contact_eello(ii,jj,itask)
6787 implicit real*8 (a-h,o-z)
6788 include "DIMENSIONS"
6789 include "COMMON.IOUNITS"
6792 parameter (max_cont=maxconts)
6793 parameter (max_dim=70)
6794 include "COMMON.CONTACTS"
6795 double precision zapas(max_dim,maxconts,max_fg_procs),
6796 & zapas_recv(max_dim,maxconts,max_fg_procs)
6797 common /przechowalnia/ zapas
6798 integer i,j,ii,jj,iproc,itask(4),nn
6799 c write (iout,*) "itask",itask
6802 if (iproc.gt.0) then
6803 do j=1,num_cont_hb(ii)
6805 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6807 ncont_sent(iproc)=ncont_sent(iproc)+1
6808 nn=ncont_sent(iproc)
6809 zapas(1,nn,iproc)=ii
6810 zapas(2,nn,iproc)=jjc
6811 zapas(3,nn,iproc)=d_cont(j,ii)
6815 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6820 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6828 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6840 c------------------------------------------------------------------------------
6841 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6842 implicit real*8 (a-h,o-z)
6843 include 'DIMENSIONS'
6844 include 'COMMON.IOUNITS'
6845 include 'COMMON.DERIV'
6846 include 'COMMON.INTERACT'
6847 include 'COMMON.CONTACTS'
6848 double precision gx(3),gx1(3)
6858 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6859 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6860 C Following 4 lines for diagnostics.
6865 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6866 c & 'Contacts ',i,j,
6867 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6868 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6870 C Calculate the multi-body contribution to energy.
6871 c ecorr=ecorr+ekont*ees
6872 C Calculate multi-body contributions to the gradient.
6873 coeffpees0pij=coeffp*ees0pij
6874 coeffmees0mij=coeffm*ees0mij
6875 coeffpees0pkl=coeffp*ees0pkl
6876 coeffmees0mkl=coeffm*ees0mkl
6878 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6879 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6880 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6881 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6882 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6883 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6884 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6885 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6886 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6887 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6888 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6889 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6890 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6891 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6892 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6893 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6894 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6895 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6896 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6897 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6898 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6899 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6900 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6901 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6902 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6907 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6908 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6909 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6910 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6915 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6916 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6917 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6918 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6921 c write (iout,*) "ehbcorr",ekont*ees
6926 C---------------------------------------------------------------------------
6927 subroutine dipole(i,j,jj)
6928 implicit real*8 (a-h,o-z)
6929 include 'DIMENSIONS'
6930 include 'COMMON.IOUNITS'
6931 include 'COMMON.CHAIN'
6932 include 'COMMON.FFIELD'
6933 include 'COMMON.DERIV'
6934 include 'COMMON.INTERACT'
6935 include 'COMMON.CONTACTS'
6936 include 'COMMON.TORSION'
6937 include 'COMMON.VAR'
6938 include 'COMMON.GEO'
6939 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6941 iti1 = itortyp(itype(i+1))
6942 if (j.lt.nres-1) then
6943 itj1 = itortyp(itype(j+1))
6948 dipi(iii,1)=Ub2(iii,i)
6949 dipderi(iii)=Ub2der(iii,i)
6950 dipi(iii,2)=b1(iii,i+1)
6951 dipj(iii,1)=Ub2(iii,j)
6952 dipderj(iii)=Ub2der(iii,j)
6953 dipj(iii,2)=b1(iii,j+1)
6957 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6960 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6967 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6971 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6976 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6977 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6979 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6981 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6983 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6988 C---------------------------------------------------------------------------
6989 subroutine calc_eello(i,j,k,l,jj,kk)
6991 C This subroutine computes matrices and vectors needed to calculate
6992 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6994 implicit real*8 (a-h,o-z)
6995 include 'DIMENSIONS'
6996 include 'COMMON.IOUNITS'
6997 include 'COMMON.CHAIN'
6998 include 'COMMON.DERIV'
6999 include 'COMMON.INTERACT'
7000 include 'COMMON.CONTACTS'
7001 include 'COMMON.TORSION'
7002 include 'COMMON.VAR'
7003 include 'COMMON.GEO'
7004 include 'COMMON.FFIELD'
7005 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7006 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7009 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7010 cd & ' jj=',jj,' kk=',kk
7011 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7012 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7013 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7016 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7017 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7020 call transpose2(aa1(1,1),aa1t(1,1))
7021 call transpose2(aa2(1,1),aa2t(1,1))
7024 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7025 & aa1tder(1,1,lll,kkk))
7026 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7027 & aa2tder(1,1,lll,kkk))
7031 C parallel orientation of the two CA-CA-CA frames.
7033 iti=itortyp(itype(i))
7037 itk1=itortyp(itype(k+1))
7038 itj=itortyp(itype(j))
7039 if (l.lt.nres-1) then
7040 itl1=itortyp(itype(l+1))
7044 C A1 kernel(j+1) A2T
7046 cd write (iout,'(3f10.5,5x,3f10.5)')
7047 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7049 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7050 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7051 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7052 C Following matrices are needed only for 6-th order cumulants
7053 IF (wcorr6.gt.0.0d0) THEN
7054 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7055 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7056 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7057 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7058 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7059 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7060 & ADtEAderx(1,1,1,1,1,1))
7062 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7063 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7064 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7065 & ADtEA1derx(1,1,1,1,1,1))
7067 C End 6-th order cumulants
7070 cd write (2,*) 'In calc_eello6'
7072 cd write (2,*) 'iii=',iii
7074 cd write (2,*) 'kkk=',kkk
7076 cd write (2,'(3(2f10.5),5x)')
7077 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7082 call transpose2(EUgder(1,1,k),auxmat(1,1))
7083 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7084 call transpose2(EUg(1,1,k),auxmat(1,1))
7085 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7086 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7090 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7091 & EAEAderx(1,1,lll,kkk,iii,1))
7095 C A1T kernel(i+1) A2
7096 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7097 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7098 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7099 C Following matrices are needed only for 6-th order cumulants
7100 IF (wcorr6.gt.0.0d0) THEN
7101 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7102 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7103 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7104 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7105 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7106 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7107 & ADtEAderx(1,1,1,1,1,2))
7108 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7109 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7110 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7111 & ADtEA1derx(1,1,1,1,1,2))
7113 C End 6-th order cumulants
7114 call transpose2(EUgder(1,1,l),auxmat(1,1))
7115 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7116 call transpose2(EUg(1,1,l),auxmat(1,1))
7117 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7118 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7122 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7123 & EAEAderx(1,1,lll,kkk,iii,2))
7128 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7129 C They are needed only when the fifth- or the sixth-order cumulants are
7131 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7132 call transpose2(AEA(1,1,1),auxmat(1,1))
7133 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7134 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7135 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7136 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7137 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7138 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7139 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7140 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7141 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7142 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7143 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7144 call transpose2(AEA(1,1,2),auxmat(1,1))
7145 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7146 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7147 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7148 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7149 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7150 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7151 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7152 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7153 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7154 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7155 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7156 C Calculate the Cartesian derivatives of the vectors.
7160 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7161 call matvec2(auxmat(1,1),b1(1,i),
7162 & AEAb1derx(1,lll,kkk,iii,1,1))
7163 call matvec2(auxmat(1,1),Ub2(1,i),
7164 & AEAb2derx(1,lll,kkk,iii,1,1))
7165 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7166 & AEAb1derx(1,lll,kkk,iii,2,1))
7167 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7168 & AEAb2derx(1,lll,kkk,iii,2,1))
7169 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7170 call matvec2(auxmat(1,1),b1(1,j),
7171 & AEAb1derx(1,lll,kkk,iii,1,2))
7172 call matvec2(auxmat(1,1),Ub2(1,j),
7173 & AEAb2derx(1,lll,kkk,iii,1,2))
7174 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7175 & AEAb1derx(1,lll,kkk,iii,2,2))
7176 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7177 & AEAb2derx(1,lll,kkk,iii,2,2))
7184 C Antiparallel orientation of the two CA-CA-CA frames.
7186 iti=itortyp(itype(i))
7190 itk1=itortyp(itype(k+1))
7191 itl=itortyp(itype(l))
7192 itj=itortyp(itype(j))
7193 if (j.lt.nres-1) then
7194 itj1=itortyp(itype(j+1))
7198 C A2 kernel(j-1)T A1T
7199 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7200 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7201 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7202 C Following matrices are needed only for 6-th order cumulants
7203 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7204 & j.eq.i+4 .and. l.eq.i+3)) THEN
7205 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7206 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7207 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7208 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7209 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7210 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7211 & ADtEAderx(1,1,1,1,1,1))
7212 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7213 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7214 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7215 & ADtEA1derx(1,1,1,1,1,1))
7217 C End 6-th order cumulants
7218 call transpose2(EUgder(1,1,k),auxmat(1,1))
7219 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7220 call transpose2(EUg(1,1,k),auxmat(1,1))
7221 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7222 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7226 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7227 & EAEAderx(1,1,lll,kkk,iii,1))
7231 C A2T kernel(i+1)T A1
7232 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7233 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7234 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7235 C Following matrices are needed only for 6-th order cumulants
7236 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7237 & j.eq.i+4 .and. l.eq.i+3)) THEN
7238 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7239 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7240 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7241 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7242 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7243 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7244 & ADtEAderx(1,1,1,1,1,2))
7245 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7246 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7247 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7248 & ADtEA1derx(1,1,1,1,1,2))
7250 C End 6-th order cumulants
7251 call transpose2(EUgder(1,1,j),auxmat(1,1))
7252 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7253 call transpose2(EUg(1,1,j),auxmat(1,1))
7254 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7255 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7259 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7260 & EAEAderx(1,1,lll,kkk,iii,2))
7265 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7266 C They are needed only when the fifth- or the sixth-order cumulants are
7268 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7269 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7270 call transpose2(AEA(1,1,1),auxmat(1,1))
7271 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7272 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7273 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7274 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7275 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7276 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7277 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7278 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7279 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7280 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7281 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7282 call transpose2(AEA(1,1,2),auxmat(1,1))
7283 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7284 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7285 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7286 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7287 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7288 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7289 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7290 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7291 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7292 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7293 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7294 C Calculate the Cartesian derivatives of the vectors.
7298 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7299 call matvec2(auxmat(1,1),b1(1,i),
7300 & AEAb1derx(1,lll,kkk,iii,1,1))
7301 call matvec2(auxmat(1,1),Ub2(1,i),
7302 & AEAb2derx(1,lll,kkk,iii,1,1))
7303 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7304 & AEAb1derx(1,lll,kkk,iii,2,1))
7305 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7306 & AEAb2derx(1,lll,kkk,iii,2,1))
7307 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7308 call matvec2(auxmat(1,1),b1(1,l),
7309 & AEAb1derx(1,lll,kkk,iii,1,2))
7310 call matvec2(auxmat(1,1),Ub2(1,l),
7311 & AEAb2derx(1,lll,kkk,iii,1,2))
7312 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7313 & AEAb1derx(1,lll,kkk,iii,2,2))
7314 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7315 & AEAb2derx(1,lll,kkk,iii,2,2))
7324 C---------------------------------------------------------------------------
7325 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7326 & KK,KKderg,AKA,AKAderg,AKAderx)
7330 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7331 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7332 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7337 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7339 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7342 cd if (lprn) write (2,*) 'In kernel'
7344 cd if (lprn) write (2,*) 'kkk=',kkk
7346 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7347 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7349 cd write (2,*) 'lll=',lll
7350 cd write (2,*) 'iii=1'
7352 cd write (2,'(3(2f10.5),5x)')
7353 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7356 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7357 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7359 cd write (2,*) 'lll=',lll
7360 cd write (2,*) 'iii=2'
7362 cd write (2,'(3(2f10.5),5x)')
7363 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7370 C---------------------------------------------------------------------------
7371 double precision function eello4(i,j,k,l,jj,kk)
7372 implicit real*8 (a-h,o-z)
7373 include 'DIMENSIONS'
7374 include 'COMMON.IOUNITS'
7375 include 'COMMON.CHAIN'
7376 include 'COMMON.DERIV'
7377 include 'COMMON.INTERACT'
7378 include 'COMMON.CONTACTS'
7379 include 'COMMON.TORSION'
7380 include 'COMMON.VAR'
7381 include 'COMMON.GEO'
7382 double precision pizda(2,2),ggg1(3),ggg2(3)
7383 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7387 cd print *,'eello4:',i,j,k,l,jj,kk
7388 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7389 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7390 cold eij=facont_hb(jj,i)
7391 cold ekl=facont_hb(kk,k)
7393 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7394 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7395 gcorr_loc(k-1)=gcorr_loc(k-1)
7396 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7398 gcorr_loc(l-1)=gcorr_loc(l-1)
7399 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7401 gcorr_loc(j-1)=gcorr_loc(j-1)
7402 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7407 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7408 & -EAEAderx(2,2,lll,kkk,iii,1)
7409 cd derx(lll,kkk,iii)=0.0d0
7413 cd gcorr_loc(l-1)=0.0d0
7414 cd gcorr_loc(j-1)=0.0d0
7415 cd gcorr_loc(k-1)=0.0d0
7417 cd write (iout,*)'Contacts have occurred for peptide groups',
7418 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7419 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7420 if (j.lt.nres-1) then
7427 if (l.lt.nres-1) then
7435 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7436 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7437 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7438 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7439 cgrad ghalf=0.5d0*ggg1(ll)
7440 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7441 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7442 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7443 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7444 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7445 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7446 cgrad ghalf=0.5d0*ggg2(ll)
7447 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7448 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7449 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7450 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7451 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7452 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7456 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7461 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7466 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7471 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7475 cd write (2,*) iii,gcorr_loc(iii)
7478 cd write (2,*) 'ekont',ekont
7479 cd write (iout,*) 'eello4',ekont*eel4
7482 C---------------------------------------------------------------------------
7483 double precision function eello5(i,j,k,l,jj,kk)
7484 implicit real*8 (a-h,o-z)
7485 include 'DIMENSIONS'
7486 include 'COMMON.IOUNITS'
7487 include 'COMMON.CHAIN'
7488 include 'COMMON.DERIV'
7489 include 'COMMON.INTERACT'
7490 include 'COMMON.CONTACTS'
7491 include 'COMMON.TORSION'
7492 include 'COMMON.VAR'
7493 include 'COMMON.GEO'
7494 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7495 double precision ggg1(3),ggg2(3)
7496 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7501 C /l\ / \ \ / \ / \ / C
7502 C / \ / \ \ / \ / \ / C
7503 C j| o |l1 | o | o| o | | o |o C
7504 C \ |/k\| |/ \| / |/ \| |/ \| C
7505 C \i/ \ / \ / / \ / \ C
7507 C (I) (II) (III) (IV) C
7509 C eello5_1 eello5_2 eello5_3 eello5_4 C
7511 C Antiparallel chains C
7514 C /j\ / \ \ / \ / \ / C
7515 C / \ / \ \ / \ / \ / C
7516 C j1| o |l | o | o| o | | o |o C
7517 C \ |/k\| |/ \| / |/ \| |/ \| C
7518 C \i/ \ / \ / / \ / \ C
7520 C (I) (II) (III) (IV) C
7522 C eello5_1 eello5_2 eello5_3 eello5_4 C
7524 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7526 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7527 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7532 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7534 itk=itortyp(itype(k))
7535 itl=itortyp(itype(l))
7536 itj=itortyp(itype(j))
7541 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7542 cd & eel5_3_num,eel5_4_num)
7546 derx(lll,kkk,iii)=0.0d0
7550 cd eij=facont_hb(jj,i)
7551 cd ekl=facont_hb(kk,k)
7553 cd write (iout,*)'Contacts have occurred for peptide groups',
7554 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7556 C Contribution from the graph I.
7557 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7558 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7559 call transpose2(EUg(1,1,k),auxmat(1,1))
7560 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7561 vv(1)=pizda(1,1)-pizda(2,2)
7562 vv(2)=pizda(1,2)+pizda(2,1)
7563 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7564 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7565 C Explicit gradient in virtual-dihedral angles.
7566 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7567 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7568 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7569 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7570 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7571 vv(1)=pizda(1,1)-pizda(2,2)
7572 vv(2)=pizda(1,2)+pizda(2,1)
7573 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7574 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7575 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7576 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7577 vv(1)=pizda(1,1)-pizda(2,2)
7578 vv(2)=pizda(1,2)+pizda(2,1)
7580 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7581 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7582 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7584 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7585 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7586 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7588 C Cartesian gradient
7592 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7594 vv(1)=pizda(1,1)-pizda(2,2)
7595 vv(2)=pizda(1,2)+pizda(2,1)
7596 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7597 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7598 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7604 C Contribution from graph II
7605 call transpose2(EE(1,1,itk),auxmat(1,1))
7606 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7607 vv(1)=pizda(1,1)+pizda(2,2)
7608 vv(2)=pizda(2,1)-pizda(1,2)
7609 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7610 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7611 C Explicit gradient in virtual-dihedral angles.
7612 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7613 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7614 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7615 vv(1)=pizda(1,1)+pizda(2,2)
7616 vv(2)=pizda(2,1)-pizda(1,2)
7618 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7619 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7620 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7622 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7623 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7624 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7626 C Cartesian gradient
7630 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7632 vv(1)=pizda(1,1)+pizda(2,2)
7633 vv(2)=pizda(2,1)-pizda(1,2)
7634 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7635 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7636 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7644 C Parallel orientation
7645 C Contribution from graph III
7646 call transpose2(EUg(1,1,l),auxmat(1,1))
7647 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7648 vv(1)=pizda(1,1)-pizda(2,2)
7649 vv(2)=pizda(1,2)+pizda(2,1)
7650 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7651 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7652 C Explicit gradient in virtual-dihedral angles.
7653 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7654 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7655 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7656 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7657 vv(1)=pizda(1,1)-pizda(2,2)
7658 vv(2)=pizda(1,2)+pizda(2,1)
7659 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7660 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7661 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7662 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7663 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7664 vv(1)=pizda(1,1)-pizda(2,2)
7665 vv(2)=pizda(1,2)+pizda(2,1)
7666 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7667 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7668 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7669 C Cartesian gradient
7673 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7675 vv(1)=pizda(1,1)-pizda(2,2)
7676 vv(2)=pizda(1,2)+pizda(2,1)
7677 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7678 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7679 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7684 C Contribution from graph IV
7686 call transpose2(EE(1,1,itl),auxmat(1,1))
7687 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7688 vv(1)=pizda(1,1)+pizda(2,2)
7689 vv(2)=pizda(2,1)-pizda(1,2)
7690 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7691 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7692 C Explicit gradient in virtual-dihedral angles.
7693 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7694 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7695 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7696 vv(1)=pizda(1,1)+pizda(2,2)
7697 vv(2)=pizda(2,1)-pizda(1,2)
7698 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7699 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7700 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7701 C Cartesian gradient
7705 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7707 vv(1)=pizda(1,1)+pizda(2,2)
7708 vv(2)=pizda(2,1)-pizda(1,2)
7709 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7710 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7711 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7716 C Antiparallel orientation
7717 C Contribution from graph III
7719 call transpose2(EUg(1,1,j),auxmat(1,1))
7720 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7721 vv(1)=pizda(1,1)-pizda(2,2)
7722 vv(2)=pizda(1,2)+pizda(2,1)
7723 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7724 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7725 C Explicit gradient in virtual-dihedral angles.
7726 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7727 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7728 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7729 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7730 vv(1)=pizda(1,1)-pizda(2,2)
7731 vv(2)=pizda(1,2)+pizda(2,1)
7732 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7733 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7734 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7735 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7736 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7737 vv(1)=pizda(1,1)-pizda(2,2)
7738 vv(2)=pizda(1,2)+pizda(2,1)
7739 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7740 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7741 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7742 C Cartesian gradient
7746 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7748 vv(1)=pizda(1,1)-pizda(2,2)
7749 vv(2)=pizda(1,2)+pizda(2,1)
7750 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7751 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7752 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7757 C Contribution from graph IV
7759 call transpose2(EE(1,1,itj),auxmat(1,1))
7760 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7761 vv(1)=pizda(1,1)+pizda(2,2)
7762 vv(2)=pizda(2,1)-pizda(1,2)
7763 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7764 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7765 C Explicit gradient in virtual-dihedral angles.
7766 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7767 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7768 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7769 vv(1)=pizda(1,1)+pizda(2,2)
7770 vv(2)=pizda(2,1)-pizda(1,2)
7771 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7772 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7773 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7774 C Cartesian gradient
7778 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7780 vv(1)=pizda(1,1)+pizda(2,2)
7781 vv(2)=pizda(2,1)-pizda(1,2)
7782 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7783 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7784 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7790 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7791 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7792 cd write (2,*) 'ijkl',i,j,k,l
7793 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7794 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7796 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7797 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7798 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7799 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7800 if (j.lt.nres-1) then
7807 if (l.lt.nres-1) then
7817 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7818 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7819 C summed up outside the subrouine as for the other subroutines
7820 C handling long-range interactions. The old code is commented out
7821 C with "cgrad" to keep track of changes.
7823 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7824 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7825 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7826 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7827 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7828 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7829 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7830 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7831 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7832 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7834 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7835 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7836 cgrad ghalf=0.5d0*ggg1(ll)
7838 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7839 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7840 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7841 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7842 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7843 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7844 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7845 cgrad ghalf=0.5d0*ggg2(ll)
7847 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7848 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7849 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7850 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7851 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7852 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7857 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7858 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7863 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7864 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7870 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7875 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7879 cd write (2,*) iii,g_corr5_loc(iii)
7882 cd write (2,*) 'ekont',ekont
7883 cd write (iout,*) 'eello5',ekont*eel5
7886 c--------------------------------------------------------------------------
7887 double precision function eello6(i,j,k,l,jj,kk)
7888 implicit real*8 (a-h,o-z)
7889 include 'DIMENSIONS'
7890 include 'COMMON.IOUNITS'
7891 include 'COMMON.CHAIN'
7892 include 'COMMON.DERIV'
7893 include 'COMMON.INTERACT'
7894 include 'COMMON.CONTACTS'
7895 include 'COMMON.TORSION'
7896 include 'COMMON.VAR'
7897 include 'COMMON.GEO'
7898 include 'COMMON.FFIELD'
7899 double precision ggg1(3),ggg2(3)
7900 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7905 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7913 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7914 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7918 derx(lll,kkk,iii)=0.0d0
7922 cd eij=facont_hb(jj,i)
7923 cd ekl=facont_hb(kk,k)
7929 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7930 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7931 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7932 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7933 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7934 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7936 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7937 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7938 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7939 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7940 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7941 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7945 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7947 C If turn contributions are considered, they will be handled separately.
7948 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7949 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7950 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7951 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7952 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7953 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7954 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7956 if (j.lt.nres-1) then
7963 if (l.lt.nres-1) then
7971 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7972 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7973 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7974 cgrad ghalf=0.5d0*ggg1(ll)
7976 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7977 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7978 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7979 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7980 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7981 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7982 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7983 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7984 cgrad ghalf=0.5d0*ggg2(ll)
7985 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7987 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7988 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7989 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7990 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7991 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7992 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7997 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7998 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8003 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8004 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8010 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8015 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8019 cd write (2,*) iii,g_corr6_loc(iii)
8022 cd write (2,*) 'ekont',ekont
8023 cd write (iout,*) 'eello6',ekont*eel6
8026 c--------------------------------------------------------------------------
8027 double precision function eello6_graph1(i,j,k,l,imat,swap)
8028 implicit real*8 (a-h,o-z)
8029 include 'DIMENSIONS'
8030 include 'COMMON.IOUNITS'
8031 include 'COMMON.CHAIN'
8032 include 'COMMON.DERIV'
8033 include 'COMMON.INTERACT'
8034 include 'COMMON.CONTACTS'
8035 include 'COMMON.TORSION'
8036 include 'COMMON.VAR'
8037 include 'COMMON.GEO'
8038 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8044 C Parallel Antiparallel C
8050 C \ j|/k\| / \ |/k\|l / C
8055 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8056 itk=itortyp(itype(k))
8057 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8058 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8059 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8060 call transpose2(EUgC(1,1,k),auxmat(1,1))
8061 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8062 vv1(1)=pizda1(1,1)-pizda1(2,2)
8063 vv1(2)=pizda1(1,2)+pizda1(2,1)
8064 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8065 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8066 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8067 s5=scalar2(vv(1),Dtobr2(1,i))
8068 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8069 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8070 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8071 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8072 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8073 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8074 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8075 & +scalar2(vv(1),Dtobr2der(1,i)))
8076 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8077 vv1(1)=pizda1(1,1)-pizda1(2,2)
8078 vv1(2)=pizda1(1,2)+pizda1(2,1)
8079 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8080 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8082 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8083 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8084 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8085 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8086 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8088 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8089 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8090 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8091 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8092 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8094 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8095 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8096 vv1(1)=pizda1(1,1)-pizda1(2,2)
8097 vv1(2)=pizda1(1,2)+pizda1(2,1)
8098 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8099 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8100 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8101 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8110 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8111 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8112 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8113 call transpose2(EUgC(1,1,k),auxmat(1,1))
8114 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8116 vv1(1)=pizda1(1,1)-pizda1(2,2)
8117 vv1(2)=pizda1(1,2)+pizda1(2,1)
8118 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8119 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8120 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8121 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8122 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8123 s5=scalar2(vv(1),Dtobr2(1,i))
8124 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8130 c----------------------------------------------------------------------------
8131 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8132 implicit real*8 (a-h,o-z)
8133 include 'DIMENSIONS'
8134 include 'COMMON.IOUNITS'
8135 include 'COMMON.CHAIN'
8136 include 'COMMON.DERIV'
8137 include 'COMMON.INTERACT'
8138 include 'COMMON.CONTACTS'
8139 include 'COMMON.TORSION'
8140 include 'COMMON.VAR'
8141 include 'COMMON.GEO'
8143 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8144 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8147 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8149 C Parallel Antiparallel C
8155 C \ j|/k\| \ |/k\|l C
8160 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8161 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8162 C AL 7/4/01 s1 would occur in the sixth-order moment,
8163 C but not in a cluster cumulant
8165 s1=dip(1,jj,i)*dip(1,kk,k)
8167 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8168 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8169 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8170 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8171 call transpose2(EUg(1,1,k),auxmat(1,1))
8172 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8173 vv(1)=pizda(1,1)-pizda(2,2)
8174 vv(2)=pizda(1,2)+pizda(2,1)
8175 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8176 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8178 eello6_graph2=-(s1+s2+s3+s4)
8180 eello6_graph2=-(s2+s3+s4)
8183 C Derivatives in gamma(i-1)
8186 s1=dipderg(1,jj,i)*dip(1,kk,k)
8188 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8189 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8190 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8191 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8193 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8195 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8197 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8199 C Derivatives in gamma(k-1)
8201 s1=dip(1,jj,i)*dipderg(1,kk,k)
8203 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8204 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8205 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8206 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8207 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8208 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8209 vv(1)=pizda(1,1)-pizda(2,2)
8210 vv(2)=pizda(1,2)+pizda(2,1)
8211 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8213 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8215 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8217 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8218 C Derivatives in gamma(j-1) or gamma(l-1)
8221 s1=dipderg(3,jj,i)*dip(1,kk,k)
8223 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8224 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8225 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8226 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8227 vv(1)=pizda(1,1)-pizda(2,2)
8228 vv(2)=pizda(1,2)+pizda(2,1)
8229 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8232 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8234 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8237 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8238 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8240 C Derivatives in gamma(l-1) or gamma(j-1)
8243 s1=dip(1,jj,i)*dipderg(3,kk,k)
8245 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8246 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8247 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8248 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8249 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8250 vv(1)=pizda(1,1)-pizda(2,2)
8251 vv(2)=pizda(1,2)+pizda(2,1)
8252 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8255 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8257 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8260 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8261 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8263 C Cartesian derivatives.
8265 write (2,*) 'In eello6_graph2'
8267 write (2,*) 'iii=',iii
8269 write (2,*) 'kkk=',kkk
8271 write (2,'(3(2f10.5),5x)')
8272 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8282 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8284 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8287 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8289 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8290 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8292 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8293 call transpose2(EUg(1,1,k),auxmat(1,1))
8294 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8296 vv(1)=pizda(1,1)-pizda(2,2)
8297 vv(2)=pizda(1,2)+pizda(2,1)
8298 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8299 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8301 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8303 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8306 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8308 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8315 c----------------------------------------------------------------------------
8316 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8317 implicit real*8 (a-h,o-z)
8318 include 'DIMENSIONS'
8319 include 'COMMON.IOUNITS'
8320 include 'COMMON.CHAIN'
8321 include 'COMMON.DERIV'
8322 include 'COMMON.INTERACT'
8323 include 'COMMON.CONTACTS'
8324 include 'COMMON.TORSION'
8325 include 'COMMON.VAR'
8326 include 'COMMON.GEO'
8327 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8329 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8331 C Parallel Antiparallel C
8337 C j|/k\| / |/k\|l / C
8342 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8344 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8345 C energy moment and not to the cluster cumulant.
8346 iti=itortyp(itype(i))
8347 if (j.lt.nres-1) then
8348 itj1=itortyp(itype(j+1))
8352 itk=itortyp(itype(k))
8353 itk1=itortyp(itype(k+1))
8354 if (l.lt.nres-1) then
8355 itl1=itortyp(itype(l+1))
8360 s1=dip(4,jj,i)*dip(4,kk,k)
8362 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8363 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8364 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8365 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8366 call transpose2(EE(1,1,itk),auxmat(1,1))
8367 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8368 vv(1)=pizda(1,1)+pizda(2,2)
8369 vv(2)=pizda(2,1)-pizda(1,2)
8370 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8371 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8372 cd & "sum",-(s2+s3+s4)
8374 eello6_graph3=-(s1+s2+s3+s4)
8376 eello6_graph3=-(s2+s3+s4)
8379 C Derivatives in gamma(k-1)
8380 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8381 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8382 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8383 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8384 C Derivatives in gamma(l-1)
8385 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8386 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8387 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8388 vv(1)=pizda(1,1)+pizda(2,2)
8389 vv(2)=pizda(2,1)-pizda(1,2)
8390 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8391 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8392 C Cartesian derivatives.
8398 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8400 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8403 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8405 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8406 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8408 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8409 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8411 vv(1)=pizda(1,1)+pizda(2,2)
8412 vv(2)=pizda(2,1)-pizda(1,2)
8413 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8415 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8417 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8420 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8422 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8424 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8430 c----------------------------------------------------------------------------
8431 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8432 implicit real*8 (a-h,o-z)
8433 include 'DIMENSIONS'
8434 include 'COMMON.IOUNITS'
8435 include 'COMMON.CHAIN'
8436 include 'COMMON.DERIV'
8437 include 'COMMON.INTERACT'
8438 include 'COMMON.CONTACTS'
8439 include 'COMMON.TORSION'
8440 include 'COMMON.VAR'
8441 include 'COMMON.GEO'
8442 include 'COMMON.FFIELD'
8443 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8444 & auxvec1(2),auxmat1(2,2)
8446 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8448 C Parallel Antiparallel C
8454 C \ j|/k\| \ |/k\|l C
8459 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8461 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8462 C energy moment and not to the cluster cumulant.
8463 cd write (2,*) 'eello_graph4: wturn6',wturn6
8464 iti=itortyp(itype(i))
8465 itj=itortyp(itype(j))
8466 if (j.lt.nres-1) then
8467 itj1=itortyp(itype(j+1))
8471 itk=itortyp(itype(k))
8472 if (k.lt.nres-1) then
8473 itk1=itortyp(itype(k+1))
8477 itl=itortyp(itype(l))
8478 if (l.lt.nres-1) then
8479 itl1=itortyp(itype(l+1))
8483 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8484 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8485 cd & ' itl',itl,' itl1',itl1
8488 s1=dip(3,jj,i)*dip(3,kk,k)
8490 s1=dip(2,jj,j)*dip(2,kk,l)
8493 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8494 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8496 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8497 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8499 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8500 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8502 call transpose2(EUg(1,1,k),auxmat(1,1))
8503 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8504 vv(1)=pizda(1,1)-pizda(2,2)
8505 vv(2)=pizda(2,1)+pizda(1,2)
8506 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8507 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8509 eello6_graph4=-(s1+s2+s3+s4)
8511 eello6_graph4=-(s2+s3+s4)
8513 C Derivatives in gamma(i-1)
8517 s1=dipderg(2,jj,i)*dip(3,kk,k)
8519 s1=dipderg(4,jj,j)*dip(2,kk,l)
8522 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8524 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8525 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8527 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8528 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8530 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8531 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8532 cd write (2,*) 'turn6 derivatives'
8534 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8536 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8540 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8542 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8546 C Derivatives in gamma(k-1)
8549 s1=dip(3,jj,i)*dipderg(2,kk,k)
8551 s1=dip(2,jj,j)*dipderg(4,kk,l)
8554 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8555 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8557 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8558 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8560 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8561 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8563 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8564 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)-pizda(2,2)
8566 vv(2)=pizda(2,1)+pizda(1,2)
8567 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8568 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8570 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8572 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8576 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8578 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8581 C Derivatives in gamma(j-1) or gamma(l-1)
8582 if (l.eq.j+1 .and. l.gt.1) then
8583 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8584 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8585 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8586 vv(1)=pizda(1,1)-pizda(2,2)
8587 vv(2)=pizda(2,1)+pizda(1,2)
8588 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8589 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8590 else if (j.gt.1) then
8591 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8592 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8593 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8594 vv(1)=pizda(1,1)-pizda(2,2)
8595 vv(2)=pizda(2,1)+pizda(1,2)
8596 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8597 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8598 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8600 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8603 C Cartesian derivatives.
8610 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8612 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8616 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8618 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8622 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8624 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8626 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8627 & b1(1,j+1),auxvec(1))
8628 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8630 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8631 & b1(1,l+1),auxvec(1))
8632 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8634 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8636 vv(1)=pizda(1,1)-pizda(2,2)
8637 vv(2)=pizda(2,1)+pizda(1,2)
8638 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8640 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8642 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8645 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8648 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8651 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8655 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8659 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8661 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8664 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8666 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8674 c----------------------------------------------------------------------------
8675 double precision function eello_turn6(i,jj,kk)
8676 implicit real*8 (a-h,o-z)
8677 include 'DIMENSIONS'
8678 include 'COMMON.IOUNITS'
8679 include 'COMMON.CHAIN'
8680 include 'COMMON.DERIV'
8681 include 'COMMON.INTERACT'
8682 include 'COMMON.CONTACTS'
8683 include 'COMMON.TORSION'
8684 include 'COMMON.VAR'
8685 include 'COMMON.GEO'
8686 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8687 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8689 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8690 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8691 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8692 C the respective energy moment and not to the cluster cumulant.
8701 iti=itortyp(itype(i))
8702 itk=itortyp(itype(k))
8703 itk1=itortyp(itype(k+1))
8704 itl=itortyp(itype(l))
8705 itj=itortyp(itype(j))
8706 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8707 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8708 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8713 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8715 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8719 derx_turn(lll,kkk,iii)=0.0d0
8726 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8728 cd write (2,*) 'eello6_5',eello6_5
8730 call transpose2(AEA(1,1,1),auxmat(1,1))
8731 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8732 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8733 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8735 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8736 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8737 s2 = scalar2(b1(1,k),vtemp1(1))
8739 call transpose2(AEA(1,1,2),atemp(1,1))
8740 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8741 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8742 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8744 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8745 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8746 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8748 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8749 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8750 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8751 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8752 ss13 = scalar2(b1(1,k),vtemp4(1))
8753 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8755 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8761 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8762 C Derivatives in gamma(i+2)
8766 call transpose2(AEA(1,1,1),auxmatd(1,1))
8767 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8768 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8769 call transpose2(AEAderg(1,1,2),atempd(1,1))
8770 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8771 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8773 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8774 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8775 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8781 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8782 C Derivatives in gamma(i+3)
8784 call transpose2(AEA(1,1,1),auxmatd(1,1))
8785 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8786 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8787 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8789 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8790 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8791 s2d = scalar2(b1(1,k),vtemp1d(1))
8793 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8794 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8796 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8798 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8799 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8800 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8808 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8809 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8811 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8812 & -0.5d0*ekont*(s2d+s12d)
8814 C Derivatives in gamma(i+4)
8815 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8816 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8817 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8819 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8820 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8821 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8829 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8831 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8833 C Derivatives in gamma(i+5)
8835 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8836 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8837 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8839 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8840 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8841 s2d = scalar2(b1(1,k),vtemp1d(1))
8843 call transpose2(AEA(1,1,2),atempd(1,1))
8844 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8845 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8847 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8848 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8850 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8851 ss13d = scalar2(b1(1,k),vtemp4d(1))
8852 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8860 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8861 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8863 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8864 & -0.5d0*ekont*(s2d+s12d)
8866 C Cartesian derivatives
8871 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8872 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8873 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8875 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8876 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8878 s2d = scalar2(b1(1,k),vtemp1d(1))
8880 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8881 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8882 s8d = -(atempd(1,1)+atempd(2,2))*
8883 & scalar2(cc(1,1,itl),vtemp2(1))
8885 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8887 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8888 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8895 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8898 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8902 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8903 & - 0.5d0*(s8d+s12d)
8905 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8914 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8916 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8917 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8918 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8919 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8920 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8922 ss13d = scalar2(b1(1,k),vtemp4d(1))
8923 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8924 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8928 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8929 cd & 16*eel_turn6_num
8931 if (j.lt.nres-1) then
8938 if (l.lt.nres-1) then
8946 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8947 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8948 cgrad ghalf=0.5d0*ggg1(ll)
8950 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8951 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8952 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8953 & +ekont*derx_turn(ll,2,1)
8954 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8955 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8956 & +ekont*derx_turn(ll,4,1)
8957 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8958 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8959 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8960 cgrad ghalf=0.5d0*ggg2(ll)
8962 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8963 & +ekont*derx_turn(ll,2,2)
8964 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8965 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8966 & +ekont*derx_turn(ll,4,2)
8967 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8968 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8969 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8974 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8979 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8985 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8990 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8994 cd write (2,*) iii,g_corr6_loc(iii)
8996 eello_turn6=ekont*eel_turn6
8997 cd write (2,*) 'ekont',ekont
8998 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9002 C-----------------------------------------------------------------------------
9003 double precision function scalar(u,v)
9004 !DIR$ INLINEALWAYS scalar
9006 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9009 double precision u(3),v(3)
9010 cd double precision sc
9018 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9021 crc-------------------------------------------------
9022 SUBROUTINE MATVEC2(A1,V1,V2)
9023 !DIR$ INLINEALWAYS MATVEC2
9025 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9027 implicit real*8 (a-h,o-z)
9028 include 'DIMENSIONS'
9029 DIMENSION A1(2,2),V1(2),V2(2)
9033 c 3 VI=VI+A1(I,K)*V1(K)
9037 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9038 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9043 C---------------------------------------
9044 SUBROUTINE MATMAT2(A1,A2,A3)
9046 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9048 implicit real*8 (a-h,o-z)
9049 include 'DIMENSIONS'
9050 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9051 c DIMENSION AI3(2,2)
9055 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9061 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9062 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9063 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9064 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9072 c-------------------------------------------------------------------------
9073 double precision function scalar2(u,v)
9074 !DIR$ INLINEALWAYS scalar2
9076 double precision u(2),v(2)
9079 scalar2=u(1)*v(1)+u(2)*v(2)
9083 C-----------------------------------------------------------------------------
9085 subroutine transpose2(a,at)
9086 !DIR$ INLINEALWAYS transpose2
9088 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9091 double precision a(2,2),at(2,2)
9098 c--------------------------------------------------------------------------
9099 subroutine transpose(n,a,at)
9102 double precision a(n,n),at(n,n)
9110 C---------------------------------------------------------------------------
9111 subroutine prodmat3(a1,a2,kk,transp,prod)
9112 !DIR$ INLINEALWAYS prodmat3
9114 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9118 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9120 crc double precision auxmat(2,2),prod_(2,2)
9123 crc call transpose2(kk(1,1),auxmat(1,1))
9124 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9125 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9127 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9128 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9129 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9130 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9131 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9132 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9133 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9134 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9137 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9138 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9140 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9141 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9142 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9143 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9144 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9145 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9146 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9147 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9150 c call transpose2(a2(1,1),a2t(1,1))
9153 crc print *,((prod_(i,j),i=1,2),j=1,2)
9154 crc print *,((prod(i,j),i=1,2),j=1,2)