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
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
37 if (fg_rank.eq.0) then
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
39 c print *,"Processor",myrank," BROADCAST iorder"
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
41 C FG slaves as WEIGHTS array.
62 C FG Master broadcasts the WEIGHTS_ array
63 call MPI_Bcast(weights_(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
66 C FG slaves receive the WEIGHTS array
67 call MPI_Bcast(weights(1),n_ene,
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
92 c call chainbuild_cart
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
98 c call int_from_cart1(.false.)
109 C Compute the side-chain and electrostatic interaction energy
111 goto (101,102,103,104,105,106) ipot
112 C Lennard-Jones potential.
113 101 call elj(evdw,evdw_p,evdw_m)
114 cd print '(a)','Exit ELJ'
116 C Lennard-Jones-Kihara potential (shifted).
117 102 call eljk(evdw,evdw_p,evdw_m)
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
120 103 call ebp(evdw,evdw_p,evdw_m)
122 C Gay-Berne potential (shifted LJ, angular dependence).
123 104 call egb(evdw,evdw_p,evdw_m)
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
126 105 call egbv(evdw,evdw_p,evdw_m)
128 C Soft-sphere potential
129 106 call e_softsphere(evdw)
131 C Calculate electrostatic (H-bonding) energy of the main chain.
134 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 time_vec=time_vec+tcpu()-time01
150 c print *,"Processor",myrank," left VEC_AND_DERIV"
153 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
154 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
155 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
156 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
158 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
159 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
160 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
161 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
163 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
172 c write (iout,*) "Soft-spheer ELEC potential"
173 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
176 c print *,"Processor",myrank," computed UELEC"
178 C Calculate excluded-volume interaction energy between peptide groups
183 call escp(evdw2,evdw2_14)
189 c write (iout,*) "Soft-sphere SCP potential"
190 call escp_soft_sphere(evdw2,evdw2_14)
193 c Calculate the bond-stretching energy
197 C Calculate the disulfide-bridge and other energy and the contributions
198 C from other distance constraints.
199 cd print *,'Calling EHPB'
201 cd print *,'EHPB exitted succesfully.'
203 C Calculate the virtual-bond-angle energy.
205 if (wang.gt.0d0) then
210 c print *,"Processor",myrank," computed UB"
212 C Calculate the SC local energy.
215 c print *,"Processor",myrank," computed USC"
217 C Calculate the virtual-bond torsional energy.
219 cd print *,'nterm=',nterm
221 call etor(etors,edihcnstr)
226 c print *,"Processor",myrank," computed Utor"
228 C 6/23/01 Calculate double-torsional energy
230 if (wtor_d.gt.0) then
235 c print *,"Processor",myrank," computed Utord"
237 C 21/5/07 Calculate local sicdechain correlation energy
239 if (wsccor.gt.0.0d0) then
240 call eback_sc_corr(esccor)
244 c print *,"Processor",myrank," computed Usccorr"
246 C 12/1/95 Multi-body terms
250 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
251 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
252 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
253 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
254 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
261 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
262 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
263 cd write (iout,*) "multibody_hb ecorr",ecorr
265 c print *,"Processor",myrank," computed Ucorr"
267 C If performing constraint dynamics, call the constraint energy
268 C after the equilibration time
269 if(usampl.and.totT.gt.eq_time) then
278 time_enecalc=time_enecalc+MPI_Wtime()-time00
280 time_enecalc=time_enecalc+tcpu()-time00
283 c print *,"Processor",myrank," computed Uconstr"
296 energia(2)=evdw2-evdw2_14
313 energia(8)=eello_turn3
314 energia(9)=eello_turn4
321 energia(19)=edihcnstr
323 energia(20)=Uconst+Uconst_back
327 c print *," Processor",myrank," calls SUM_ENERGY"
328 call sum_energy(energia,.true.)
329 c print *," Processor",myrank," left SUM_ENERGY"
332 time_sumene=time_sumene+MPI_Wtime()-time00
334 time_sumene=time_sumene+tcpu()-time00
339 c-------------------------------------------------------------------------------
340 subroutine sum_energy(energia,reduce)
341 implicit real*8 (a-h,o-z)
346 cMS$ATTRIBUTES C :: proc_proc
352 include 'COMMON.SETUP'
353 include 'COMMON.IOUNITS'
354 double precision energia(0:n_ene),enebuff(0:n_ene+1)
355 include 'COMMON.FFIELD'
356 include 'COMMON.DERIV'
357 include 'COMMON.INTERACT'
358 include 'COMMON.SBRIDGE'
359 include 'COMMON.CHAIN'
361 include 'COMMON.CONTROL'
362 include 'COMMON.TIME1'
365 if (nfgtasks.gt.1 .and. reduce) then
367 write (iout,*) "energies before REDUCE"
368 call enerprint(energia)
372 enebuff(i)=energia(i)
375 call MPI_Barrier(FG_COMM,IERR)
376 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
378 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
379 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
381 write (iout,*) "energies after REDUCE"
382 call enerprint(energia)
385 time_Reduce=time_Reduce+MPI_Wtime()-time00
387 if (fg_rank.eq.0) then
390 evdw=energia(22)+wsct*energia(23)
395 evdw2=energia(2)+energia(18)
411 eello_turn3=energia(8)
412 eello_turn4=energia(9)
419 edihcnstr=energia(19)
424 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
425 & +wang*ebe+wtor*etors+wscloc*escloc
426 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
427 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
428 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
429 & +wbond*estr+Uconst+wsccor*esccor
431 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
432 & +wang*ebe+wtor*etors+wscloc*escloc
433 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
434 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
435 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
436 & +wbond*estr+Uconst+wsccor*esccor
442 if (isnan(etot).ne.0) energia(0)=1.0d+99
444 if (isnan(etot)) energia(0)=1.0d+99
449 idumm=proc_proc(etot,i)
451 call proc_proc(etot,i)
453 if(i.eq.1)energia(0)=1.0d+99
460 c-------------------------------------------------------------------------------
461 subroutine sum_gradient
462 implicit real*8 (a-h,o-z)
467 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
475 include 'COMMON.SETUP'
476 include 'COMMON.IOUNITS'
477 include 'COMMON.FFIELD'
478 include 'COMMON.DERIV'
479 include 'COMMON.INTERACT'
480 include 'COMMON.SBRIDGE'
481 include 'COMMON.CHAIN'
483 include 'COMMON.CONTROL'
484 include 'COMMON.TIME1'
485 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
502 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
503 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
504 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
507 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
508 C in virtual-bond-vector coordinates
511 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
513 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
514 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
516 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
518 c write (iout,'(i5,3f10.5,2x,f10.5)')
519 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
521 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
523 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
524 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
532 gradbufc(j,i)=wsc*gvdwc(j,i)+
533 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
534 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
535 & wel_loc*gel_loc_long(j,i)+
536 & wcorr*gradcorr_long(j,i)+
537 & wcorr5*gradcorr5_long(j,i)+
538 & wcorr6*gradcorr6_long(j,i)+
539 & wturn6*gcorr6_turn_long(j,i)+
546 gradbufc(j,i)=wsc*gvdwc(j,i)+
547 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
548 & welec*gelc_long(j,i)+
550 & wel_loc*gel_loc_long(j,i)+
551 & wcorr*gradcorr_long(j,i)+
552 & wcorr5*gradcorr5_long(j,i)+
553 & wcorr6*gradcorr6_long(j,i)+
554 & wturn6*gcorr6_turn_long(j,i)+
560 if (nfgtasks.gt.1) then
563 write (iout,*) "gradbufc before allreduce"
565 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
571 gradbufc_sum(j,i)=gradbufc(j,i)
575 c time_allreduce=time_allreduce+MPI_Wtime()-time00
583 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
584 write (iout,*) (i," jgrad_start",jgrad_start(i),
585 & " jgrad_end ",jgrad_end(i),
586 & i=igrad_start,igrad_end)
589 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
593 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
597 write (iout,*) "gradbufc after summing"
599 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
606 write (iout,*) "gradbufc"
608 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
614 gradbufc_sum(j,i)=gradbufc(j,i)
619 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
623 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
627 write (iout,*) "gradbufc after summing"
629 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
637 gradbufc(k,nres)=0.0d0
642 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
643 & wel_loc*gel_loc(j,i)+
644 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
645 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
646 & wel_loc*gel_loc_long(j,i)+
647 & wcorr*gradcorr_long(j,i)+
648 & wcorr5*gradcorr5_long(j,i)+
649 & wcorr6*gradcorr6_long(j,i)+
650 & wturn6*gcorr6_turn_long(j,i))+
652 & wcorr*gradcorr(j,i)+
653 & wturn3*gcorr3_turn(j,i)+
654 & wturn4*gcorr4_turn(j,i)+
655 & wcorr5*gradcorr5(j,i)+
656 & wcorr6*gradcorr6(j,i)+
657 & wturn6*gcorr6_turn(j,i)+
658 & wsccor*gsccorc(j,i)
659 & +wscloc*gscloc(j,i)
661 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
662 & wel_loc*gel_loc(j,i)+
663 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
664 & welec*gelc_long(j,i)
665 & wel_loc*gel_loc_long(j,i)+
666 & wcorr*gcorr_long(j,i)+
667 & wcorr5*gradcorr5_long(j,i)+
668 & wcorr6*gradcorr6_long(j,i)+
669 & wturn6*gcorr6_turn_long(j,i))+
671 & wcorr*gradcorr(j,i)+
672 & wturn3*gcorr3_turn(j,i)+
673 & wturn4*gcorr4_turn(j,i)+
674 & wcorr5*gradcorr5(j,i)+
675 & wcorr6*gradcorr6(j,i)+
676 & wturn6*gcorr6_turn(j,i)+
677 & wsccor*gsccorc(j,i)
678 & +wscloc*gscloc(j,i)
680 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
682 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
683 & wsccor*gsccorx(j,i)
684 & +wscloc*gsclocx(j,i)
688 write (iout,*) "gloc before adding corr"
690 write (iout,*) i,gloc(i,icg)
694 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
695 & +wcorr5*g_corr5_loc(i)
696 & +wcorr6*g_corr6_loc(i)
697 & +wturn4*gel_loc_turn4(i)
698 & +wturn3*gel_loc_turn3(i)
699 & +wturn6*gel_loc_turn6(i)
700 & +wel_loc*gel_loc_loc(i)
701 & +wsccor*gsccor_loc(i)
704 write (iout,*) "gloc after adding corr"
706 write (iout,*) i,gloc(i,icg)
710 if (nfgtasks.gt.1) then
713 gradbufc(j,i)=gradc(j,i,icg)
714 gradbufx(j,i)=gradx(j,i,icg)
718 glocbuf(i)=gloc(i,icg)
721 call MPI_Barrier(FG_COMM,IERR)
722 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
724 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
725 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
726 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
727 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
728 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
729 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
730 time_reduce=time_reduce+MPI_Wtime()-time00
732 write (iout,*) "gloc after reduce"
734 write (iout,*) i,gloc(i,icg)
739 if (gnorm_check) then
741 c Compute the maximum elements of the gradient
751 gcorr3_turn_max=0.0d0
752 gcorr4_turn_max=0.0d0
755 gcorr6_turn_max=0.0d0
765 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
766 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
767 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
768 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
769 & gvdwc_scp_max=gvdwc_scp_norm
770 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
771 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
772 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
773 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
774 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
775 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
776 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
777 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
778 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
779 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
780 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
781 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
782 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
784 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
785 & gcorr3_turn_max=gcorr3_turn_norm
786 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
788 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
789 & gcorr4_turn_max=gcorr4_turn_norm
790 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
791 if (gradcorr5_norm.gt.gradcorr5_max)
792 & gradcorr5_max=gradcorr5_norm
793 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
794 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
795 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
797 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
798 & gcorr6_turn_max=gcorr6_turn_norm
799 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
800 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
801 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
802 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
803 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
804 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
805 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
806 if (gradx_scp_norm.gt.gradx_scp_max)
807 & gradx_scp_max=gradx_scp_norm
808 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
809 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
810 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
811 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
812 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
813 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
814 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
815 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
819 open(istat,file=statname,position="append")
821 open(istat,file=statname,access="append")
823 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
824 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
825 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
826 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
827 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
828 & gsccorx_max,gsclocx_max
830 if (gvdwc_max.gt.1.0d4) then
831 write (iout,*) "gvdwc gvdwx gradb gradbx"
833 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
834 & gradb(j,i),gradbx(j,i),j=1,3)
836 call pdbout(0.0d0,'cipiszcze',iout)
842 write (iout,*) "gradc gradx gloc"
844 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
845 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
850 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
852 time_sumgradient=time_sumgradient+tcpu()-time01
857 c-------------------------------------------------------------------------------
858 subroutine rescale_weights(t_bath)
859 implicit real*8 (a-h,o-z)
861 include 'COMMON.IOUNITS'
862 include 'COMMON.FFIELD'
863 include 'COMMON.SBRIDGE'
864 double precision kfac /2.4d0/
865 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
867 c facT=2*temp0/(t_bath+temp0)
868 if (rescale_mode.eq.0) then
874 else if (rescale_mode.eq.1) then
875 facT=kfac/(kfac-1.0d0+t_bath/temp0)
876 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
877 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
878 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
879 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
880 else if (rescale_mode.eq.2) then
886 facT=licznik/dlog(dexp(x)+dexp(-x))
887 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
888 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
889 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
890 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
892 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
893 write (*,*) "Wrong RESCALE_MODE",rescale_mode
895 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
899 welec=weights(3)*fact
900 wcorr=weights(4)*fact3
901 wcorr5=weights(5)*fact4
902 wcorr6=weights(6)*fact5
903 wel_loc=weights(7)*fact2
904 wturn3=weights(8)*fact2
905 wturn4=weights(9)*fact3
906 wturn6=weights(10)*fact5
907 wtor=weights(13)*fact
908 wtor_d=weights(14)*fact2
909 wsccor=weights(21)*fact
912 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
916 C------------------------------------------------------------------------
917 subroutine enerprint(energia)
918 implicit real*8 (a-h,o-z)
920 include 'COMMON.IOUNITS'
921 include 'COMMON.FFIELD'
922 include 'COMMON.SBRIDGE'
924 double precision energia(0:n_ene)
927 evdw=energia(22)+wsct*energia(23)
933 evdw2=energia(2)+energia(18)
945 eello_turn3=energia(8)
946 eello_turn4=energia(9)
947 eello_turn6=energia(10)
953 edihcnstr=energia(19)
958 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
959 & estr,wbond,ebe,wang,
960 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
962 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
963 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
966 10 format (/'Virtual-chain energies:'//
967 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
968 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
969 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
970 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
971 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
972 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
973 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
974 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
975 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
976 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
977 & ' (SS bridges & dist. cnstr.)'/
978 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
979 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
980 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
981 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
982 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
983 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
984 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
985 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
986 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
987 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
988 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
989 & 'ETOT= ',1pE16.6,' (total)')
991 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
992 & estr,wbond,ebe,wang,
993 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
995 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
996 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
997 & ebr*nss,Uconst,etot
998 10 format (/'Virtual-chain energies:'//
999 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1000 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1001 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1002 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1003 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1004 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1005 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1006 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1007 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1008 & ' (SS bridges & dist. cnstr.)'/
1009 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1010 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1011 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1012 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1013 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1014 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1015 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1016 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1017 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1018 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1019 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1020 & 'ETOT= ',1pE16.6,' (total)')
1024 C-----------------------------------------------------------------------
1025 subroutine elj(evdw,evdw_p,evdw_m)
1027 C This subroutine calculates the interaction energy of nonbonded side chains
1028 C assuming the LJ potential of interaction.
1030 implicit real*8 (a-h,o-z)
1031 include 'DIMENSIONS'
1032 parameter (accur=1.0d-10)
1033 include 'COMMON.GEO'
1034 include 'COMMON.VAR'
1035 include 'COMMON.LOCAL'
1036 include 'COMMON.CHAIN'
1037 include 'COMMON.DERIV'
1038 include 'COMMON.INTERACT'
1039 include 'COMMON.TORSION'
1040 include 'COMMON.SBRIDGE'
1041 include 'COMMON.NAMES'
1042 include 'COMMON.IOUNITS'
1043 include 'COMMON.CONTACTS'
1045 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1047 do i=iatsc_s,iatsc_e
1056 C Calculate SC interaction energy.
1058 do iint=1,nint_gr(i)
1059 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1060 cd & 'iend=',iend(i,iint)
1061 do j=istart(i,iint),iend(i,iint)
1066 C Change 12/1/95 to calculate four-body interactions
1067 rij=xj*xj+yj*yj+zj*zj
1069 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1070 eps0ij=eps(itypi,itypj)
1072 e1=fac*fac*aa(itypi,itypj)
1073 e2=fac*bb(itypi,itypj)
1075 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1076 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1077 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1078 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1079 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1080 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1082 if (bb(itypi,itypj).gt.0) then
1083 evdw_p=evdw_p+evdwij
1085 evdw_m=evdw_m+evdwij
1091 C Calculate the components of the gradient in DC and X
1093 fac=-rrij*(e1+evdwij)
1098 if (bb(itypi,itypj).gt.0.0d0) then
1100 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1101 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1102 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1103 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1107 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1108 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1109 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1110 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1115 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1116 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1117 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1118 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1123 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1127 C 12/1/95, revised on 5/20/97
1129 C Calculate the contact function. The ith column of the array JCONT will
1130 C contain the numbers of atoms that make contacts with the atom I (of numbers
1131 C greater than I). The arrays FACONT and GACONT will contain the values of
1132 C the contact function and its derivative.
1134 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1135 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1136 C Uncomment next line, if the correlation interactions are contact function only
1137 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1139 sigij=sigma(itypi,itypj)
1140 r0ij=rs0(itypi,itypj)
1142 C Check whether the SC's are not too far to make a contact.
1145 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1146 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1148 if (fcont.gt.0.0D0) then
1149 C If the SC-SC distance if close to sigma, apply spline.
1150 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1151 cAdam & fcont1,fprimcont1)
1152 cAdam fcont1=1.0d0-fcont1
1153 cAdam if (fcont1.gt.0.0d0) then
1154 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1155 cAdam fcont=fcont*fcont1
1157 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1158 cga eps0ij=1.0d0/dsqrt(eps0ij)
1160 cga gg(k)=gg(k)*eps0ij
1162 cga eps0ij=-evdwij*eps0ij
1163 C Uncomment for AL's type of SC correlation interactions.
1164 cadam eps0ij=-evdwij
1165 num_conti=num_conti+1
1166 jcont(num_conti,i)=j
1167 facont(num_conti,i)=fcont*eps0ij
1168 fprimcont=eps0ij*fprimcont/rij
1170 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1171 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1172 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1173 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1174 gacont(1,num_conti,i)=-fprimcont*xj
1175 gacont(2,num_conti,i)=-fprimcont*yj
1176 gacont(3,num_conti,i)=-fprimcont*zj
1177 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1178 cd write (iout,'(2i3,3f10.5)')
1179 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1185 num_cont(i)=num_conti
1189 gvdwc(j,i)=expon*gvdwc(j,i)
1190 gvdwx(j,i)=expon*gvdwx(j,i)
1193 C******************************************************************************
1197 C To save time, the factor of EXPON has been extracted from ALL components
1198 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1201 C******************************************************************************
1204 C-----------------------------------------------------------------------------
1205 subroutine eljk(evdw,evdw_p,evdw_m)
1207 C This subroutine calculates the interaction energy of nonbonded side chains
1208 C assuming the LJK potential of interaction.
1210 implicit real*8 (a-h,o-z)
1211 include 'DIMENSIONS'
1212 include 'COMMON.GEO'
1213 include 'COMMON.VAR'
1214 include 'COMMON.LOCAL'
1215 include 'COMMON.CHAIN'
1216 include 'COMMON.DERIV'
1217 include 'COMMON.INTERACT'
1218 include 'COMMON.IOUNITS'
1219 include 'COMMON.NAMES'
1222 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1224 do i=iatsc_s,iatsc_e
1231 C Calculate SC interaction energy.
1233 do iint=1,nint_gr(i)
1234 do j=istart(i,iint),iend(i,iint)
1239 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1240 fac_augm=rrij**expon
1241 e_augm=augm(itypi,itypj)*fac_augm
1242 r_inv_ij=dsqrt(rrij)
1244 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1245 fac=r_shift_inv**expon
1246 e1=fac*fac*aa(itypi,itypj)
1247 e2=fac*bb(itypi,itypj)
1249 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1250 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1251 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1252 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1253 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1254 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1255 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1257 if (bb(itypi,itypj).gt.0) then
1258 evdw_p=evdw_p+evdwij
1260 evdw_m=evdw_m+evdwij
1266 C Calculate the components of the gradient in DC and X
1268 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1273 if (bb(itypi,itypj).gt.0.0d0) then
1275 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1276 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1277 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1278 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1282 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1283 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1284 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1285 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1290 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1291 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1292 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1293 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1298 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1306 gvdwc(j,i)=expon*gvdwc(j,i)
1307 gvdwx(j,i)=expon*gvdwx(j,i)
1312 C-----------------------------------------------------------------------------
1313 subroutine ebp(evdw,evdw_p,evdw_m)
1315 C This subroutine calculates the interaction energy of nonbonded side chains
1316 C assuming the Berne-Pechukas potential of interaction.
1318 implicit real*8 (a-h,o-z)
1319 include 'DIMENSIONS'
1320 include 'COMMON.GEO'
1321 include 'COMMON.VAR'
1322 include 'COMMON.LOCAL'
1323 include 'COMMON.CHAIN'
1324 include 'COMMON.DERIV'
1325 include 'COMMON.NAMES'
1326 include 'COMMON.INTERACT'
1327 include 'COMMON.IOUNITS'
1328 include 'COMMON.CALC'
1329 common /srutu/ icall
1330 c double precision rrsave(maxdim)
1333 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1335 c if (icall.eq.0) then
1341 do i=iatsc_s,iatsc_e
1347 dxi=dc_norm(1,nres+i)
1348 dyi=dc_norm(2,nres+i)
1349 dzi=dc_norm(3,nres+i)
1350 c dsci_inv=dsc_inv(itypi)
1351 dsci_inv=vbld_inv(i+nres)
1353 C Calculate SC interaction energy.
1355 do iint=1,nint_gr(i)
1356 do j=istart(i,iint),iend(i,iint)
1359 c dscj_inv=dsc_inv(itypj)
1360 dscj_inv=vbld_inv(j+nres)
1361 chi1=chi(itypi,itypj)
1362 chi2=chi(itypj,itypi)
1369 alf12=0.5D0*(alf1+alf2)
1370 C For diagnostics only!!!
1383 dxj=dc_norm(1,nres+j)
1384 dyj=dc_norm(2,nres+j)
1385 dzj=dc_norm(3,nres+j)
1386 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1387 cd if (icall.eq.0) then
1393 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1395 C Calculate whole angle-dependent part of epsilon and contributions
1396 C to its derivatives
1397 fac=(rrij*sigsq)**expon2
1398 e1=fac*fac*aa(itypi,itypj)
1399 e2=fac*bb(itypi,itypj)
1400 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1401 eps2der=evdwij*eps3rt
1402 eps3der=evdwij*eps2rt
1403 evdwij=evdwij*eps2rt*eps3rt
1405 if (bb(itypi,itypj).gt.0) then
1406 evdw_p=evdw_p+evdwij
1408 evdw_m=evdw_m+evdwij
1414 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1415 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1416 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1417 cd & restyp(itypi),i,restyp(itypj),j,
1418 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1419 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1420 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1423 C Calculate gradient components.
1424 e1=e1*eps1*eps2rt**2*eps3rt**2
1425 fac=-expon*(e1+evdwij)
1428 C Calculate radial part of the gradient
1432 C Calculate the angular part of the gradient and sum add the contributions
1433 C to the appropriate components of the Cartesian gradient.
1435 if (bb(itypi,itypj).gt.0) then
1449 C-----------------------------------------------------------------------------
1450 subroutine egb(evdw,evdw_p,evdw_m)
1452 C This subroutine calculates the interaction energy of nonbonded side chains
1453 C assuming the Gay-Berne potential of interaction.
1455 implicit real*8 (a-h,o-z)
1456 include 'DIMENSIONS'
1457 include 'COMMON.GEO'
1458 include 'COMMON.VAR'
1459 include 'COMMON.LOCAL'
1460 include 'COMMON.CHAIN'
1461 include 'COMMON.DERIV'
1462 include 'COMMON.NAMES'
1463 include 'COMMON.INTERACT'
1464 include 'COMMON.IOUNITS'
1465 include 'COMMON.CALC'
1466 include 'COMMON.CONTROL'
1469 ccccc energy_dec=.false.
1470 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1475 c if (icall.eq.0) lprn=.false.
1477 do i=iatsc_s,iatsc_e
1483 dxi=dc_norm(1,nres+i)
1484 dyi=dc_norm(2,nres+i)
1485 dzi=dc_norm(3,nres+i)
1486 c dsci_inv=dsc_inv(itypi)
1487 dsci_inv=vbld_inv(i+nres)
1488 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1489 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1491 C Calculate SC interaction energy.
1493 do iint=1,nint_gr(i)
1494 do j=istart(i,iint),iend(i,iint)
1497 c dscj_inv=dsc_inv(itypj)
1498 dscj_inv=vbld_inv(j+nres)
1499 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1500 c & 1.0d0/vbld(j+nres)
1501 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1502 sig0ij=sigma(itypi,itypj)
1503 chi1=chi(itypi,itypj)
1504 chi2=chi(itypj,itypi)
1511 alf12=0.5D0*(alf1+alf2)
1512 C For diagnostics only!!!
1525 dxj=dc_norm(1,nres+j)
1526 dyj=dc_norm(2,nres+j)
1527 dzj=dc_norm(3,nres+j)
1528 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1529 c write (iout,*) "j",j," dc_norm",
1530 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1531 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1533 C Calculate angle-dependent terms of energy and contributions to their
1537 sig=sig0ij*dsqrt(sigsq)
1538 rij_shift=1.0D0/rij-sig+sig0ij
1539 c for diagnostics; uncomment
1540 c rij_shift=1.2*sig0ij
1541 C I hate to put IF's in the loops, but here don't have another choice!!!!
1542 if (rij_shift.le.0.0D0) then
1544 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1545 cd & restyp(itypi),i,restyp(itypj),j,
1546 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1550 c---------------------------------------------------------------
1551 rij_shift=1.0D0/rij_shift
1552 fac=rij_shift**expon
1553 e1=fac*fac*aa(itypi,itypj)
1554 e2=fac*bb(itypi,itypj)
1555 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1556 eps2der=evdwij*eps3rt
1557 eps3der=evdwij*eps2rt
1558 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1559 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1560 evdwij=evdwij*eps2rt*eps3rt
1562 if (bb(itypi,itypj).gt.0) then
1563 evdw_p=evdw_p+evdwij
1565 evdw_m=evdw_m+evdwij
1571 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1572 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1573 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1574 & restyp(itypi),i,restyp(itypj),j,
1575 & epsi,sigm,chi1,chi2,chip1,chip2,
1576 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1577 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1581 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1584 C Calculate gradient components.
1585 e1=e1*eps1*eps2rt**2*eps3rt**2
1586 fac=-expon*(e1+evdwij)*rij_shift
1590 C Calculate the radial part of the gradient
1594 C Calculate angular part of the gradient.
1596 if (bb(itypi,itypj).gt.0) then
1607 c write (iout,*) "Number of loop steps in EGB:",ind
1608 cccc energy_dec=.false.
1611 C-----------------------------------------------------------------------------
1612 subroutine egbv(evdw,evdw_p,evdw_m)
1614 C This subroutine calculates the interaction energy of nonbonded side chains
1615 C assuming the Gay-Berne-Vorobjev potential of interaction.
1617 implicit real*8 (a-h,o-z)
1618 include 'DIMENSIONS'
1619 include 'COMMON.GEO'
1620 include 'COMMON.VAR'
1621 include 'COMMON.LOCAL'
1622 include 'COMMON.CHAIN'
1623 include 'COMMON.DERIV'
1624 include 'COMMON.NAMES'
1625 include 'COMMON.INTERACT'
1626 include 'COMMON.IOUNITS'
1627 include 'COMMON.CALC'
1628 common /srutu/ icall
1631 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1634 c if (icall.eq.0) lprn=.true.
1636 do i=iatsc_s,iatsc_e
1642 dxi=dc_norm(1,nres+i)
1643 dyi=dc_norm(2,nres+i)
1644 dzi=dc_norm(3,nres+i)
1645 c dsci_inv=dsc_inv(itypi)
1646 dsci_inv=vbld_inv(i+nres)
1648 C Calculate SC interaction energy.
1650 do iint=1,nint_gr(i)
1651 do j=istart(i,iint),iend(i,iint)
1654 c dscj_inv=dsc_inv(itypj)
1655 dscj_inv=vbld_inv(j+nres)
1656 sig0ij=sigma(itypi,itypj)
1657 r0ij=r0(itypi,itypj)
1658 chi1=chi(itypi,itypj)
1659 chi2=chi(itypj,itypi)
1666 alf12=0.5D0*(alf1+alf2)
1667 C For diagnostics only!!!
1680 dxj=dc_norm(1,nres+j)
1681 dyj=dc_norm(2,nres+j)
1682 dzj=dc_norm(3,nres+j)
1683 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1685 C Calculate angle-dependent terms of energy and contributions to their
1689 sig=sig0ij*dsqrt(sigsq)
1690 rij_shift=1.0D0/rij-sig+r0ij
1691 C I hate to put IF's in the loops, but here don't have another choice!!!!
1692 if (rij_shift.le.0.0D0) then
1697 c---------------------------------------------------------------
1698 rij_shift=1.0D0/rij_shift
1699 fac=rij_shift**expon
1700 e1=fac*fac*aa(itypi,itypj)
1701 e2=fac*bb(itypi,itypj)
1702 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1703 eps2der=evdwij*eps3rt
1704 eps3der=evdwij*eps2rt
1705 fac_augm=rrij**expon
1706 e_augm=augm(itypi,itypj)*fac_augm
1707 evdwij=evdwij*eps2rt*eps3rt
1709 if (bb(itypi,itypj).gt.0) then
1710 evdw_p=evdw_p+evdwij+e_augm
1712 evdw_m=evdw_m+evdwij+e_augm
1715 evdw=evdw+evdwij+e_augm
1718 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1719 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1720 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1721 & restyp(itypi),i,restyp(itypj),j,
1722 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1723 & chi1,chi2,chip1,chip2,
1724 & eps1,eps2rt**2,eps3rt**2,
1725 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1728 C Calculate gradient components.
1729 e1=e1*eps1*eps2rt**2*eps3rt**2
1730 fac=-expon*(e1+evdwij)*rij_shift
1732 fac=rij*fac-2*expon*rrij*e_augm
1733 C Calculate the radial part of the gradient
1737 C Calculate angular part of the gradient.
1739 if (bb(itypi,itypj).gt.0) then
1751 C-----------------------------------------------------------------------------
1752 subroutine sc_angular
1753 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1754 C om12. Called by ebp, egb, and egbv.
1756 include 'COMMON.CALC'
1757 include 'COMMON.IOUNITS'
1761 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1762 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1763 om12=dxi*dxj+dyi*dyj+dzi*dzj
1765 C Calculate eps1(om12) and its derivative in om12
1766 faceps1=1.0D0-om12*chiom12
1767 faceps1_inv=1.0D0/faceps1
1768 eps1=dsqrt(faceps1_inv)
1769 C Following variable is eps1*deps1/dom12
1770 eps1_om12=faceps1_inv*chiom12
1775 c write (iout,*) "om12",om12," eps1",eps1
1776 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1781 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1782 sigsq=1.0D0-facsig*faceps1_inv
1783 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1784 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1785 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1791 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1792 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1794 C Calculate eps2 and its derivatives in om1, om2, and om12.
1797 chipom12=chip12*om12
1798 facp=1.0D0-om12*chipom12
1800 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1801 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1802 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1803 C Following variable is the square root of eps2
1804 eps2rt=1.0D0-facp1*facp_inv
1805 C Following three variables are the derivatives of the square root of eps
1806 C in om1, om2, and om12.
1807 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1808 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1809 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1810 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1811 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1812 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1813 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1814 c & " eps2rt_om12",eps2rt_om12
1815 C Calculate whole angle-dependent part of epsilon and contributions
1816 C to its derivatives
1820 C----------------------------------------------------------------------------
1821 subroutine sc_grad_T
1822 implicit real*8 (a-h,o-z)
1823 include 'DIMENSIONS'
1824 include 'COMMON.CHAIN'
1825 include 'COMMON.DERIV'
1826 include 'COMMON.CALC'
1827 include 'COMMON.IOUNITS'
1828 double precision dcosom1(3),dcosom2(3)
1829 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1830 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1831 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1832 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1836 c eom12=evdwij*eps1_om12
1838 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1839 c & " sigder",sigder
1840 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1841 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1843 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1844 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1847 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1849 c write (iout,*) "gg",(gg(k),k=1,3)
1851 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1852 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1853 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1854 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1855 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1856 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1857 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1858 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1859 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1860 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1863 C Calculate the components of the gradient in DC and X
1867 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1871 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1872 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1877 C----------------------------------------------------------------------------
1879 implicit real*8 (a-h,o-z)
1880 include 'DIMENSIONS'
1881 include 'COMMON.CHAIN'
1882 include 'COMMON.DERIV'
1883 include 'COMMON.CALC'
1884 include 'COMMON.IOUNITS'
1885 double precision dcosom1(3),dcosom2(3)
1886 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1887 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1888 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1889 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1893 c eom12=evdwij*eps1_om12
1895 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1896 c & " sigder",sigder
1897 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1898 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1900 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1901 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1904 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1906 c write (iout,*) "gg",(gg(k),k=1,3)
1908 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1909 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1910 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1911 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1912 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1913 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1914 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1915 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1916 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1917 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1920 C Calculate the components of the gradient in DC and X
1924 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1928 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1929 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1933 C-----------------------------------------------------------------------
1934 subroutine e_softsphere(evdw)
1936 C This subroutine calculates the interaction energy of nonbonded side chains
1937 C assuming the LJ potential of interaction.
1939 implicit real*8 (a-h,o-z)
1940 include 'DIMENSIONS'
1941 parameter (accur=1.0d-10)
1942 include 'COMMON.GEO'
1943 include 'COMMON.VAR'
1944 include 'COMMON.LOCAL'
1945 include 'COMMON.CHAIN'
1946 include 'COMMON.DERIV'
1947 include 'COMMON.INTERACT'
1948 include 'COMMON.TORSION'
1949 include 'COMMON.SBRIDGE'
1950 include 'COMMON.NAMES'
1951 include 'COMMON.IOUNITS'
1952 include 'COMMON.CONTACTS'
1954 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1956 do i=iatsc_s,iatsc_e
1963 C Calculate SC interaction energy.
1965 do iint=1,nint_gr(i)
1966 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1967 cd & 'iend=',iend(i,iint)
1968 do j=istart(i,iint),iend(i,iint)
1973 rij=xj*xj+yj*yj+zj*zj
1974 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1975 r0ij=r0(itypi,itypj)
1977 c print *,i,j,r0ij,dsqrt(rij)
1978 if (rij.lt.r0ijsq) then
1979 evdwij=0.25d0*(rij-r0ijsq)**2
1987 C Calculate the components of the gradient in DC and X
1993 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1994 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1995 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1996 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2000 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2008 C--------------------------------------------------------------------------
2009 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2012 C Soft-sphere potential of p-p interaction
2014 implicit real*8 (a-h,o-z)
2015 include 'DIMENSIONS'
2016 include 'COMMON.CONTROL'
2017 include 'COMMON.IOUNITS'
2018 include 'COMMON.GEO'
2019 include 'COMMON.VAR'
2020 include 'COMMON.LOCAL'
2021 include 'COMMON.CHAIN'
2022 include 'COMMON.DERIV'
2023 include 'COMMON.INTERACT'
2024 include 'COMMON.CONTACTS'
2025 include 'COMMON.TORSION'
2026 include 'COMMON.VECTORS'
2027 include 'COMMON.FFIELD'
2029 cd write(iout,*) 'In EELEC_soft_sphere'
2036 do i=iatel_s,iatel_e
2040 xmedi=c(1,i)+0.5d0*dxi
2041 ymedi=c(2,i)+0.5d0*dyi
2042 zmedi=c(3,i)+0.5d0*dzi
2044 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2045 do j=ielstart(i),ielend(i)
2049 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2050 r0ij=rpp(iteli,itelj)
2055 xj=c(1,j)+0.5D0*dxj-xmedi
2056 yj=c(2,j)+0.5D0*dyj-ymedi
2057 zj=c(3,j)+0.5D0*dzj-zmedi
2058 rij=xj*xj+yj*yj+zj*zj
2059 if (rij.lt.r0ijsq) then
2060 evdw1ij=0.25d0*(rij-r0ijsq)**2
2068 C Calculate contributions to the Cartesian gradient.
2074 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2075 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2078 * Loop over residues i+1 thru j-1.
2082 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2087 cgrad do i=nnt,nct-1
2089 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2091 cgrad do j=i+1,nct-1
2093 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2099 c------------------------------------------------------------------------------
2100 subroutine vec_and_deriv
2101 implicit real*8 (a-h,o-z)
2102 include 'DIMENSIONS'
2106 include 'COMMON.IOUNITS'
2107 include 'COMMON.GEO'
2108 include 'COMMON.VAR'
2109 include 'COMMON.LOCAL'
2110 include 'COMMON.CHAIN'
2111 include 'COMMON.VECTORS'
2112 include 'COMMON.SETUP'
2113 include 'COMMON.TIME1'
2114 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2115 C Compute the local reference systems. For reference system (i), the
2116 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2117 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2119 do i=ivec_start,ivec_end
2123 if (i.eq.nres-1) then
2124 C Case of the last full residue
2125 C Compute the Z-axis
2126 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2127 costh=dcos(pi-theta(nres))
2128 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2132 C Compute the derivatives of uz
2134 uzder(2,1,1)=-dc_norm(3,i-1)
2135 uzder(3,1,1)= dc_norm(2,i-1)
2136 uzder(1,2,1)= dc_norm(3,i-1)
2138 uzder(3,2,1)=-dc_norm(1,i-1)
2139 uzder(1,3,1)=-dc_norm(2,i-1)
2140 uzder(2,3,1)= dc_norm(1,i-1)
2143 uzder(2,1,2)= dc_norm(3,i)
2144 uzder(3,1,2)=-dc_norm(2,i)
2145 uzder(1,2,2)=-dc_norm(3,i)
2147 uzder(3,2,2)= dc_norm(1,i)
2148 uzder(1,3,2)= dc_norm(2,i)
2149 uzder(2,3,2)=-dc_norm(1,i)
2151 C Compute the Y-axis
2154 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2156 C Compute the derivatives of uy
2159 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2160 & -dc_norm(k,i)*dc_norm(j,i-1)
2161 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2163 uyder(j,j,1)=uyder(j,j,1)-costh
2164 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2169 uygrad(l,k,j,i)=uyder(l,k,j)
2170 uzgrad(l,k,j,i)=uzder(l,k,j)
2174 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2175 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2176 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2177 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2180 C Compute the Z-axis
2181 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2182 costh=dcos(pi-theta(i+2))
2183 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2187 C Compute the derivatives of uz
2189 uzder(2,1,1)=-dc_norm(3,i+1)
2190 uzder(3,1,1)= dc_norm(2,i+1)
2191 uzder(1,2,1)= dc_norm(3,i+1)
2193 uzder(3,2,1)=-dc_norm(1,i+1)
2194 uzder(1,3,1)=-dc_norm(2,i+1)
2195 uzder(2,3,1)= dc_norm(1,i+1)
2198 uzder(2,1,2)= dc_norm(3,i)
2199 uzder(3,1,2)=-dc_norm(2,i)
2200 uzder(1,2,2)=-dc_norm(3,i)
2202 uzder(3,2,2)= dc_norm(1,i)
2203 uzder(1,3,2)= dc_norm(2,i)
2204 uzder(2,3,2)=-dc_norm(1,i)
2206 C Compute the Y-axis
2209 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2211 C Compute the derivatives of uy
2214 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2215 & -dc_norm(k,i)*dc_norm(j,i+1)
2216 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2218 uyder(j,j,1)=uyder(j,j,1)-costh
2219 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2224 uygrad(l,k,j,i)=uyder(l,k,j)
2225 uzgrad(l,k,j,i)=uzder(l,k,j)
2229 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2230 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2231 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2232 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2236 vbld_inv_temp(1)=vbld_inv(i+1)
2237 if (i.lt.nres-1) then
2238 vbld_inv_temp(2)=vbld_inv(i+2)
2240 vbld_inv_temp(2)=vbld_inv(i)
2245 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2246 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2251 #if defined(PARVEC) && defined(MPI)
2252 if (nfgtasks1.gt.1) then
2254 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2255 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2256 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2257 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2258 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2260 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2261 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2263 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2264 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2265 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2266 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2267 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2268 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2269 time_gather=time_gather+MPI_Wtime()-time00
2271 c if (fg_rank.eq.0) then
2272 c write (iout,*) "Arrays UY and UZ"
2274 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2281 C-----------------------------------------------------------------------------
2282 subroutine check_vecgrad
2283 implicit real*8 (a-h,o-z)
2284 include 'DIMENSIONS'
2285 include 'COMMON.IOUNITS'
2286 include 'COMMON.GEO'
2287 include 'COMMON.VAR'
2288 include 'COMMON.LOCAL'
2289 include 'COMMON.CHAIN'
2290 include 'COMMON.VECTORS'
2291 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2292 dimension uyt(3,maxres),uzt(3,maxres)
2293 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2294 double precision delta /1.0d-7/
2297 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2298 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2299 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2300 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2301 cd & (dc_norm(if90,i),if90=1,3)
2302 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2303 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2304 cd write(iout,'(a)')
2310 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2311 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2324 cd write (iout,*) 'i=',i
2326 erij(k)=dc_norm(k,i)
2330 dc_norm(k,i)=erij(k)
2332 dc_norm(j,i)=dc_norm(j,i)+delta
2333 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2335 c dc_norm(k,i)=dc_norm(k,i)/fac
2337 c write (iout,*) (dc_norm(k,i),k=1,3)
2338 c write (iout,*) (erij(k),k=1,3)
2341 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2342 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2343 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2344 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2346 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2347 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2348 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2351 dc_norm(k,i)=erij(k)
2354 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2355 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2356 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2357 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2358 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2359 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2360 cd write (iout,'(a)')
2365 C--------------------------------------------------------------------------
2366 subroutine set_matrices
2367 implicit real*8 (a-h,o-z)
2368 include 'DIMENSIONS'
2371 include "COMMON.SETUP"
2373 integer status(MPI_STATUS_SIZE)
2375 include 'COMMON.IOUNITS'
2376 include 'COMMON.GEO'
2377 include 'COMMON.VAR'
2378 include 'COMMON.LOCAL'
2379 include 'COMMON.CHAIN'
2380 include 'COMMON.DERIV'
2381 include 'COMMON.INTERACT'
2382 include 'COMMON.CONTACTS'
2383 include 'COMMON.TORSION'
2384 include 'COMMON.VECTORS'
2385 include 'COMMON.FFIELD'
2386 double precision auxvec(2),auxmat(2,2)
2388 C Compute the virtual-bond-torsional-angle dependent quantities needed
2389 C to calculate the el-loc multibody terms of various order.
2392 do i=ivec_start+2,ivec_end+2
2396 if (i .lt. nres+1) then
2433 if (i .gt. 3 .and. i .lt. nres+1) then
2434 obrot_der(1,i-2)=-sin1
2435 obrot_der(2,i-2)= cos1
2436 Ugder(1,1,i-2)= sin1
2437 Ugder(1,2,i-2)=-cos1
2438 Ugder(2,1,i-2)=-cos1
2439 Ugder(2,2,i-2)=-sin1
2442 obrot2_der(1,i-2)=-dwasin2
2443 obrot2_der(2,i-2)= dwacos2
2444 Ug2der(1,1,i-2)= dwasin2
2445 Ug2der(1,2,i-2)=-dwacos2
2446 Ug2der(2,1,i-2)=-dwacos2
2447 Ug2der(2,2,i-2)=-dwasin2
2449 obrot_der(1,i-2)=0.0d0
2450 obrot_der(2,i-2)=0.0d0
2451 Ugder(1,1,i-2)=0.0d0
2452 Ugder(1,2,i-2)=0.0d0
2453 Ugder(2,1,i-2)=0.0d0
2454 Ugder(2,2,i-2)=0.0d0
2455 obrot2_der(1,i-2)=0.0d0
2456 obrot2_der(2,i-2)=0.0d0
2457 Ug2der(1,1,i-2)=0.0d0
2458 Ug2der(1,2,i-2)=0.0d0
2459 Ug2der(2,1,i-2)=0.0d0
2460 Ug2der(2,2,i-2)=0.0d0
2462 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2463 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2464 iti = itortyp(itype(i-2))
2468 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2469 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2470 iti1 = itortyp(itype(i-1))
2474 cd write (iout,*) '*******i',i,' iti1',iti
2475 cd write (iout,*) 'b1',b1(:,iti)
2476 cd write (iout,*) 'b2',b2(:,iti)
2477 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2478 c if (i .gt. iatel_s+2) then
2479 if (i .gt. nnt+2) then
2480 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2481 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2482 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2484 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2485 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2486 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2487 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2488 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2499 DtUg2(l,k,i-2)=0.0d0
2503 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2504 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2506 muder(k,i-2)=Ub2der(k,i-2)
2508 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2509 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2510 iti1 = itortyp(itype(i-1))
2515 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2517 cd write (iout,*) 'mu ',mu(:,i-2)
2518 cd write (iout,*) 'mu1',mu1(:,i-2)
2519 cd write (iout,*) 'mu2',mu2(:,i-2)
2520 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2522 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2523 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2524 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2525 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2526 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2527 C Vectors and matrices dependent on a single virtual-bond dihedral.
2528 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2529 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2530 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2531 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2532 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2533 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2534 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2535 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2536 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2539 C Matrices dependent on two consecutive virtual-bond dihedrals.
2540 C The order of matrices is from left to right.
2541 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2543 c do i=max0(ivec_start,2),ivec_end
2545 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2546 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2547 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2548 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2549 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2550 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2551 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2552 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2555 #if defined(MPI) && defined(PARMAT)
2557 c if (fg_rank.eq.0) then
2558 write (iout,*) "Arrays UG and UGDER before GATHER"
2560 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2561 & ((ug(l,k,i),l=1,2),k=1,2),
2562 & ((ugder(l,k,i),l=1,2),k=1,2)
2564 write (iout,*) "Arrays UG2 and UG2DER"
2566 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2567 & ((ug2(l,k,i),l=1,2),k=1,2),
2568 & ((ug2der(l,k,i),l=1,2),k=1,2)
2570 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2572 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2573 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2574 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2576 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2578 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2579 & costab(i),sintab(i),costab2(i),sintab2(i)
2581 write (iout,*) "Array MUDER"
2583 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2587 if (nfgtasks.gt.1) then
2589 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2590 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2591 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2593 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2594 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2596 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2597 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2599 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2600 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2602 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2603 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2605 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2606 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2608 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2609 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2611 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2612 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2613 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2614 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2615 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2616 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2617 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2618 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2619 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2620 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2621 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2622 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2623 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2625 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2626 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2628 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2629 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2631 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2632 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2634 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2637 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2638 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2640 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2641 & ivec_count(fg_rank1),
2642 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2644 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2645 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2647 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2648 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2650 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2651 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2653 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2654 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2656 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2657 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2659 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2660 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2662 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2663 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2665 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2666 & ivec_count(fg_rank1),
2667 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2669 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2670 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2672 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2673 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2675 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2676 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2678 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2681 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2682 & ivec_count(fg_rank1),
2683 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2685 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2686 & ivec_count(fg_rank1),
2687 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2689 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2690 & ivec_count(fg_rank1),
2691 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2692 & MPI_MAT2,FG_COMM1,IERR)
2693 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2694 & ivec_count(fg_rank1),
2695 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2696 & MPI_MAT2,FG_COMM1,IERR)
2699 c Passes matrix info through the ring
2702 if (irecv.lt.0) irecv=nfgtasks1-1
2705 if (inext.ge.nfgtasks1) inext=0
2707 c write (iout,*) "isend",isend," irecv",irecv
2709 lensend=lentyp(isend)
2710 lenrecv=lentyp(irecv)
2711 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2712 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2713 c & MPI_ROTAT1(lensend),inext,2200+isend,
2714 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2715 c & iprev,2200+irecv,FG_COMM,status,IERR)
2716 c write (iout,*) "Gather ROTAT1"
2718 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2719 c & MPI_ROTAT2(lensend),inext,3300+isend,
2720 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2721 c & iprev,3300+irecv,FG_COMM,status,IERR)
2722 c write (iout,*) "Gather ROTAT2"
2724 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2725 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2726 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2727 & iprev,4400+irecv,FG_COMM,status,IERR)
2728 c write (iout,*) "Gather ROTAT_OLD"
2730 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2731 & MPI_PRECOMP11(lensend),inext,5500+isend,
2732 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2733 & iprev,5500+irecv,FG_COMM,status,IERR)
2734 c write (iout,*) "Gather PRECOMP11"
2736 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2737 & MPI_PRECOMP12(lensend),inext,6600+isend,
2738 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2739 & iprev,6600+irecv,FG_COMM,status,IERR)
2740 c write (iout,*) "Gather PRECOMP12"
2742 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2744 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2745 & MPI_ROTAT2(lensend),inext,7700+isend,
2746 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2747 & iprev,7700+irecv,FG_COMM,status,IERR)
2748 c write (iout,*) "Gather PRECOMP21"
2750 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2751 & MPI_PRECOMP22(lensend),inext,8800+isend,
2752 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2753 & iprev,8800+irecv,FG_COMM,status,IERR)
2754 c write (iout,*) "Gather PRECOMP22"
2756 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2757 & MPI_PRECOMP23(lensend),inext,9900+isend,
2758 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2759 & MPI_PRECOMP23(lenrecv),
2760 & iprev,9900+irecv,FG_COMM,status,IERR)
2761 c write (iout,*) "Gather PRECOMP23"
2766 if (irecv.lt.0) irecv=nfgtasks1-1
2769 time_gather=time_gather+MPI_Wtime()-time00
2772 c if (fg_rank.eq.0) then
2773 write (iout,*) "Arrays UG and UGDER"
2775 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2776 & ((ug(l,k,i),l=1,2),k=1,2),
2777 & ((ugder(l,k,i),l=1,2),k=1,2)
2779 write (iout,*) "Arrays UG2 and UG2DER"
2781 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2782 & ((ug2(l,k,i),l=1,2),k=1,2),
2783 & ((ug2der(l,k,i),l=1,2),k=1,2)
2785 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2787 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2788 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2789 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2791 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2793 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2794 & costab(i),sintab(i),costab2(i),sintab2(i)
2796 write (iout,*) "Array MUDER"
2798 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2804 cd iti = itortyp(itype(i))
2807 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2808 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2813 C--------------------------------------------------------------------------
2814 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2816 C This subroutine calculates the average interaction energy and its gradient
2817 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2818 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2819 C The potential depends both on the distance of peptide-group centers and on
2820 C the orientation of the CA-CA virtual bonds.
2822 implicit real*8 (a-h,o-z)
2826 include 'DIMENSIONS'
2827 include 'COMMON.CONTROL'
2828 include 'COMMON.SETUP'
2829 include 'COMMON.IOUNITS'
2830 include 'COMMON.GEO'
2831 include 'COMMON.VAR'
2832 include 'COMMON.LOCAL'
2833 include 'COMMON.CHAIN'
2834 include 'COMMON.DERIV'
2835 include 'COMMON.INTERACT'
2836 include 'COMMON.CONTACTS'
2837 include 'COMMON.TORSION'
2838 include 'COMMON.VECTORS'
2839 include 'COMMON.FFIELD'
2840 include 'COMMON.TIME1'
2841 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2842 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2843 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2844 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2845 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2846 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2848 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2850 double precision scal_el /1.0d0/
2852 double precision scal_el /0.5d0/
2855 C 13-go grudnia roku pamietnego...
2856 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2857 & 0.0d0,1.0d0,0.0d0,
2858 & 0.0d0,0.0d0,1.0d0/
2859 cd write(iout,*) 'In EELEC'
2861 cd write(iout,*) 'Type',i
2862 cd write(iout,*) 'B1',B1(:,i)
2863 cd write(iout,*) 'B2',B2(:,i)
2864 cd write(iout,*) 'CC',CC(:,:,i)
2865 cd write(iout,*) 'DD',DD(:,:,i)
2866 cd write(iout,*) 'EE',EE(:,:,i)
2868 cd call check_vecgrad
2870 if (icheckgrad.eq.1) then
2872 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2874 dc_norm(k,i)=dc(k,i)*fac
2876 c write (iout,*) 'i',i,' fac',fac
2879 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2880 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2881 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2882 c call vec_and_deriv
2888 time_mat=time_mat+MPI_Wtime()-time01
2892 cd write (iout,*) 'i=',i
2894 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2897 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2898 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2911 cd print '(a)','Enter EELEC'
2912 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2914 gel_loc_loc(i)=0.0d0
2919 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2921 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2923 do i=iturn3_start,iturn3_end
2927 dx_normi=dc_norm(1,i)
2928 dy_normi=dc_norm(2,i)
2929 dz_normi=dc_norm(3,i)
2930 xmedi=c(1,i)+0.5d0*dxi
2931 ymedi=c(2,i)+0.5d0*dyi
2932 zmedi=c(3,i)+0.5d0*dzi
2934 call eelecij(i,i+2,ees,evdw1,eel_loc)
2935 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2936 num_cont_hb(i)=num_conti
2938 do i=iturn4_start,iturn4_end
2942 dx_normi=dc_norm(1,i)
2943 dy_normi=dc_norm(2,i)
2944 dz_normi=dc_norm(3,i)
2945 xmedi=c(1,i)+0.5d0*dxi
2946 ymedi=c(2,i)+0.5d0*dyi
2947 zmedi=c(3,i)+0.5d0*dzi
2948 num_conti=num_cont_hb(i)
2949 call eelecij(i,i+3,ees,evdw1,eel_loc)
2950 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2951 num_cont_hb(i)=num_conti
2954 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2956 do i=iatel_s,iatel_e
2960 dx_normi=dc_norm(1,i)
2961 dy_normi=dc_norm(2,i)
2962 dz_normi=dc_norm(3,i)
2963 xmedi=c(1,i)+0.5d0*dxi
2964 ymedi=c(2,i)+0.5d0*dyi
2965 zmedi=c(3,i)+0.5d0*dzi
2966 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2967 num_conti=num_cont_hb(i)
2968 do j=ielstart(i),ielend(i)
2969 call eelecij(i,j,ees,evdw1,eel_loc)
2971 num_cont_hb(i)=num_conti
2973 c write (iout,*) "Number of loop steps in EELEC:",ind
2975 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2976 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2978 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2979 ccc eel_loc=eel_loc+eello_turn3
2980 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2983 C-------------------------------------------------------------------------------
2984 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2985 implicit real*8 (a-h,o-z)
2986 include 'DIMENSIONS'
2990 include 'COMMON.CONTROL'
2991 include 'COMMON.IOUNITS'
2992 include 'COMMON.GEO'
2993 include 'COMMON.VAR'
2994 include 'COMMON.LOCAL'
2995 include 'COMMON.CHAIN'
2996 include 'COMMON.DERIV'
2997 include 'COMMON.INTERACT'
2998 include 'COMMON.CONTACTS'
2999 include 'COMMON.TORSION'
3000 include 'COMMON.VECTORS'
3001 include 'COMMON.FFIELD'
3002 include 'COMMON.TIME1'
3003 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3004 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3005 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3006 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3007 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3008 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3010 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3012 double precision scal_el /1.0d0/
3014 double precision scal_el /0.5d0/
3017 C 13-go grudnia roku pamietnego...
3018 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3019 & 0.0d0,1.0d0,0.0d0,
3020 & 0.0d0,0.0d0,1.0d0/
3021 c time00=MPI_Wtime()
3022 cd write (iout,*) "eelecij",i,j
3026 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3027 aaa=app(iteli,itelj)
3028 bbb=bpp(iteli,itelj)
3029 ael6i=ael6(iteli,itelj)
3030 ael3i=ael3(iteli,itelj)
3034 dx_normj=dc_norm(1,j)
3035 dy_normj=dc_norm(2,j)
3036 dz_normj=dc_norm(3,j)
3037 xj=c(1,j)+0.5D0*dxj-xmedi
3038 yj=c(2,j)+0.5D0*dyj-ymedi
3039 zj=c(3,j)+0.5D0*dzj-zmedi
3040 rij=xj*xj+yj*yj+zj*zj
3046 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3047 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3048 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3049 fac=cosa-3.0D0*cosb*cosg
3051 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3052 if (j.eq.i+2) ev1=scal_el*ev1
3057 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3060 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3061 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3064 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3065 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3066 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3067 cd & xmedi,ymedi,zmedi,xj,yj,zj
3069 if (energy_dec) then
3070 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3071 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3075 C Calculate contributions to the Cartesian gradient.
3078 facvdw=-6*rrmij*(ev1+evdwij)
3079 facel=-3*rrmij*(el1+eesij)
3085 * Radial derivatives. First process both termini of the fragment (i,j)
3091 c ghalf=0.5D0*ggg(k)
3092 c gelc(k,i)=gelc(k,i)+ghalf
3093 c gelc(k,j)=gelc(k,j)+ghalf
3095 c 9/28/08 AL Gradient compotents will be summed only at the end
3097 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3098 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3101 * Loop over residues i+1 thru j-1.
3105 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3112 c ghalf=0.5D0*ggg(k)
3113 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3114 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3116 c 9/28/08 AL Gradient compotents will be summed only at the end
3118 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3119 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3122 * Loop over residues i+1 thru j-1.
3126 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3133 fac=-3*rrmij*(facvdw+facvdw+facel)
3138 * Radial derivatives. First process both termini of the fragment (i,j)
3144 c ghalf=0.5D0*ggg(k)
3145 c gelc(k,i)=gelc(k,i)+ghalf
3146 c gelc(k,j)=gelc(k,j)+ghalf
3148 c 9/28/08 AL Gradient compotents will be summed only at the end
3150 gelc_long(k,j)=gelc(k,j)+ggg(k)
3151 gelc_long(k,i)=gelc(k,i)-ggg(k)
3154 * Loop over residues i+1 thru j-1.
3158 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3161 c 9/28/08 AL Gradient compotents will be summed only at the end
3166 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3167 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3173 ecosa=2.0D0*fac3*fac1+fac4
3176 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3177 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3179 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3180 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3182 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3183 cd & (dcosg(k),k=1,3)
3185 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3188 c ghalf=0.5D0*ggg(k)
3189 c gelc(k,i)=gelc(k,i)+ghalf
3190 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3191 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3192 c gelc(k,j)=gelc(k,j)+ghalf
3193 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3194 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3198 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3203 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3204 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3206 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3207 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3208 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3209 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3211 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3212 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3213 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3215 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3216 C energy of a peptide unit is assumed in the form of a second-order
3217 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3218 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3219 C are computed for EVERY pair of non-contiguous peptide groups.
3221 if (j.lt.nres-1) then
3232 muij(kkk)=mu(k,i)*mu(l,j)
3235 cd write (iout,*) 'EELEC: i',i,' j',j
3236 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3237 cd write(iout,*) 'muij',muij
3238 ury=scalar(uy(1,i),erij)
3239 urz=scalar(uz(1,i),erij)
3240 vry=scalar(uy(1,j),erij)
3241 vrz=scalar(uz(1,j),erij)
3242 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3243 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3244 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3245 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3246 fac=dsqrt(-ael6i)*r3ij
3251 cd write (iout,'(4i5,4f10.5)')
3252 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3253 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3254 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3255 cd & uy(:,j),uz(:,j)
3256 cd write (iout,'(4f10.5)')
3257 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3258 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3259 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3260 cd write (iout,'(9f10.5/)')
3261 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3262 C Derivatives of the elements of A in virtual-bond vectors
3263 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3265 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3266 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3267 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3268 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3269 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3270 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3271 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3272 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3273 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3274 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3275 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3276 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3278 C Compute radial contributions to the gradient
3296 C Add the contributions coming from er
3299 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3300 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3301 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3302 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3305 C Derivatives in DC(i)
3306 cgrad ghalf1=0.5d0*agg(k,1)
3307 cgrad ghalf2=0.5d0*agg(k,2)
3308 cgrad ghalf3=0.5d0*agg(k,3)
3309 cgrad ghalf4=0.5d0*agg(k,4)
3310 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3311 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3312 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3313 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3314 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3315 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3316 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3317 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3318 C Derivatives in DC(i+1)
3319 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3320 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3321 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3322 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3323 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3324 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3325 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3326 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3327 C Derivatives in DC(j)
3328 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3329 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3330 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3331 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3332 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3333 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3334 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3335 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3336 C Derivatives in DC(j+1) or DC(nres-1)
3337 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3338 & -3.0d0*vryg(k,3)*ury)
3339 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3340 & -3.0d0*vrzg(k,3)*ury)
3341 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3342 & -3.0d0*vryg(k,3)*urz)
3343 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3344 & -3.0d0*vrzg(k,3)*urz)
3345 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3347 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3360 aggi(k,l)=-aggi(k,l)
3361 aggi1(k,l)=-aggi1(k,l)
3362 aggj(k,l)=-aggj(k,l)
3363 aggj1(k,l)=-aggj1(k,l)
3366 if (j.lt.nres-1) then
3372 aggi(k,l)=-aggi(k,l)
3373 aggi1(k,l)=-aggi1(k,l)
3374 aggj(k,l)=-aggj(k,l)
3375 aggj1(k,l)=-aggj1(k,l)
3386 aggi(k,l)=-aggi(k,l)
3387 aggi1(k,l)=-aggi1(k,l)
3388 aggj(k,l)=-aggj(k,l)
3389 aggj1(k,l)=-aggj1(k,l)
3394 IF (wel_loc.gt.0.0d0) THEN
3395 C Contribution to the local-electrostatic energy coming from the i-j pair
3396 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3398 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3400 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3401 & 'eelloc',i,j,eel_loc_ij
3403 eel_loc=eel_loc+eel_loc_ij
3404 C Partial derivatives in virtual-bond dihedral angles gamma
3406 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3407 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3408 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3409 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3410 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3411 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3412 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3414 ggg(l)=agg(l,1)*muij(1)+
3415 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3416 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3417 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3418 cgrad ghalf=0.5d0*ggg(l)
3419 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3420 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3424 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3427 C Remaining derivatives of eello
3429 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3430 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3431 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3432 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3433 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3434 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3435 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3436 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3439 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3440 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3441 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3442 & .and. num_conti.le.maxconts) then
3443 c write (iout,*) i,j," entered corr"
3445 C Calculate the contact function. The ith column of the array JCONT will
3446 C contain the numbers of atoms that make contacts with the atom I (of numbers
3447 C greater than I). The arrays FACONT and GACONT will contain the values of
3448 C the contact function and its derivative.
3449 c r0ij=1.02D0*rpp(iteli,itelj)
3450 c r0ij=1.11D0*rpp(iteli,itelj)
3451 r0ij=2.20D0*rpp(iteli,itelj)
3452 c r0ij=1.55D0*rpp(iteli,itelj)
3453 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3454 if (fcont.gt.0.0D0) then
3455 num_conti=num_conti+1
3456 if (num_conti.gt.maxconts) then
3457 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3458 & ' will skip next contacts for this conf.'
3460 jcont_hb(num_conti,i)=j
3461 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3462 cd & " jcont_hb",jcont_hb(num_conti,i)
3463 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3464 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3465 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3467 d_cont(num_conti,i)=rij
3468 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3469 C --- Electrostatic-interaction matrix ---
3470 a_chuj(1,1,num_conti,i)=a22
3471 a_chuj(1,2,num_conti,i)=a23
3472 a_chuj(2,1,num_conti,i)=a32
3473 a_chuj(2,2,num_conti,i)=a33
3474 C --- Gradient of rij
3476 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3483 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3484 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3485 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3486 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3487 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3492 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3493 C Calculate contact energies
3495 wij=cosa-3.0D0*cosb*cosg
3498 c fac3=dsqrt(-ael6i)/r0ij**3
3499 fac3=dsqrt(-ael6i)*r3ij
3500 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3501 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3502 if (ees0tmp.gt.0) then
3503 ees0pij=dsqrt(ees0tmp)
3507 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3508 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3509 if (ees0tmp.gt.0) then
3510 ees0mij=dsqrt(ees0tmp)
3515 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3516 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3517 C Diagnostics. Comment out or remove after debugging!
3518 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3519 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3520 c ees0m(num_conti,i)=0.0D0
3522 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3523 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3524 C Angular derivatives of the contact function
3525 ees0pij1=fac3/ees0pij
3526 ees0mij1=fac3/ees0mij
3527 fac3p=-3.0D0*fac3*rrmij
3528 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3529 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3531 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3532 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3533 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3534 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3535 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3536 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3537 ecosap=ecosa1+ecosa2
3538 ecosbp=ecosb1+ecosb2
3539 ecosgp=ecosg1+ecosg2
3540 ecosam=ecosa1-ecosa2
3541 ecosbm=ecosb1-ecosb2
3542 ecosgm=ecosg1-ecosg2
3551 facont_hb(num_conti,i)=fcont
3552 fprimcont=fprimcont/rij
3553 cd facont_hb(num_conti,i)=1.0D0
3554 C Following line is for diagnostics.
3557 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3558 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3561 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3562 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3564 gggp(1)=gggp(1)+ees0pijp*xj
3565 gggp(2)=gggp(2)+ees0pijp*yj
3566 gggp(3)=gggp(3)+ees0pijp*zj
3567 gggm(1)=gggm(1)+ees0mijp*xj
3568 gggm(2)=gggm(2)+ees0mijp*yj
3569 gggm(3)=gggm(3)+ees0mijp*zj
3570 C Derivatives due to the contact function
3571 gacont_hbr(1,num_conti,i)=fprimcont*xj
3572 gacont_hbr(2,num_conti,i)=fprimcont*yj
3573 gacont_hbr(3,num_conti,i)=fprimcont*zj
3576 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3577 c following the change of gradient-summation algorithm.
3579 cgrad ghalfp=0.5D0*gggp(k)
3580 cgrad ghalfm=0.5D0*gggm(k)
3581 gacontp_hb1(k,num_conti,i)=!ghalfp
3582 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3583 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3584 gacontp_hb2(k,num_conti,i)=!ghalfp
3585 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3586 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3587 gacontp_hb3(k,num_conti,i)=gggp(k)
3588 gacontm_hb1(k,num_conti,i)=!ghalfm
3589 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3590 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3591 gacontm_hb2(k,num_conti,i)=!ghalfm
3592 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3593 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3594 gacontm_hb3(k,num_conti,i)=gggm(k)
3596 C Diagnostics. Comment out or remove after debugging!
3598 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3599 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3600 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3601 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3602 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3603 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3606 endif ! num_conti.le.maxconts
3609 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3612 ghalf=0.5d0*agg(l,k)
3613 aggi(l,k)=aggi(l,k)+ghalf
3614 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3615 aggj(l,k)=aggj(l,k)+ghalf
3618 if (j.eq.nres-1 .and. i.lt.j-2) then
3621 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3626 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3629 C-----------------------------------------------------------------------------
3630 subroutine eturn3(i,eello_turn3)
3631 C Third- and fourth-order contributions from turns
3632 implicit real*8 (a-h,o-z)
3633 include 'DIMENSIONS'
3634 include 'COMMON.IOUNITS'
3635 include 'COMMON.GEO'
3636 include 'COMMON.VAR'
3637 include 'COMMON.LOCAL'
3638 include 'COMMON.CHAIN'
3639 include 'COMMON.DERIV'
3640 include 'COMMON.INTERACT'
3641 include 'COMMON.CONTACTS'
3642 include 'COMMON.TORSION'
3643 include 'COMMON.VECTORS'
3644 include 'COMMON.FFIELD'
3645 include 'COMMON.CONTROL'
3647 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3648 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3649 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3650 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3651 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3652 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3653 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3656 c write (iout,*) "eturn3",i,j,j1,j2
3661 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3663 C Third-order contributions
3670 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3671 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3672 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3673 call transpose2(auxmat(1,1),auxmat1(1,1))
3674 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3675 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3676 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3677 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3678 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3679 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3680 cd & ' eello_turn3_num',4*eello_turn3_num
3681 C Derivatives in gamma(i)
3682 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3683 call transpose2(auxmat2(1,1),auxmat3(1,1))
3684 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3685 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3686 C Derivatives in gamma(i+1)
3687 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3688 call transpose2(auxmat2(1,1),auxmat3(1,1))
3689 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3690 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3691 & +0.5d0*(pizda(1,1)+pizda(2,2))
3692 C Cartesian derivatives
3694 c ghalf1=0.5d0*agg(l,1)
3695 c ghalf2=0.5d0*agg(l,2)
3696 c ghalf3=0.5d0*agg(l,3)
3697 c ghalf4=0.5d0*agg(l,4)
3698 a_temp(1,1)=aggi(l,1)!+ghalf1
3699 a_temp(1,2)=aggi(l,2)!+ghalf2
3700 a_temp(2,1)=aggi(l,3)!+ghalf3
3701 a_temp(2,2)=aggi(l,4)!+ghalf4
3702 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3703 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3704 & +0.5d0*(pizda(1,1)+pizda(2,2))
3705 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3706 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3707 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3708 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3709 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3710 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3711 & +0.5d0*(pizda(1,1)+pizda(2,2))
3712 a_temp(1,1)=aggj(l,1)!+ghalf1
3713 a_temp(1,2)=aggj(l,2)!+ghalf2
3714 a_temp(2,1)=aggj(l,3)!+ghalf3
3715 a_temp(2,2)=aggj(l,4)!+ghalf4
3716 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3717 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3718 & +0.5d0*(pizda(1,1)+pizda(2,2))
3719 a_temp(1,1)=aggj1(l,1)
3720 a_temp(1,2)=aggj1(l,2)
3721 a_temp(2,1)=aggj1(l,3)
3722 a_temp(2,2)=aggj1(l,4)
3723 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3724 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3725 & +0.5d0*(pizda(1,1)+pizda(2,2))
3729 C-------------------------------------------------------------------------------
3730 subroutine eturn4(i,eello_turn4)
3731 C Third- and fourth-order contributions from turns
3732 implicit real*8 (a-h,o-z)
3733 include 'DIMENSIONS'
3734 include 'COMMON.IOUNITS'
3735 include 'COMMON.GEO'
3736 include 'COMMON.VAR'
3737 include 'COMMON.LOCAL'
3738 include 'COMMON.CHAIN'
3739 include 'COMMON.DERIV'
3740 include 'COMMON.INTERACT'
3741 include 'COMMON.CONTACTS'
3742 include 'COMMON.TORSION'
3743 include 'COMMON.VECTORS'
3744 include 'COMMON.FFIELD'
3745 include 'COMMON.CONTROL'
3747 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3748 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3749 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3750 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3751 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3752 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3753 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3756 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3758 C Fourth-order contributions
3766 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3767 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3768 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3773 iti1=itortyp(itype(i+1))
3774 iti2=itortyp(itype(i+2))
3775 iti3=itortyp(itype(i+3))
3776 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3777 call transpose2(EUg(1,1,i+1),e1t(1,1))
3778 call transpose2(Eug(1,1,i+2),e2t(1,1))
3779 call transpose2(Eug(1,1,i+3),e3t(1,1))
3780 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3781 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3782 s1=scalar2(b1(1,iti2),auxvec(1))
3783 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3784 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3785 s2=scalar2(b1(1,iti1),auxvec(1))
3786 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3787 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3788 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3789 eello_turn4=eello_turn4-(s1+s2+s3)
3790 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3791 & 'eturn4',i,j,-(s1+s2+s3)
3792 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3793 cd & ' eello_turn4_num',8*eello_turn4_num
3794 C Derivatives in gamma(i)
3795 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3796 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3797 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3798 s1=scalar2(b1(1,iti2),auxvec(1))
3799 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3800 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3801 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3802 C Derivatives in gamma(i+1)
3803 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3804 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3805 s2=scalar2(b1(1,iti1),auxvec(1))
3806 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3807 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3808 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3809 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3810 C Derivatives in gamma(i+2)
3811 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3812 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3813 s1=scalar2(b1(1,iti2),auxvec(1))
3814 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3815 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3816 s2=scalar2(b1(1,iti1),auxvec(1))
3817 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3818 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3819 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3820 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3821 C Cartesian derivatives
3822 C Derivatives of this turn contributions in DC(i+2)
3823 if (j.lt.nres-1) then
3825 a_temp(1,1)=agg(l,1)
3826 a_temp(1,2)=agg(l,2)
3827 a_temp(2,1)=agg(l,3)
3828 a_temp(2,2)=agg(l,4)
3829 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3830 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3831 s1=scalar2(b1(1,iti2),auxvec(1))
3832 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3833 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3834 s2=scalar2(b1(1,iti1),auxvec(1))
3835 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3836 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3837 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3839 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3842 C Remaining derivatives of this turn contribution
3844 a_temp(1,1)=aggi(l,1)
3845 a_temp(1,2)=aggi(l,2)
3846 a_temp(2,1)=aggi(l,3)
3847 a_temp(2,2)=aggi(l,4)
3848 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3849 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3850 s1=scalar2(b1(1,iti2),auxvec(1))
3851 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3852 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3853 s2=scalar2(b1(1,iti1),auxvec(1))
3854 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3855 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3856 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3857 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3858 a_temp(1,1)=aggi1(l,1)
3859 a_temp(1,2)=aggi1(l,2)
3860 a_temp(2,1)=aggi1(l,3)
3861 a_temp(2,2)=aggi1(l,4)
3862 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3863 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3864 s1=scalar2(b1(1,iti2),auxvec(1))
3865 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3866 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3867 s2=scalar2(b1(1,iti1),auxvec(1))
3868 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3869 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3870 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3871 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3872 a_temp(1,1)=aggj(l,1)
3873 a_temp(1,2)=aggj(l,2)
3874 a_temp(2,1)=aggj(l,3)
3875 a_temp(2,2)=aggj(l,4)
3876 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3877 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3880 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3883 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3886 a_temp(1,1)=aggj1(l,1)
3887 a_temp(1,2)=aggj1(l,2)
3888 a_temp(2,1)=aggj1(l,3)
3889 a_temp(2,2)=aggj1(l,4)
3890 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3891 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3892 s1=scalar2(b1(1,iti2),auxvec(1))
3893 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3894 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3895 s2=scalar2(b1(1,iti1),auxvec(1))
3896 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3897 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3898 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3899 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3900 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3904 C-----------------------------------------------------------------------------
3905 subroutine vecpr(u,v,w)
3906 implicit real*8(a-h,o-z)
3907 dimension u(3),v(3),w(3)
3908 w(1)=u(2)*v(3)-u(3)*v(2)
3909 w(2)=-u(1)*v(3)+u(3)*v(1)
3910 w(3)=u(1)*v(2)-u(2)*v(1)
3913 C-----------------------------------------------------------------------------
3914 subroutine unormderiv(u,ugrad,unorm,ungrad)
3915 C This subroutine computes the derivatives of a normalized vector u, given
3916 C the derivatives computed without normalization conditions, ugrad. Returns
3919 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3920 double precision vec(3)
3921 double precision scalar
3923 c write (2,*) 'ugrad',ugrad
3926 vec(i)=scalar(ugrad(1,i),u(1))
3928 c write (2,*) 'vec',vec
3931 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3934 c write (2,*) 'ungrad',ungrad
3937 C-----------------------------------------------------------------------------
3938 subroutine escp_soft_sphere(evdw2,evdw2_14)
3940 C This subroutine calculates the excluded-volume interaction energy between
3941 C peptide-group centers and side chains and its gradient in virtual-bond and
3942 C side-chain vectors.
3944 implicit real*8 (a-h,o-z)
3945 include 'DIMENSIONS'
3946 include 'COMMON.GEO'
3947 include 'COMMON.VAR'
3948 include 'COMMON.LOCAL'
3949 include 'COMMON.CHAIN'
3950 include 'COMMON.DERIV'
3951 include 'COMMON.INTERACT'
3952 include 'COMMON.FFIELD'
3953 include 'COMMON.IOUNITS'
3954 include 'COMMON.CONTROL'
3959 cd print '(a)','Enter ESCP'
3960 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3961 do i=iatscp_s,iatscp_e
3963 xi=0.5D0*(c(1,i)+c(1,i+1))
3964 yi=0.5D0*(c(2,i)+c(2,i+1))
3965 zi=0.5D0*(c(3,i)+c(3,i+1))
3967 do iint=1,nscp_gr(i)
3969 do j=iscpstart(i,iint),iscpend(i,iint)
3971 C Uncomment following three lines for SC-p interactions
3975 C Uncomment following three lines for Ca-p interactions
3979 rij=xj*xj+yj*yj+zj*zj
3982 if (rij.lt.r0ijsq) then
3983 evdwij=0.25d0*(rij-r0ijsq)**2
3991 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3996 cgrad if (j.lt.i) then
3997 cd write (iout,*) 'j<i'
3998 C Uncomment following three lines for SC-p interactions
4000 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4003 cd write (iout,*) 'j>i'
4005 cgrad ggg(k)=-ggg(k)
4006 C Uncomment following line for SC-p interactions
4007 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4011 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4013 cgrad kstart=min0(i+1,j)
4014 cgrad kend=max0(i-1,j-1)
4015 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4016 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4017 cgrad do k=kstart,kend
4019 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4023 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4024 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4032 C-----------------------------------------------------------------------------
4033 subroutine escp(evdw2,evdw2_14)
4035 C This subroutine calculates the excluded-volume interaction energy between
4036 C peptide-group centers and side chains and its gradient in virtual-bond and
4037 C side-chain vectors.
4039 implicit real*8 (a-h,o-z)
4040 include 'DIMENSIONS'
4041 include 'COMMON.GEO'
4042 include 'COMMON.VAR'
4043 include 'COMMON.LOCAL'
4044 include 'COMMON.CHAIN'
4045 include 'COMMON.DERIV'
4046 include 'COMMON.INTERACT'
4047 include 'COMMON.FFIELD'
4048 include 'COMMON.IOUNITS'
4049 include 'COMMON.CONTROL'
4053 cd print '(a)','Enter ESCP'
4054 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4055 do i=iatscp_s,iatscp_e
4057 xi=0.5D0*(c(1,i)+c(1,i+1))
4058 yi=0.5D0*(c(2,i)+c(2,i+1))
4059 zi=0.5D0*(c(3,i)+c(3,i+1))
4061 do iint=1,nscp_gr(i)
4063 do j=iscpstart(i,iint),iscpend(i,iint)
4065 C Uncomment following three lines for SC-p interactions
4069 C Uncomment following three lines for Ca-p interactions
4073 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4075 e1=fac*fac*aad(itypj,iteli)
4076 e2=fac*bad(itypj,iteli)
4077 if (iabs(j-i) .le. 2) then
4080 evdw2_14=evdw2_14+e1+e2
4084 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4085 & 'evdw2',i,j,evdwij
4087 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4089 fac=-(evdwij+e1)*rrij
4093 cgrad if (j.lt.i) then
4094 cd write (iout,*) 'j<i'
4095 C Uncomment following three lines for SC-p interactions
4097 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4100 cd write (iout,*) 'j>i'
4102 cgrad ggg(k)=-ggg(k)
4103 C Uncomment following line for SC-p interactions
4104 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4105 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4109 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4111 cgrad kstart=min0(i+1,j)
4112 cgrad kend=max0(i-1,j-1)
4113 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4114 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4115 cgrad do k=kstart,kend
4117 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4121 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4122 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4130 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4131 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4132 gradx_scp(j,i)=expon*gradx_scp(j,i)
4135 C******************************************************************************
4139 C To save time the factor EXPON has been extracted from ALL components
4140 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4143 C******************************************************************************
4146 C--------------------------------------------------------------------------
4147 subroutine edis(ehpb)
4149 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4151 implicit real*8 (a-h,o-z)
4152 include 'DIMENSIONS'
4153 include 'COMMON.SBRIDGE'
4154 include 'COMMON.CHAIN'
4155 include 'COMMON.DERIV'
4156 include 'COMMON.VAR'
4157 include 'COMMON.INTERACT'
4158 include 'COMMON.IOUNITS'
4161 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4162 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4163 if (link_end.eq.0) return
4164 do i=link_start,link_end
4165 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4166 C CA-CA distance used in regularization of structure.
4169 C iii and jjj point to the residues for which the distance is assigned.
4170 if (ii.gt.nres) then
4177 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4178 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4179 C distance and angle dependent SS bond potential.
4180 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4181 call ssbond_ene(iii,jjj,eij)
4183 cd write (iout,*) "eij",eij
4185 C Calculate the distance between the two points and its difference from the
4189 C Get the force constant corresponding to this distance.
4191 C Calculate the contribution to energy.
4192 ehpb=ehpb+waga*rdis*rdis
4194 C Evaluate gradient.
4197 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4198 cd & ' waga=',waga,' fac=',fac
4200 ggg(j)=fac*(c(j,jj)-c(j,ii))
4202 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4203 C If this is a SC-SC distance, we need to calculate the contributions to the
4204 C Cartesian gradient in the SC vectors (ghpbx).
4207 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4208 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4211 cgrad do j=iii,jjj-1
4213 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4217 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4218 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4225 C--------------------------------------------------------------------------
4226 subroutine ssbond_ene(i,j,eij)
4228 C Calculate the distance and angle dependent SS-bond potential energy
4229 C using a free-energy function derived based on RHF/6-31G** ab initio
4230 C calculations of diethyl disulfide.
4232 C A. Liwo and U. Kozlowska, 11/24/03
4234 implicit real*8 (a-h,o-z)
4235 include 'DIMENSIONS'
4236 include 'COMMON.SBRIDGE'
4237 include 'COMMON.CHAIN'
4238 include 'COMMON.DERIV'
4239 include 'COMMON.LOCAL'
4240 include 'COMMON.INTERACT'
4241 include 'COMMON.VAR'
4242 include 'COMMON.IOUNITS'
4243 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4248 dxi=dc_norm(1,nres+i)
4249 dyi=dc_norm(2,nres+i)
4250 dzi=dc_norm(3,nres+i)
4251 c dsci_inv=dsc_inv(itypi)
4252 dsci_inv=vbld_inv(nres+i)
4254 c dscj_inv=dsc_inv(itypj)
4255 dscj_inv=vbld_inv(nres+j)
4259 dxj=dc_norm(1,nres+j)
4260 dyj=dc_norm(2,nres+j)
4261 dzj=dc_norm(3,nres+j)
4262 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4267 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4268 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4269 om12=dxi*dxj+dyi*dyj+dzi*dzj
4271 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4272 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4278 deltat12=om2-om1+2.0d0
4280 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4281 & +akct*deltad*deltat12
4282 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4283 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4284 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4285 c & " deltat12",deltat12," eij",eij
4286 ed=2*akcm*deltad+akct*deltat12
4288 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4289 eom1=-2*akth*deltat1-pom1-om2*pom2
4290 eom2= 2*akth*deltat2+pom1-om1*pom2
4293 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4294 ghpbx(k,i)=ghpbx(k,i)-ggk
4295 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4296 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4297 ghpbx(k,j)=ghpbx(k,j)+ggk
4298 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4299 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4300 ghpbc(k,i)=ghpbc(k,i)-ggk
4301 ghpbc(k,j)=ghpbc(k,j)+ggk
4304 C Calculate the components of the gradient in DC and X
4308 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4313 C--------------------------------------------------------------------------
4314 subroutine ebond(estr)
4316 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4318 implicit real*8 (a-h,o-z)
4319 include 'DIMENSIONS'
4320 include 'COMMON.LOCAL'
4321 include 'COMMON.GEO'
4322 include 'COMMON.INTERACT'
4323 include 'COMMON.DERIV'
4324 include 'COMMON.VAR'
4325 include 'COMMON.CHAIN'
4326 include 'COMMON.IOUNITS'
4327 include 'COMMON.NAMES'
4328 include 'COMMON.FFIELD'
4329 include 'COMMON.CONTROL'
4330 include 'COMMON.SETUP'
4331 double precision u(3),ud(3)
4333 do i=ibondp_start,ibondp_end
4334 diff = vbld(i)-vbldp0
4335 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4338 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4340 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4344 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4346 do i=ibond_start,ibond_end
4351 diff=vbld(i+nres)-vbldsc0(1,iti)
4352 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4353 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4354 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4356 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4360 diff=vbld(i+nres)-vbldsc0(j,iti)
4361 ud(j)=aksc(j,iti)*diff
4362 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4376 uprod2=uprod2*u(k)*u(k)
4380 usumsqder=usumsqder+ud(j)*uprod2
4382 estr=estr+uprod/usum
4384 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4392 C--------------------------------------------------------------------------
4393 subroutine ebend(etheta)
4395 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4396 C angles gamma and its derivatives in consecutive thetas and gammas.
4398 implicit real*8 (a-h,o-z)
4399 include 'DIMENSIONS'
4400 include 'COMMON.LOCAL'
4401 include 'COMMON.GEO'
4402 include 'COMMON.INTERACT'
4403 include 'COMMON.DERIV'
4404 include 'COMMON.VAR'
4405 include 'COMMON.CHAIN'
4406 include 'COMMON.IOUNITS'
4407 include 'COMMON.NAMES'
4408 include 'COMMON.FFIELD'
4409 include 'COMMON.CONTROL'
4410 common /calcthet/ term1,term2,termm,diffak,ratak,
4411 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4412 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4413 double precision y(2),z(2)
4415 c time11=dexp(-2*time)
4418 c write (*,'(a,i2)') 'EBEND ICG=',icg
4419 do i=ithet_start,ithet_end
4420 C Zero the energy function and its derivative at 0 or pi.
4421 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4426 if (phii.ne.phii) phii=150.0
4439 if (phii1.ne.phii1) phii1=150.0
4451 C Calculate the "mean" value of theta from the part of the distribution
4452 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4453 C In following comments this theta will be referred to as t_c.
4454 thet_pred_mean=0.0d0
4458 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4460 dthett=thet_pred_mean*ssd
4461 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4462 C Derivatives of the "mean" values in gamma1 and gamma2.
4463 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4464 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4465 if (theta(i).gt.pi-delta) then
4466 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4468 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4469 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4470 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4472 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4474 else if (theta(i).lt.delta) then
4475 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4476 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4477 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4479 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4480 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4483 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4486 etheta=etheta+ethetai
4487 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4489 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4490 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4491 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4493 C Ufff.... We've done all this!!!
4496 C---------------------------------------------------------------------------
4497 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4499 implicit real*8 (a-h,o-z)
4500 include 'DIMENSIONS'
4501 include 'COMMON.LOCAL'
4502 include 'COMMON.IOUNITS'
4503 common /calcthet/ term1,term2,termm,diffak,ratak,
4504 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4505 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4506 C Calculate the contributions to both Gaussian lobes.
4507 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4508 C The "polynomial part" of the "standard deviation" of this part of
4512 sig=sig*thet_pred_mean+polthet(j,it)
4514 C Derivative of the "interior part" of the "standard deviation of the"
4515 C gamma-dependent Gaussian lobe in t_c.
4516 sigtc=3*polthet(3,it)
4518 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4521 C Set the parameters of both Gaussian lobes of the distribution.
4522 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4523 fac=sig*sig+sigc0(it)
4526 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4527 sigsqtc=-4.0D0*sigcsq*sigtc
4528 c print *,i,sig,sigtc,sigsqtc
4529 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4530 sigtc=-sigtc/(fac*fac)
4531 C Following variable is sigma(t_c)**(-2)
4532 sigcsq=sigcsq*sigcsq
4534 sig0inv=1.0D0/sig0i**2
4535 delthec=thetai-thet_pred_mean
4536 delthe0=thetai-theta0i
4537 term1=-0.5D0*sigcsq*delthec*delthec
4538 term2=-0.5D0*sig0inv*delthe0*delthe0
4539 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4540 C NaNs in taking the logarithm. We extract the largest exponent which is added
4541 C to the energy (this being the log of the distribution) at the end of energy
4542 C term evaluation for this virtual-bond angle.
4543 if (term1.gt.term2) then
4545 term2=dexp(term2-termm)
4549 term1=dexp(term1-termm)
4552 C The ratio between the gamma-independent and gamma-dependent lobes of
4553 C the distribution is a Gaussian function of thet_pred_mean too.
4554 diffak=gthet(2,it)-thet_pred_mean
4555 ratak=diffak/gthet(3,it)**2
4556 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4557 C Let's differentiate it in thet_pred_mean NOW.
4559 C Now put together the distribution terms to make complete distribution.
4560 termexp=term1+ak*term2
4561 termpre=sigc+ak*sig0i
4562 C Contribution of the bending energy from this theta is just the -log of
4563 C the sum of the contributions from the two lobes and the pre-exponential
4564 C factor. Simple enough, isn't it?
4565 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4566 C NOW the derivatives!!!
4567 C 6/6/97 Take into account the deformation.
4568 E_theta=(delthec*sigcsq*term1
4569 & +ak*delthe0*sig0inv*term2)/termexp
4570 E_tc=((sigtc+aktc*sig0i)/termpre
4571 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4572 & aktc*term2)/termexp)
4575 c-----------------------------------------------------------------------------
4576 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4577 implicit real*8 (a-h,o-z)
4578 include 'DIMENSIONS'
4579 include 'COMMON.LOCAL'
4580 include 'COMMON.IOUNITS'
4581 common /calcthet/ term1,term2,termm,diffak,ratak,
4582 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4583 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4584 delthec=thetai-thet_pred_mean
4585 delthe0=thetai-theta0i
4586 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4587 t3 = thetai-thet_pred_mean
4591 t14 = t12+t6*sigsqtc
4593 t21 = thetai-theta0i
4599 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4600 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4601 & *(-t12*t9-ak*sig0inv*t27)
4605 C--------------------------------------------------------------------------
4606 subroutine ebend(etheta)
4608 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4609 C angles gamma and its derivatives in consecutive thetas and gammas.
4610 C ab initio-derived potentials from
4611 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4613 implicit real*8 (a-h,o-z)
4614 include 'DIMENSIONS'
4615 include 'COMMON.LOCAL'
4616 include 'COMMON.GEO'
4617 include 'COMMON.INTERACT'
4618 include 'COMMON.DERIV'
4619 include 'COMMON.VAR'
4620 include 'COMMON.CHAIN'
4621 include 'COMMON.IOUNITS'
4622 include 'COMMON.NAMES'
4623 include 'COMMON.FFIELD'
4624 include 'COMMON.CONTROL'
4625 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4626 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4627 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4628 & sinph1ph2(maxdouble,maxdouble)
4629 logical lprn /.false./, lprn1 /.false./
4631 do i=ithet_start,ithet_end
4635 theti2=0.5d0*theta(i)
4636 ityp2=ithetyp(itype(i-1))
4638 coskt(k)=dcos(k*theti2)
4639 sinkt(k)=dsin(k*theti2)
4644 if (phii.ne.phii) phii=150.0
4648 ityp1=ithetyp(itype(i-2))
4650 cosph1(k)=dcos(k*phii)
4651 sinph1(k)=dsin(k*phii)
4664 if (phii1.ne.phii1) phii1=150.0
4669 ityp3=ithetyp(itype(i))
4671 cosph2(k)=dcos(k*phii1)
4672 sinph2(k)=dsin(k*phii1)
4682 ethetai=aa0thet(ityp1,ityp2,ityp3)
4685 ccl=cosph1(l)*cosph2(k-l)
4686 ssl=sinph1(l)*sinph2(k-l)
4687 scl=sinph1(l)*cosph2(k-l)
4688 csl=cosph1(l)*sinph2(k-l)
4689 cosph1ph2(l,k)=ccl-ssl
4690 cosph1ph2(k,l)=ccl+ssl
4691 sinph1ph2(l,k)=scl+csl
4692 sinph1ph2(k,l)=scl-csl
4696 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4697 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4698 write (iout,*) "coskt and sinkt"
4700 write (iout,*) k,coskt(k),sinkt(k)
4704 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4705 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4708 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4709 & " ethetai",ethetai
4712 write (iout,*) "cosph and sinph"
4714 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4716 write (iout,*) "cosph1ph2 and sinph2ph2"
4719 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4720 & sinph1ph2(l,k),sinph1ph2(k,l)
4723 write(iout,*) "ethetai",ethetai
4727 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4728 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4729 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4730 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4731 ethetai=ethetai+sinkt(m)*aux
4732 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4733 dephii=dephii+k*sinkt(m)*(
4734 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4735 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4736 dephii1=dephii1+k*sinkt(m)*(
4737 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4738 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4740 & write (iout,*) "m",m," k",k," bbthet",
4741 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4742 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4743 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4744 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4748 & write(iout,*) "ethetai",ethetai
4752 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4753 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4754 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4755 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4756 ethetai=ethetai+sinkt(m)*aux
4757 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4758 dephii=dephii+l*sinkt(m)*(
4759 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4760 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4761 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4762 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4763 dephii1=dephii1+(k-l)*sinkt(m)*(
4764 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4765 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4766 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4767 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4769 write (iout,*) "m",m," k",k," l",l," ffthet",
4770 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4771 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4772 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4773 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4774 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4775 & cosph1ph2(k,l)*sinkt(m),
4776 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4782 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4783 & i,theta(i)*rad2deg,phii*rad2deg,
4784 & phii1*rad2deg,ethetai
4785 etheta=etheta+ethetai
4786 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4787 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4788 gloc(nphi+i-2,icg)=wang*dethetai
4794 c-----------------------------------------------------------------------------
4795 subroutine esc(escloc)
4796 C Calculate the local energy of a side chain and its derivatives in the
4797 C corresponding virtual-bond valence angles THETA and the spherical angles
4799 implicit real*8 (a-h,o-z)
4800 include 'DIMENSIONS'
4801 include 'COMMON.GEO'
4802 include 'COMMON.LOCAL'
4803 include 'COMMON.VAR'
4804 include 'COMMON.INTERACT'
4805 include 'COMMON.DERIV'
4806 include 'COMMON.CHAIN'
4807 include 'COMMON.IOUNITS'
4808 include 'COMMON.NAMES'
4809 include 'COMMON.FFIELD'
4810 include 'COMMON.CONTROL'
4811 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4812 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4813 common /sccalc/ time11,time12,time112,theti,it,nlobit
4816 c write (iout,'(a)') 'ESC'
4817 do i=loc_start,loc_end
4819 if (it.eq.10) goto 1
4821 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4822 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4823 theti=theta(i+1)-pipol
4828 if (x(2).gt.pi-delta) then
4832 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4834 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4835 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4837 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4838 & ddersc0(1),dersc(1))
4839 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4840 & ddersc0(3),dersc(3))
4842 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4844 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4845 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4846 & dersc0(2),esclocbi,dersc02)
4847 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4849 call splinthet(x(2),0.5d0*delta,ss,ssd)
4854 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4856 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4857 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4859 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4861 c write (iout,*) escloci
4862 else if (x(2).lt.delta) then
4866 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4868 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4869 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4871 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4872 & ddersc0(1),dersc(1))
4873 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4874 & ddersc0(3),dersc(3))
4876 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4878 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4879 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4880 & dersc0(2),esclocbi,dersc02)
4881 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4886 call splinthet(x(2),0.5d0*delta,ss,ssd)
4888 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4890 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4891 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4893 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4894 c write (iout,*) escloci
4896 call enesc(x,escloci,dersc,ddummy,.false.)
4899 escloc=escloc+escloci
4900 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4901 & 'escloc',i,escloci
4902 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4904 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4906 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4907 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4912 C---------------------------------------------------------------------------
4913 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4914 implicit real*8 (a-h,o-z)
4915 include 'DIMENSIONS'
4916 include 'COMMON.GEO'
4917 include 'COMMON.LOCAL'
4918 include 'COMMON.IOUNITS'
4919 common /sccalc/ time11,time12,time112,theti,it,nlobit
4920 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4921 double precision contr(maxlob,-1:1)
4923 c write (iout,*) 'it=',it,' nlobit=',nlobit
4927 if (mixed) ddersc(j)=0.0d0
4931 C Because of periodicity of the dependence of the SC energy in omega we have
4932 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4933 C To avoid underflows, first compute & store the exponents.
4941 z(k)=x(k)-censc(k,j,it)
4946 Axk=Axk+gaussc(l,k,j,it)*z(l)
4952 expfac=expfac+Ax(k,j,iii)*z(k)
4960 C As in the case of ebend, we want to avoid underflows in exponentiation and
4961 C subsequent NaNs and INFs in energy calculation.
4962 C Find the largest exponent
4966 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4970 cd print *,'it=',it,' emin=',emin
4972 C Compute the contribution to SC energy and derivatives
4977 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4978 if(adexp.ne.adexp) adexp=1.0
4981 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4983 cd print *,'j=',j,' expfac=',expfac
4984 escloc_i=escloc_i+expfac
4986 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4990 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4991 & +gaussc(k,2,j,it))*expfac
4998 dersc(1)=dersc(1)/cos(theti)**2
4999 ddersc(1)=ddersc(1)/cos(theti)**2
5002 escloci=-(dlog(escloc_i)-emin)
5004 dersc(j)=dersc(j)/escloc_i
5008 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5013 C------------------------------------------------------------------------------
5014 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5015 implicit real*8 (a-h,o-z)
5016 include 'DIMENSIONS'
5017 include 'COMMON.GEO'
5018 include 'COMMON.LOCAL'
5019 include 'COMMON.IOUNITS'
5020 common /sccalc/ time11,time12,time112,theti,it,nlobit
5021 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5022 double precision contr(maxlob)
5033 z(k)=x(k)-censc(k,j,it)
5039 Axk=Axk+gaussc(l,k,j,it)*z(l)
5045 expfac=expfac+Ax(k,j)*z(k)
5050 C As in the case of ebend, we want to avoid underflows in exponentiation and
5051 C subsequent NaNs and INFs in energy calculation.
5052 C Find the largest exponent
5055 if (emin.gt.contr(j)) emin=contr(j)
5059 C Compute the contribution to SC energy and derivatives
5063 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5064 escloc_i=escloc_i+expfac
5066 dersc(k)=dersc(k)+Ax(k,j)*expfac
5068 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5069 & +gaussc(1,2,j,it))*expfac
5073 dersc(1)=dersc(1)/cos(theti)**2
5074 dersc12=dersc12/cos(theti)**2
5075 escloci=-(dlog(escloc_i)-emin)
5077 dersc(j)=dersc(j)/escloc_i
5079 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5083 c----------------------------------------------------------------------------------
5084 subroutine esc(escloc)
5085 C Calculate the local energy of a side chain and its derivatives in the
5086 C corresponding virtual-bond valence angles THETA and the spherical angles
5087 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5088 C added by Urszula Kozlowska. 07/11/2007
5090 implicit real*8 (a-h,o-z)
5091 include 'DIMENSIONS'
5092 include 'COMMON.GEO'
5093 include 'COMMON.LOCAL'
5094 include 'COMMON.VAR'
5095 include 'COMMON.SCROT'
5096 include 'COMMON.INTERACT'
5097 include 'COMMON.DERIV'
5098 include 'COMMON.CHAIN'
5099 include 'COMMON.IOUNITS'
5100 include 'COMMON.NAMES'
5101 include 'COMMON.FFIELD'
5102 include 'COMMON.CONTROL'
5103 include 'COMMON.VECTORS'
5104 double precision x_prime(3),y_prime(3),z_prime(3)
5105 & , sumene,dsc_i,dp2_i,x(65),
5106 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5107 & de_dxx,de_dyy,de_dzz,de_dt
5108 double precision s1_t,s1_6_t,s2_t,s2_6_t
5110 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5111 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5112 & dt_dCi(3),dt_dCi1(3)
5113 common /sccalc/ time11,time12,time112,theti,it,nlobit
5116 do i=loc_start,loc_end
5117 costtab(i+1) =dcos(theta(i+1))
5118 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5119 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5120 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5121 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5122 cosfac=dsqrt(cosfac2)
5123 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5124 sinfac=dsqrt(sinfac2)
5126 if (it.eq.10) goto 1
5128 C Compute the axes of tghe local cartesian coordinates system; store in
5129 c x_prime, y_prime and z_prime
5136 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5137 C & dc_norm(3,i+nres)
5139 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5140 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5143 z_prime(j) = -uz(j,i-1)
5146 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5147 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5148 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5149 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5150 c & " xy",scalar(x_prime(1),y_prime(1)),
5151 c & " xz",scalar(x_prime(1),z_prime(1)),
5152 c & " yy",scalar(y_prime(1),y_prime(1)),
5153 c & " yz",scalar(y_prime(1),z_prime(1)),
5154 c & " zz",scalar(z_prime(1),z_prime(1))
5156 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5157 C to local coordinate system. Store in xx, yy, zz.
5163 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5164 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5165 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5172 C Compute the energy of the ith side cbain
5174 c write (2,*) "xx",xx," yy",yy," zz",zz
5177 x(j) = sc_parmin(j,it)
5180 Cc diagnostics - remove later
5182 yy1 = dsin(alph(2))*dcos(omeg(2))
5183 zz1 = -dsin(alph(2))*dsin(omeg(2))
5184 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5185 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5187 C," --- ", xx_w,yy_w,zz_w
5190 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5191 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5193 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5194 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5196 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5197 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5198 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5199 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5200 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5202 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5203 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5204 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5205 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5206 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5208 dsc_i = 0.743d0+x(61)
5210 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5211 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5212 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5213 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5214 s1=(1+x(63))/(0.1d0 + dscp1)
5215 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5216 s2=(1+x(65))/(0.1d0 + dscp2)
5217 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5218 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5219 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5220 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5222 c & dscp1,dscp2,sumene
5223 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5224 escloc = escloc + sumene
5225 c write (2,*) "i",i," escloc",sumene,escloc
5228 C This section to check the numerical derivatives of the energy of ith side
5229 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5230 C #define DEBUG in the code to turn it on.
5232 write (2,*) "sumene =",sumene
5236 write (2,*) xx,yy,zz
5237 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5238 de_dxx_num=(sumenep-sumene)/aincr
5240 write (2,*) "xx+ sumene from enesc=",sumenep
5243 write (2,*) xx,yy,zz
5244 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5245 de_dyy_num=(sumenep-sumene)/aincr
5247 write (2,*) "yy+ sumene from enesc=",sumenep
5250 write (2,*) xx,yy,zz
5251 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5252 de_dzz_num=(sumenep-sumene)/aincr
5254 write (2,*) "zz+ sumene from enesc=",sumenep
5255 costsave=cost2tab(i+1)
5256 sintsave=sint2tab(i+1)
5257 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5258 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5259 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5260 de_dt_num=(sumenep-sumene)/aincr
5261 write (2,*) " t+ sumene from enesc=",sumenep
5262 cost2tab(i+1)=costsave
5263 sint2tab(i+1)=sintsave
5264 C End of diagnostics section.
5267 C Compute the gradient of esc
5269 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5270 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5271 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5272 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5273 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5274 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5275 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5276 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5277 pom1=(sumene3*sint2tab(i+1)+sumene1)
5278 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5279 pom2=(sumene4*cost2tab(i+1)+sumene2)
5280 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5281 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5282 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5283 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5285 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5286 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5287 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5289 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5290 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5291 & +(pom1+pom2)*pom_dx
5293 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5296 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5297 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5298 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5300 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5301 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5302 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5303 & +x(59)*zz**2 +x(60)*xx*zz
5304 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5305 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5306 & +(pom1-pom2)*pom_dy
5308 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5311 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5312 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5313 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5314 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5315 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5316 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5317 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5318 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5320 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5323 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5324 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5325 & +pom1*pom_dt1+pom2*pom_dt2
5327 write(2,*), "de_dt = ", de_dt,de_dt_num
5331 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5332 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5333 cosfac2xx=cosfac2*xx
5334 sinfac2yy=sinfac2*yy
5336 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5338 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5340 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5341 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5342 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5343 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5344 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5345 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5346 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5347 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5348 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5349 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5353 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5354 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5357 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5358 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5359 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5361 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5362 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5366 dXX_Ctab(k,i)=dXX_Ci(k)
5367 dXX_C1tab(k,i)=dXX_Ci1(k)
5368 dYY_Ctab(k,i)=dYY_Ci(k)
5369 dYY_C1tab(k,i)=dYY_Ci1(k)
5370 dZZ_Ctab(k,i)=dZZ_Ci(k)
5371 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5372 dXX_XYZtab(k,i)=dXX_XYZ(k)
5373 dYY_XYZtab(k,i)=dYY_XYZ(k)
5374 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5378 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5379 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5380 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5381 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5382 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5384 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5385 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5386 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5387 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5388 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5389 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5390 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5391 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5393 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5394 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5396 C to check gradient call subroutine check_grad
5402 c------------------------------------------------------------------------------
5403 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5405 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5406 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5407 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5408 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5410 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5411 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5413 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5414 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5415 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5416 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5417 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5419 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5420 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5421 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5422 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5423 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5425 dsc_i = 0.743d0+x(61)
5427 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5428 & *(xx*cost2+yy*sint2))
5429 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5430 & *(xx*cost2-yy*sint2))
5431 s1=(1+x(63))/(0.1d0 + dscp1)
5432 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5433 s2=(1+x(65))/(0.1d0 + dscp2)
5434 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5435 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5436 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5441 c------------------------------------------------------------------------------
5442 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5444 C This procedure calculates two-body contact function g(rij) and its derivative:
5447 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5450 C where x=(rij-r0ij)/delta
5452 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5455 double precision rij,r0ij,eps0ij,fcont,fprimcont
5456 double precision x,x2,x4,delta
5460 if (x.lt.-1.0D0) then
5463 else if (x.le.1.0D0) then
5466 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5467 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5474 c------------------------------------------------------------------------------
5475 subroutine splinthet(theti,delta,ss,ssder)
5476 implicit real*8 (a-h,o-z)
5477 include 'DIMENSIONS'
5478 include 'COMMON.VAR'
5479 include 'COMMON.GEO'
5482 if (theti.gt.pipol) then
5483 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5485 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5490 c------------------------------------------------------------------------------
5491 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5493 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5494 double precision ksi,ksi2,ksi3,a1,a2,a3
5495 a1=fprim0*delta/(f1-f0)
5501 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5502 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5505 c------------------------------------------------------------------------------
5506 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5508 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5509 double precision ksi,ksi2,ksi3,a1,a2,a3
5514 a2=3*(f1x-f0x)-2*fprim0x*delta
5515 a3=fprim0x*delta-2*(f1x-f0x)
5516 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5519 C-----------------------------------------------------------------------------
5521 C-----------------------------------------------------------------------------
5522 subroutine etor(etors,edihcnstr)
5523 implicit real*8 (a-h,o-z)
5524 include 'DIMENSIONS'
5525 include 'COMMON.VAR'
5526 include 'COMMON.GEO'
5527 include 'COMMON.LOCAL'
5528 include 'COMMON.TORSION'
5529 include 'COMMON.INTERACT'
5530 include 'COMMON.DERIV'
5531 include 'COMMON.CHAIN'
5532 include 'COMMON.NAMES'
5533 include 'COMMON.IOUNITS'
5534 include 'COMMON.FFIELD'
5535 include 'COMMON.TORCNSTR'
5536 include 'COMMON.CONTROL'
5538 C Set lprn=.true. for debugging
5542 do i=iphi_start,iphi_end
5544 itori=itortyp(itype(i-2))
5545 itori1=itortyp(itype(i-1))
5548 C Proline-Proline pair is a special case...
5549 if (itori.eq.3 .and. itori1.eq.3) then
5550 if (phii.gt.-dwapi3) then
5552 fac=1.0D0/(1.0D0-cosphi)
5553 etorsi=v1(1,3,3)*fac
5554 etorsi=etorsi+etorsi
5555 etors=etors+etorsi-v1(1,3,3)
5556 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5557 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5560 v1ij=v1(j+1,itori,itori1)
5561 v2ij=v2(j+1,itori,itori1)
5564 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5565 if (energy_dec) etors_ii=etors_ii+
5566 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5567 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5571 v1ij=v1(j,itori,itori1)
5572 v2ij=v2(j,itori,itori1)
5575 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5576 if (energy_dec) etors_ii=etors_ii+
5577 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5578 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5581 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5584 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5585 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5586 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5587 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5588 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5590 ! 6/20/98 - dihedral angle constraints
5593 itori=idih_constr(i)
5596 if (difi.gt.drange(i)) then
5598 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5599 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5600 else if (difi.lt.-drange(i)) then
5602 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5603 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5605 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5606 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5608 ! write (iout,*) 'edihcnstr',edihcnstr
5611 c------------------------------------------------------------------------------
5612 subroutine etor_d(etors_d)
5616 c----------------------------------------------------------------------------
5618 subroutine etor(etors,edihcnstr)
5619 implicit real*8 (a-h,o-z)
5620 include 'DIMENSIONS'
5621 include 'COMMON.VAR'
5622 include 'COMMON.GEO'
5623 include 'COMMON.LOCAL'
5624 include 'COMMON.TORSION'
5625 include 'COMMON.INTERACT'
5626 include 'COMMON.DERIV'
5627 include 'COMMON.CHAIN'
5628 include 'COMMON.NAMES'
5629 include 'COMMON.IOUNITS'
5630 include 'COMMON.FFIELD'
5631 include 'COMMON.TORCNSTR'
5632 include 'COMMON.CONTROL'
5634 C Set lprn=.true. for debugging
5638 do i=iphi_start,iphi_end
5640 itori=itortyp(itype(i-2))
5641 itori1=itortyp(itype(i-1))
5644 C Regular cosine and sine terms
5645 do j=1,nterm(itori,itori1)
5646 v1ij=v1(j,itori,itori1)
5647 v2ij=v2(j,itori,itori1)
5650 etors=etors+v1ij*cosphi+v2ij*sinphi
5651 if (energy_dec) etors_ii=etors_ii+
5652 & v1ij*cosphi+v2ij*sinphi
5653 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5657 C E = SUM ----------------------------------- - v1
5658 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5660 cosphi=dcos(0.5d0*phii)
5661 sinphi=dsin(0.5d0*phii)
5662 do j=1,nlor(itori,itori1)
5663 vl1ij=vlor1(j,itori,itori1)
5664 vl2ij=vlor2(j,itori,itori1)
5665 vl3ij=vlor3(j,itori,itori1)
5666 pom=vl2ij*cosphi+vl3ij*sinphi
5667 pom1=1.0d0/(pom*pom+1.0d0)
5668 etors=etors+vl1ij*pom1
5669 if (energy_dec) etors_ii=etors_ii+
5672 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5674 C Subtract the constant term
5675 etors=etors-v0(itori,itori1)
5676 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5677 & 'etor',i,etors_ii-v0(itori,itori1)
5679 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5680 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5681 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5682 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5683 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5685 ! 6/20/98 - dihedral angle constraints
5687 c do i=1,ndih_constr
5688 do i=idihconstr_start,idihconstr_end
5689 itori=idih_constr(i)
5691 difi=pinorm(phii-phi0(i))
5692 if (difi.gt.drange(i)) then
5694 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5695 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5696 else if (difi.lt.-drange(i)) then
5698 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5699 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5703 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5704 cd & rad2deg*phi0(i), rad2deg*drange(i),
5705 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5707 cd write (iout,*) 'edihcnstr',edihcnstr
5710 c----------------------------------------------------------------------------
5711 subroutine etor_d(etors_d)
5712 C 6/23/01 Compute double torsional energy
5713 implicit real*8 (a-h,o-z)
5714 include 'DIMENSIONS'
5715 include 'COMMON.VAR'
5716 include 'COMMON.GEO'
5717 include 'COMMON.LOCAL'
5718 include 'COMMON.TORSION'
5719 include 'COMMON.INTERACT'
5720 include 'COMMON.DERIV'
5721 include 'COMMON.CHAIN'
5722 include 'COMMON.NAMES'
5723 include 'COMMON.IOUNITS'
5724 include 'COMMON.FFIELD'
5725 include 'COMMON.TORCNSTR'
5727 C Set lprn=.true. for debugging
5731 do i=iphid_start,iphid_end
5732 itori=itortyp(itype(i-2))
5733 itori1=itortyp(itype(i-1))
5734 itori2=itortyp(itype(i))
5739 C Regular cosine and sine terms
5740 do j=1,ntermd_1(itori,itori1,itori2)
5741 v1cij=v1c(1,j,itori,itori1,itori2)
5742 v1sij=v1s(1,j,itori,itori1,itori2)
5743 v2cij=v1c(2,j,itori,itori1,itori2)
5744 v2sij=v1s(2,j,itori,itori1,itori2)
5745 cosphi1=dcos(j*phii)
5746 sinphi1=dsin(j*phii)
5747 cosphi2=dcos(j*phii1)
5748 sinphi2=dsin(j*phii1)
5749 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5750 & v2cij*cosphi2+v2sij*sinphi2
5751 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5752 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5754 do k=2,ntermd_2(itori,itori1,itori2)
5756 v1cdij = v2c(k,l,itori,itori1,itori2)
5757 v2cdij = v2c(l,k,itori,itori1,itori2)
5758 v1sdij = v2s(k,l,itori,itori1,itori2)
5759 v2sdij = v2s(l,k,itori,itori1,itori2)
5760 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5761 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5762 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5763 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5764 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5765 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5766 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5767 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5768 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5769 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5772 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5773 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5778 c------------------------------------------------------------------------------
5779 subroutine eback_sc_corr(esccor)
5780 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5781 c conformational states; temporarily implemented as differences
5782 c between UNRES torsional potentials (dependent on three types of
5783 c residues) and the torsional potentials dependent on all 20 types
5784 c of residues computed from AM1 energy surfaces of terminally-blocked
5785 c amino-acid residues.
5786 implicit real*8 (a-h,o-z)
5787 include 'DIMENSIONS'
5788 include 'COMMON.VAR'
5789 include 'COMMON.GEO'
5790 include 'COMMON.LOCAL'
5791 include 'COMMON.TORSION'
5792 include 'COMMON.SCCOR'
5793 include 'COMMON.INTERACT'
5794 include 'COMMON.DERIV'
5795 include 'COMMON.CHAIN'
5796 include 'COMMON.NAMES'
5797 include 'COMMON.IOUNITS'
5798 include 'COMMON.FFIELD'
5799 include 'COMMON.CONTROL'
5801 C Set lprn=.true. for debugging
5804 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5806 do i=iphi_start,iphi_end
5813 v1ij=v1sccor(j,itori,itori1)
5814 v2ij=v2sccor(j,itori,itori1)
5817 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5818 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5821 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5822 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5823 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5824 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5828 c----------------------------------------------------------------------------
5829 subroutine multibody(ecorr)
5830 C This subroutine calculates multi-body contributions to energy following
5831 C the idea of Skolnick et al. If side chains I and J make a contact and
5832 C at the same time side chains I+1 and J+1 make a contact, an extra
5833 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5834 implicit real*8 (a-h,o-z)
5835 include 'DIMENSIONS'
5836 include 'COMMON.IOUNITS'
5837 include 'COMMON.DERIV'
5838 include 'COMMON.INTERACT'
5839 include 'COMMON.CONTACTS'
5840 double precision gx(3),gx1(3)
5843 C Set lprn=.true. for debugging
5847 write (iout,'(a)') 'Contact function values:'
5849 write (iout,'(i2,20(1x,i2,f10.5))')
5850 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5865 num_conti=num_cont(i)
5866 num_conti1=num_cont(i1)
5871 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5872 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5873 cd & ' ishift=',ishift
5874 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5875 C The system gains extra energy.
5876 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5877 endif ! j1==j+-ishift
5886 c------------------------------------------------------------------------------
5887 double precision function esccorr(i,j,k,l,jj,kk)
5888 implicit real*8 (a-h,o-z)
5889 include 'DIMENSIONS'
5890 include 'COMMON.IOUNITS'
5891 include 'COMMON.DERIV'
5892 include 'COMMON.INTERACT'
5893 include 'COMMON.CONTACTS'
5894 double precision gx(3),gx1(3)
5899 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5900 C Calculate the multi-body contribution to energy.
5901 C Calculate multi-body contributions to the gradient.
5902 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5903 cd & k,l,(gacont(m,kk,k),m=1,3)
5905 gx(m) =ekl*gacont(m,jj,i)
5906 gx1(m)=eij*gacont(m,kk,k)
5907 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5908 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5909 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5910 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5914 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5919 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5925 c------------------------------------------------------------------------------
5926 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5927 C This subroutine calculates multi-body contributions to hydrogen-bonding
5928 implicit real*8 (a-h,o-z)
5929 include 'DIMENSIONS'
5930 include 'COMMON.IOUNITS'
5933 parameter (max_cont=maxconts)
5934 parameter (max_dim=26)
5935 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5936 double precision zapas(max_dim,maxconts,max_fg_procs),
5937 & zapas_recv(max_dim,maxconts,max_fg_procs)
5938 common /przechowalnia/ zapas
5939 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5940 & status_array(MPI_STATUS_SIZE,maxconts*2)
5942 include 'COMMON.SETUP'
5943 include 'COMMON.FFIELD'
5944 include 'COMMON.DERIV'
5945 include 'COMMON.INTERACT'
5946 include 'COMMON.CONTACTS'
5947 include 'COMMON.CONTROL'
5948 include 'COMMON.LOCAL'
5949 double precision gx(3),gx1(3),time00
5952 C Set lprn=.true. for debugging
5957 if (nfgtasks.le.1) goto 30
5959 write (iout,'(a)') 'Contact function values before RECEIVE:'
5961 write (iout,'(2i3,50(1x,i2,f5.2))')
5962 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5963 & j=1,num_cont_hb(i))
5967 do i=1,ntask_cont_from
5970 do i=1,ntask_cont_to
5973 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5975 C Make the list of contacts to send to send to other procesors
5976 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5978 do i=iturn3_start,iturn3_end
5979 c write (iout,*) "make contact list turn3",i," num_cont",
5981 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5983 do i=iturn4_start,iturn4_end
5984 c write (iout,*) "make contact list turn4",i," num_cont",
5986 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5990 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5992 do j=1,num_cont_hb(i)
5995 iproc=iint_sent_local(k,jjc,ii)
5996 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5997 if (iproc.gt.0) then
5998 ncont_sent(iproc)=ncont_sent(iproc)+1
5999 nn=ncont_sent(iproc)
6001 zapas(2,nn,iproc)=jjc
6002 zapas(3,nn,iproc)=facont_hb(j,i)
6003 zapas(4,nn,iproc)=ees0p(j,i)
6004 zapas(5,nn,iproc)=ees0m(j,i)
6005 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6006 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6007 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6008 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6009 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6010 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6011 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6012 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6013 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6014 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6015 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6016 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6017 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6018 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6019 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6020 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6021 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6022 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6023 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6024 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6025 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6032 & "Numbers of contacts to be sent to other processors",
6033 & (ncont_sent(i),i=1,ntask_cont_to)
6034 write (iout,*) "Contacts sent"
6035 do ii=1,ntask_cont_to
6037 iproc=itask_cont_to(ii)
6038 write (iout,*) nn," contacts to processor",iproc,
6039 & " of CONT_TO_COMM group"
6041 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6049 CorrelID1=nfgtasks+fg_rank+1
6051 C Receive the numbers of needed contacts from other processors
6052 do ii=1,ntask_cont_from
6053 iproc=itask_cont_from(ii)
6055 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6056 & FG_COMM,req(ireq),IERR)
6058 c write (iout,*) "IRECV ended"
6060 C Send the number of contacts needed by other processors
6061 do ii=1,ntask_cont_to
6062 iproc=itask_cont_to(ii)
6064 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6065 & FG_COMM,req(ireq),IERR)
6067 c write (iout,*) "ISEND ended"
6068 c write (iout,*) "number of requests (nn)",ireq
6071 & call MPI_Waitall(ireq,req,status_array,ierr)
6073 c & "Numbers of contacts to be received from other processors",
6074 c & (ncont_recv(i),i=1,ntask_cont_from)
6078 do ii=1,ntask_cont_from
6079 iproc=itask_cont_from(ii)
6081 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6082 c & " of CONT_TO_COMM group"
6086 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6087 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6088 c write (iout,*) "ireq,req",ireq,req(ireq)
6091 C Send the contacts to processors that need them
6092 do ii=1,ntask_cont_to
6093 iproc=itask_cont_to(ii)
6095 c write (iout,*) nn," contacts to processor",iproc,
6096 c & " of CONT_TO_COMM group"
6099 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6100 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6101 c write (iout,*) "ireq,req",ireq,req(ireq)
6103 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6107 c write (iout,*) "number of requests (contacts)",ireq
6108 c write (iout,*) "req",(req(i),i=1,4)
6111 & call MPI_Waitall(ireq,req,status_array,ierr)
6112 do iii=1,ntask_cont_from
6113 iproc=itask_cont_from(iii)
6116 write (iout,*) "Received",nn," contacts from processor",iproc,
6117 & " of CONT_FROM_COMM group"
6120 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6125 ii=zapas_recv(1,i,iii)
6126 c Flag the received contacts to prevent double-counting
6127 jj=-zapas_recv(2,i,iii)
6128 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6130 nnn=num_cont_hb(ii)+1
6133 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6134 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6135 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6136 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6137 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6138 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6139 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6140 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6141 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6142 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6143 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6144 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6145 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6146 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6147 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6148 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6149 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6150 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6151 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6152 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6153 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6154 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6155 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6156 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6161 write (iout,'(a)') 'Contact function values after receive:'
6163 write (iout,'(2i3,50(1x,i3,f5.2))')
6164 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6165 & j=1,num_cont_hb(i))
6172 write (iout,'(a)') 'Contact function values:'
6174 write (iout,'(2i3,50(1x,i3,f5.2))')
6175 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6176 & j=1,num_cont_hb(i))
6180 C Remove the loop below after debugging !!!
6187 C Calculate the local-electrostatic correlation terms
6188 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6190 num_conti=num_cont_hb(i)
6191 num_conti1=num_cont_hb(i+1)
6198 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6199 c & ' jj=',jj,' kk=',kk
6200 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6201 & .or. j.lt.0 .and. j1.gt.0) .and.
6202 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6203 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6204 C The system gains extra energy.
6205 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6206 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6207 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6209 else if (j1.eq.j) then
6210 C Contacts I-J and I-(J+1) occur simultaneously.
6211 C The system loses extra energy.
6212 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6217 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6218 c & ' jj=',jj,' kk=',kk
6220 C Contacts I-J and (I+1)-J occur simultaneously.
6221 C The system loses extra energy.
6222 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6229 c------------------------------------------------------------------------------
6230 subroutine add_hb_contact(ii,jj,itask)
6231 implicit real*8 (a-h,o-z)
6232 include "DIMENSIONS"
6233 include "COMMON.IOUNITS"
6236 parameter (max_cont=maxconts)
6237 parameter (max_dim=26)
6238 include "COMMON.CONTACTS"
6239 double precision zapas(max_dim,maxconts,max_fg_procs),
6240 & zapas_recv(max_dim,maxconts,max_fg_procs)
6241 common /przechowalnia/ zapas
6242 integer i,j,ii,jj,iproc,itask(4),nn
6243 c write (iout,*) "itask",itask
6246 if (iproc.gt.0) then
6247 do j=1,num_cont_hb(ii)
6249 c write (iout,*) "i",ii," j",jj," jjc",jjc
6251 ncont_sent(iproc)=ncont_sent(iproc)+1
6252 nn=ncont_sent(iproc)
6253 zapas(1,nn,iproc)=ii
6254 zapas(2,nn,iproc)=jjc
6255 zapas(3,nn,iproc)=facont_hb(j,ii)
6256 zapas(4,nn,iproc)=ees0p(j,ii)
6257 zapas(5,nn,iproc)=ees0m(j,ii)
6258 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6259 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6260 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6261 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6262 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6263 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6264 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6265 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6266 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6267 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6268 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6269 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6270 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6271 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6272 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6273 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6274 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6275 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6276 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6277 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6278 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6286 c------------------------------------------------------------------------------
6287 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6289 C This subroutine calculates multi-body contributions to hydrogen-bonding
6290 implicit real*8 (a-h,o-z)
6291 include 'DIMENSIONS'
6292 include 'COMMON.IOUNITS'
6295 parameter (max_cont=maxconts)
6296 parameter (max_dim=70)
6297 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6298 double precision zapas(max_dim,maxconts,max_fg_procs),
6299 & zapas_recv(max_dim,maxconts,max_fg_procs)
6300 common /przechowalnia/ zapas
6301 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6302 & status_array(MPI_STATUS_SIZE,maxconts*2)
6304 include 'COMMON.SETUP'
6305 include 'COMMON.FFIELD'
6306 include 'COMMON.DERIV'
6307 include 'COMMON.LOCAL'
6308 include 'COMMON.INTERACT'
6309 include 'COMMON.CONTACTS'
6310 include 'COMMON.CHAIN'
6311 include 'COMMON.CONTROL'
6312 double precision gx(3),gx1(3)
6313 integer num_cont_hb_old(maxres)
6315 double precision eello4,eello5,eelo6,eello_turn6
6316 external eello4,eello5,eello6,eello_turn6
6317 C Set lprn=.true. for debugging
6322 num_cont_hb_old(i)=num_cont_hb(i)
6326 if (nfgtasks.le.1) goto 30
6328 write (iout,'(a)') 'Contact function values before RECEIVE:'
6330 write (iout,'(2i3,50(1x,i2,f5.2))')
6331 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6332 & j=1,num_cont_hb(i))
6336 do i=1,ntask_cont_from
6339 do i=1,ntask_cont_to
6342 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6344 C Make the list of contacts to send to send to other procesors
6345 do i=iturn3_start,iturn3_end
6346 c write (iout,*) "make contact list turn3",i," num_cont",
6348 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6350 do i=iturn4_start,iturn4_end
6351 c write (iout,*) "make contact list turn4",i," num_cont",
6353 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6357 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6359 do j=1,num_cont_hb(i)
6362 iproc=iint_sent_local(k,jjc,ii)
6363 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6364 if (iproc.ne.0) then
6365 ncont_sent(iproc)=ncont_sent(iproc)+1
6366 nn=ncont_sent(iproc)
6368 zapas(2,nn,iproc)=jjc
6369 zapas(3,nn,iproc)=d_cont(j,i)
6373 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6378 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6386 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6397 & "Numbers of contacts to be sent to other processors",
6398 & (ncont_sent(i),i=1,ntask_cont_to)
6399 write (iout,*) "Contacts sent"
6400 do ii=1,ntask_cont_to
6402 iproc=itask_cont_to(ii)
6403 write (iout,*) nn," contacts to processor",iproc,
6404 & " of CONT_TO_COMM group"
6406 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6414 CorrelID1=nfgtasks+fg_rank+1
6416 C Receive the numbers of needed contacts from other processors
6417 do ii=1,ntask_cont_from
6418 iproc=itask_cont_from(ii)
6420 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6421 & FG_COMM,req(ireq),IERR)
6423 c write (iout,*) "IRECV ended"
6425 C Send the number of contacts needed by other processors
6426 do ii=1,ntask_cont_to
6427 iproc=itask_cont_to(ii)
6429 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6430 & FG_COMM,req(ireq),IERR)
6432 c write (iout,*) "ISEND ended"
6433 c write (iout,*) "number of requests (nn)",ireq
6436 & call MPI_Waitall(ireq,req,status_array,ierr)
6438 c & "Numbers of contacts to be received from other processors",
6439 c & (ncont_recv(i),i=1,ntask_cont_from)
6443 do ii=1,ntask_cont_from
6444 iproc=itask_cont_from(ii)
6446 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6447 c & " of CONT_TO_COMM group"
6451 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6452 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6453 c write (iout,*) "ireq,req",ireq,req(ireq)
6456 C Send the contacts to processors that need them
6457 do ii=1,ntask_cont_to
6458 iproc=itask_cont_to(ii)
6460 c write (iout,*) nn," contacts to processor",iproc,
6461 c & " of CONT_TO_COMM group"
6464 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6465 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6466 c write (iout,*) "ireq,req",ireq,req(ireq)
6468 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6472 c write (iout,*) "number of requests (contacts)",ireq
6473 c write (iout,*) "req",(req(i),i=1,4)
6476 & call MPI_Waitall(ireq,req,status_array,ierr)
6477 do iii=1,ntask_cont_from
6478 iproc=itask_cont_from(iii)
6481 write (iout,*) "Received",nn," contacts from processor",iproc,
6482 & " of CONT_FROM_COMM group"
6485 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6490 ii=zapas_recv(1,i,iii)
6491 c Flag the received contacts to prevent double-counting
6492 jj=-zapas_recv(2,i,iii)
6493 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6495 nnn=num_cont_hb(ii)+1
6498 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6502 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6507 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6515 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6524 write (iout,'(a)') 'Contact function values after receive:'
6526 write (iout,'(2i3,50(1x,i3,5f6.3))')
6527 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6528 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6535 write (iout,'(a)') 'Contact function values:'
6537 write (iout,'(2i3,50(1x,i2,5f6.3))')
6538 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6539 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6545 C Remove the loop below after debugging !!!
6552 C Calculate the dipole-dipole interaction energies
6553 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6554 do i=iatel_s,iatel_e+1
6555 num_conti=num_cont_hb(i)
6564 C Calculate the local-electrostatic correlation terms
6565 c write (iout,*) "gradcorr5 in eello5 before loop"
6567 c write (iout,'(i5,3f10.5)')
6568 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6570 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6571 c write (iout,*) "corr loop i",i
6573 num_conti=num_cont_hb(i)
6574 num_conti1=num_cont_hb(i+1)
6581 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6582 c & ' jj=',jj,' kk=',kk
6583 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6584 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6585 & .or. j.lt.0 .and. j1.gt.0) .and.
6586 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6587 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6588 C The system gains extra energy.
6590 sqd1=dsqrt(d_cont(jj,i))
6591 sqd2=dsqrt(d_cont(kk,i1))
6592 sred_geom = sqd1*sqd2
6593 IF (sred_geom.lt.cutoff_corr) THEN
6594 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6596 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6597 cd & ' jj=',jj,' kk=',kk
6598 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6599 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6601 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6602 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6605 cd write (iout,*) 'sred_geom=',sred_geom,
6606 cd & ' ekont=',ekont,' fprim=',fprimcont,
6607 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6608 cd write (iout,*) "g_contij",g_contij
6609 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6610 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6611 call calc_eello(i,jp,i+1,jp1,jj,kk)
6612 if (wcorr4.gt.0.0d0)
6613 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6614 if (energy_dec.and.wcorr4.gt.0.0d0)
6615 1 write (iout,'(a6,4i5,0pf7.3)')
6616 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6617 c write (iout,*) "gradcorr5 before eello5"
6619 c write (iout,'(i5,3f10.5)')
6620 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6622 if (wcorr5.gt.0.0d0)
6623 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6624 c write (iout,*) "gradcorr5 after eello5"
6626 c write (iout,'(i5,3f10.5)')
6627 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6629 if (energy_dec.and.wcorr5.gt.0.0d0)
6630 1 write (iout,'(a6,4i5,0pf7.3)')
6631 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6632 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6633 cd write(2,*)'ijkl',i,jp,i+1,jp1
6634 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6635 & .or. wturn6.eq.0.0d0))then
6636 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6637 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6638 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6639 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6640 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6641 cd & 'ecorr6=',ecorr6
6642 cd write (iout,'(4e15.5)') sred_geom,
6643 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6644 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6645 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6646 else if (wturn6.gt.0.0d0
6647 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6648 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6649 eturn6=eturn6+eello_turn6(i,jj,kk)
6650 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6651 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6652 cd write (2,*) 'multibody_eello:eturn6',eturn6
6661 num_cont_hb(i)=num_cont_hb_old(i)
6663 c write (iout,*) "gradcorr5 in eello5"
6665 c write (iout,'(i5,3f10.5)')
6666 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6670 c------------------------------------------------------------------------------
6671 subroutine add_hb_contact_eello(ii,jj,itask)
6672 implicit real*8 (a-h,o-z)
6673 include "DIMENSIONS"
6674 include "COMMON.IOUNITS"
6677 parameter (max_cont=maxconts)
6678 parameter (max_dim=70)
6679 include "COMMON.CONTACTS"
6680 double precision zapas(max_dim,maxconts,max_fg_procs),
6681 & zapas_recv(max_dim,maxconts,max_fg_procs)
6682 common /przechowalnia/ zapas
6683 integer i,j,ii,jj,iproc,itask(4),nn
6684 c write (iout,*) "itask",itask
6687 if (iproc.gt.0) then
6688 do j=1,num_cont_hb(ii)
6690 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6692 ncont_sent(iproc)=ncont_sent(iproc)+1
6693 nn=ncont_sent(iproc)
6694 zapas(1,nn,iproc)=ii
6695 zapas(2,nn,iproc)=jjc
6696 zapas(3,nn,iproc)=d_cont(j,ii)
6700 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6705 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6713 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6725 c------------------------------------------------------------------------------
6726 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6727 implicit real*8 (a-h,o-z)
6728 include 'DIMENSIONS'
6729 include 'COMMON.IOUNITS'
6730 include 'COMMON.DERIV'
6731 include 'COMMON.INTERACT'
6732 include 'COMMON.CONTACTS'
6733 double precision gx(3),gx1(3)
6743 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6744 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6745 C Following 4 lines for diagnostics.
6750 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6751 c & 'Contacts ',i,j,
6752 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6753 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6755 C Calculate the multi-body contribution to energy.
6756 c ecorr=ecorr+ekont*ees
6757 C Calculate multi-body contributions to the gradient.
6758 coeffpees0pij=coeffp*ees0pij
6759 coeffmees0mij=coeffm*ees0mij
6760 coeffpees0pkl=coeffp*ees0pkl
6761 coeffmees0mkl=coeffm*ees0mkl
6763 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6764 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6765 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6766 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6767 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6768 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6769 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6770 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6771 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6772 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6773 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6774 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6775 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6776 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6777 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6778 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6779 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6780 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6781 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6782 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6783 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6784 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6785 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6786 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6787 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6792 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6793 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6794 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6795 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6800 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6801 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6802 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6803 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6806 c write (iout,*) "ehbcorr",ekont*ees
6811 C---------------------------------------------------------------------------
6812 subroutine dipole(i,j,jj)
6813 implicit real*8 (a-h,o-z)
6814 include 'DIMENSIONS'
6815 include 'COMMON.IOUNITS'
6816 include 'COMMON.CHAIN'
6817 include 'COMMON.FFIELD'
6818 include 'COMMON.DERIV'
6819 include 'COMMON.INTERACT'
6820 include 'COMMON.CONTACTS'
6821 include 'COMMON.TORSION'
6822 include 'COMMON.VAR'
6823 include 'COMMON.GEO'
6824 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6826 iti1 = itortyp(itype(i+1))
6827 if (j.lt.nres-1) then
6828 itj1 = itortyp(itype(j+1))
6833 dipi(iii,1)=Ub2(iii,i)
6834 dipderi(iii)=Ub2der(iii,i)
6835 dipi(iii,2)=b1(iii,iti1)
6836 dipj(iii,1)=Ub2(iii,j)
6837 dipderj(iii)=Ub2der(iii,j)
6838 dipj(iii,2)=b1(iii,itj1)
6842 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6845 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6852 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6856 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6861 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6862 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6864 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6866 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6868 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6873 C---------------------------------------------------------------------------
6874 subroutine calc_eello(i,j,k,l,jj,kk)
6876 C This subroutine computes matrices and vectors needed to calculate
6877 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6879 implicit real*8 (a-h,o-z)
6880 include 'DIMENSIONS'
6881 include 'COMMON.IOUNITS'
6882 include 'COMMON.CHAIN'
6883 include 'COMMON.DERIV'
6884 include 'COMMON.INTERACT'
6885 include 'COMMON.CONTACTS'
6886 include 'COMMON.TORSION'
6887 include 'COMMON.VAR'
6888 include 'COMMON.GEO'
6889 include 'COMMON.FFIELD'
6890 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6891 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6894 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6895 cd & ' jj=',jj,' kk=',kk
6896 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6897 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6898 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6901 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6902 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6905 call transpose2(aa1(1,1),aa1t(1,1))
6906 call transpose2(aa2(1,1),aa2t(1,1))
6909 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6910 & aa1tder(1,1,lll,kkk))
6911 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6912 & aa2tder(1,1,lll,kkk))
6916 C parallel orientation of the two CA-CA-CA frames.
6918 iti=itortyp(itype(i))
6922 itk1=itortyp(itype(k+1))
6923 itj=itortyp(itype(j))
6924 if (l.lt.nres-1) then
6925 itl1=itortyp(itype(l+1))
6929 C A1 kernel(j+1) A2T
6931 cd write (iout,'(3f10.5,5x,3f10.5)')
6932 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6934 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6935 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6936 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6937 C Following matrices are needed only for 6-th order cumulants
6938 IF (wcorr6.gt.0.0d0) THEN
6939 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6940 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6941 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6942 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6943 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6944 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6945 & ADtEAderx(1,1,1,1,1,1))
6947 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6948 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6949 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6950 & ADtEA1derx(1,1,1,1,1,1))
6952 C End 6-th order cumulants
6955 cd write (2,*) 'In calc_eello6'
6957 cd write (2,*) 'iii=',iii
6959 cd write (2,*) 'kkk=',kkk
6961 cd write (2,'(3(2f10.5),5x)')
6962 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6967 call transpose2(EUgder(1,1,k),auxmat(1,1))
6968 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6969 call transpose2(EUg(1,1,k),auxmat(1,1))
6970 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6971 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6975 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6976 & EAEAderx(1,1,lll,kkk,iii,1))
6980 C A1T kernel(i+1) A2
6981 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6982 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6983 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6984 C Following matrices are needed only for 6-th order cumulants
6985 IF (wcorr6.gt.0.0d0) THEN
6986 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6987 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6988 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6989 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6990 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6991 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6992 & ADtEAderx(1,1,1,1,1,2))
6993 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6994 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6995 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6996 & ADtEA1derx(1,1,1,1,1,2))
6998 C End 6-th order cumulants
6999 call transpose2(EUgder(1,1,l),auxmat(1,1))
7000 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7001 call transpose2(EUg(1,1,l),auxmat(1,1))
7002 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7003 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7007 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7008 & EAEAderx(1,1,lll,kkk,iii,2))
7013 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7014 C They are needed only when the fifth- or the sixth-order cumulants are
7016 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7017 call transpose2(AEA(1,1,1),auxmat(1,1))
7018 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7019 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7020 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7021 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7022 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7023 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7024 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7025 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7026 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7027 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7028 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7029 call transpose2(AEA(1,1,2),auxmat(1,1))
7030 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7031 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7032 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7033 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7034 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7035 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7036 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7037 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7038 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7039 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7040 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7041 C Calculate the Cartesian derivatives of the vectors.
7045 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7046 call matvec2(auxmat(1,1),b1(1,iti),
7047 & AEAb1derx(1,lll,kkk,iii,1,1))
7048 call matvec2(auxmat(1,1),Ub2(1,i),
7049 & AEAb2derx(1,lll,kkk,iii,1,1))
7050 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7051 & AEAb1derx(1,lll,kkk,iii,2,1))
7052 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7053 & AEAb2derx(1,lll,kkk,iii,2,1))
7054 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7055 call matvec2(auxmat(1,1),b1(1,itj),
7056 & AEAb1derx(1,lll,kkk,iii,1,2))
7057 call matvec2(auxmat(1,1),Ub2(1,j),
7058 & AEAb2derx(1,lll,kkk,iii,1,2))
7059 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7060 & AEAb1derx(1,lll,kkk,iii,2,2))
7061 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7062 & AEAb2derx(1,lll,kkk,iii,2,2))
7069 C Antiparallel orientation of the two CA-CA-CA frames.
7071 iti=itortyp(itype(i))
7075 itk1=itortyp(itype(k+1))
7076 itl=itortyp(itype(l))
7077 itj=itortyp(itype(j))
7078 if (j.lt.nres-1) then
7079 itj1=itortyp(itype(j+1))
7083 C A2 kernel(j-1)T A1T
7084 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7085 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7086 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7087 C Following matrices are needed only for 6-th order cumulants
7088 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7089 & j.eq.i+4 .and. l.eq.i+3)) THEN
7090 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7091 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7092 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7093 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7094 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7095 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7096 & ADtEAderx(1,1,1,1,1,1))
7097 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7098 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7099 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7100 & ADtEA1derx(1,1,1,1,1,1))
7102 C End 6-th order cumulants
7103 call transpose2(EUgder(1,1,k),auxmat(1,1))
7104 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7105 call transpose2(EUg(1,1,k),auxmat(1,1))
7106 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7107 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7111 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7112 & EAEAderx(1,1,lll,kkk,iii,1))
7116 C A2T kernel(i+1)T A1
7117 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7118 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7119 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7120 C Following matrices are needed only for 6-th order cumulants
7121 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7122 & j.eq.i+4 .and. l.eq.i+3)) THEN
7123 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7124 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7125 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7126 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7127 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7128 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7129 & ADtEAderx(1,1,1,1,1,2))
7130 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7131 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7132 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7133 & ADtEA1derx(1,1,1,1,1,2))
7135 C End 6-th order cumulants
7136 call transpose2(EUgder(1,1,j),auxmat(1,1))
7137 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7138 call transpose2(EUg(1,1,j),auxmat(1,1))
7139 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7140 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7144 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7145 & EAEAderx(1,1,lll,kkk,iii,2))
7150 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7151 C They are needed only when the fifth- or the sixth-order cumulants are
7153 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7154 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7155 call transpose2(AEA(1,1,1),auxmat(1,1))
7156 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7157 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7158 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7159 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7160 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7161 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7162 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7163 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7164 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7165 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7166 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7167 call transpose2(AEA(1,1,2),auxmat(1,1))
7168 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7169 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7170 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7171 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7172 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7173 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7174 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7175 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7176 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7177 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7178 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7179 C Calculate the Cartesian derivatives of the vectors.
7183 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7184 call matvec2(auxmat(1,1),b1(1,iti),
7185 & AEAb1derx(1,lll,kkk,iii,1,1))
7186 call matvec2(auxmat(1,1),Ub2(1,i),
7187 & AEAb2derx(1,lll,kkk,iii,1,1))
7188 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7189 & AEAb1derx(1,lll,kkk,iii,2,1))
7190 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7191 & AEAb2derx(1,lll,kkk,iii,2,1))
7192 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7193 call matvec2(auxmat(1,1),b1(1,itl),
7194 & AEAb1derx(1,lll,kkk,iii,1,2))
7195 call matvec2(auxmat(1,1),Ub2(1,l),
7196 & AEAb2derx(1,lll,kkk,iii,1,2))
7197 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7198 & AEAb1derx(1,lll,kkk,iii,2,2))
7199 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7200 & AEAb2derx(1,lll,kkk,iii,2,2))
7209 C---------------------------------------------------------------------------
7210 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7211 & KK,KKderg,AKA,AKAderg,AKAderx)
7215 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7216 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7217 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7222 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7224 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7227 cd if (lprn) write (2,*) 'In kernel'
7229 cd if (lprn) write (2,*) 'kkk=',kkk
7231 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7232 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7234 cd write (2,*) 'lll=',lll
7235 cd write (2,*) 'iii=1'
7237 cd write (2,'(3(2f10.5),5x)')
7238 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7241 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7242 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7244 cd write (2,*) 'lll=',lll
7245 cd write (2,*) 'iii=2'
7247 cd write (2,'(3(2f10.5),5x)')
7248 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7255 C---------------------------------------------------------------------------
7256 double precision function eello4(i,j,k,l,jj,kk)
7257 implicit real*8 (a-h,o-z)
7258 include 'DIMENSIONS'
7259 include 'COMMON.IOUNITS'
7260 include 'COMMON.CHAIN'
7261 include 'COMMON.DERIV'
7262 include 'COMMON.INTERACT'
7263 include 'COMMON.CONTACTS'
7264 include 'COMMON.TORSION'
7265 include 'COMMON.VAR'
7266 include 'COMMON.GEO'
7267 double precision pizda(2,2),ggg1(3),ggg2(3)
7268 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7272 cd print *,'eello4:',i,j,k,l,jj,kk
7273 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7274 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7275 cold eij=facont_hb(jj,i)
7276 cold ekl=facont_hb(kk,k)
7278 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7279 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7280 gcorr_loc(k-1)=gcorr_loc(k-1)
7281 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7283 gcorr_loc(l-1)=gcorr_loc(l-1)
7284 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7286 gcorr_loc(j-1)=gcorr_loc(j-1)
7287 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7292 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7293 & -EAEAderx(2,2,lll,kkk,iii,1)
7294 cd derx(lll,kkk,iii)=0.0d0
7298 cd gcorr_loc(l-1)=0.0d0
7299 cd gcorr_loc(j-1)=0.0d0
7300 cd gcorr_loc(k-1)=0.0d0
7302 cd write (iout,*)'Contacts have occurred for peptide groups',
7303 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7304 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7305 if (j.lt.nres-1) then
7312 if (l.lt.nres-1) then
7320 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7321 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7322 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7323 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7324 cgrad ghalf=0.5d0*ggg1(ll)
7325 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7326 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7327 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7328 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7329 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7330 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7331 cgrad ghalf=0.5d0*ggg2(ll)
7332 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7333 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7334 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7335 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7336 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7337 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7341 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7346 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7351 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7356 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7360 cd write (2,*) iii,gcorr_loc(iii)
7363 cd write (2,*) 'ekont',ekont
7364 cd write (iout,*) 'eello4',ekont*eel4
7367 C---------------------------------------------------------------------------
7368 double precision function eello5(i,j,k,l,jj,kk)
7369 implicit real*8 (a-h,o-z)
7370 include 'DIMENSIONS'
7371 include 'COMMON.IOUNITS'
7372 include 'COMMON.CHAIN'
7373 include 'COMMON.DERIV'
7374 include 'COMMON.INTERACT'
7375 include 'COMMON.CONTACTS'
7376 include 'COMMON.TORSION'
7377 include 'COMMON.VAR'
7378 include 'COMMON.GEO'
7379 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7380 double precision ggg1(3),ggg2(3)
7381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7386 C /l\ / \ \ / \ / \ / C
7387 C / \ / \ \ / \ / \ / C
7388 C j| o |l1 | o | o| o | | o |o C
7389 C \ |/k\| |/ \| / |/ \| |/ \| C
7390 C \i/ \ / \ / / \ / \ C
7392 C (I) (II) (III) (IV) C
7394 C eello5_1 eello5_2 eello5_3 eello5_4 C
7396 C Antiparallel chains C
7399 C /j\ / \ \ / \ / \ / C
7400 C / \ / \ \ / \ / \ / C
7401 C j1| o |l | o | o| o | | o |o C
7402 C \ |/k\| |/ \| / |/ \| |/ \| C
7403 C \i/ \ / \ / / \ / \ C
7405 C (I) (II) (III) (IV) C
7407 C eello5_1 eello5_2 eello5_3 eello5_4 C
7409 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7411 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7412 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7417 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7419 itk=itortyp(itype(k))
7420 itl=itortyp(itype(l))
7421 itj=itortyp(itype(j))
7426 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7427 cd & eel5_3_num,eel5_4_num)
7431 derx(lll,kkk,iii)=0.0d0
7435 cd eij=facont_hb(jj,i)
7436 cd ekl=facont_hb(kk,k)
7438 cd write (iout,*)'Contacts have occurred for peptide groups',
7439 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7441 C Contribution from the graph I.
7442 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7443 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7444 call transpose2(EUg(1,1,k),auxmat(1,1))
7445 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7446 vv(1)=pizda(1,1)-pizda(2,2)
7447 vv(2)=pizda(1,2)+pizda(2,1)
7448 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7449 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7450 C Explicit gradient in virtual-dihedral angles.
7451 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7452 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7453 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7454 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7455 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7456 vv(1)=pizda(1,1)-pizda(2,2)
7457 vv(2)=pizda(1,2)+pizda(2,1)
7458 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7459 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7460 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7461 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7462 vv(1)=pizda(1,1)-pizda(2,2)
7463 vv(2)=pizda(1,2)+pizda(2,1)
7465 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7466 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7467 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7469 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7470 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7471 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7473 C Cartesian gradient
7477 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7479 vv(1)=pizda(1,1)-pizda(2,2)
7480 vv(2)=pizda(1,2)+pizda(2,1)
7481 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7482 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7483 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7489 C Contribution from graph II
7490 call transpose2(EE(1,1,itk),auxmat(1,1))
7491 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7492 vv(1)=pizda(1,1)+pizda(2,2)
7493 vv(2)=pizda(2,1)-pizda(1,2)
7494 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7495 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7496 C Explicit gradient in virtual-dihedral angles.
7497 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7498 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7499 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7500 vv(1)=pizda(1,1)+pizda(2,2)
7501 vv(2)=pizda(2,1)-pizda(1,2)
7503 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7504 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7505 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7507 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7508 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7509 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7511 C Cartesian gradient
7515 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7517 vv(1)=pizda(1,1)+pizda(2,2)
7518 vv(2)=pizda(2,1)-pizda(1,2)
7519 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7520 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7521 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7529 C Parallel orientation
7530 C Contribution from graph III
7531 call transpose2(EUg(1,1,l),auxmat(1,1))
7532 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7533 vv(1)=pizda(1,1)-pizda(2,2)
7534 vv(2)=pizda(1,2)+pizda(2,1)
7535 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7536 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7537 C Explicit gradient in virtual-dihedral angles.
7538 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7539 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7540 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7541 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7542 vv(1)=pizda(1,1)-pizda(2,2)
7543 vv(2)=pizda(1,2)+pizda(2,1)
7544 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7545 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7546 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7547 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7548 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7549 vv(1)=pizda(1,1)-pizda(2,2)
7550 vv(2)=pizda(1,2)+pizda(2,1)
7551 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7552 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7553 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7554 C Cartesian gradient
7558 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7560 vv(1)=pizda(1,1)-pizda(2,2)
7561 vv(2)=pizda(1,2)+pizda(2,1)
7562 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7563 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7564 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7569 C Contribution from graph IV
7571 call transpose2(EE(1,1,itl),auxmat(1,1))
7572 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7573 vv(1)=pizda(1,1)+pizda(2,2)
7574 vv(2)=pizda(2,1)-pizda(1,2)
7575 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7576 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7577 C Explicit gradient in virtual-dihedral angles.
7578 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7579 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7580 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7581 vv(1)=pizda(1,1)+pizda(2,2)
7582 vv(2)=pizda(2,1)-pizda(1,2)
7583 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7584 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7585 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7586 C Cartesian gradient
7590 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7592 vv(1)=pizda(1,1)+pizda(2,2)
7593 vv(2)=pizda(2,1)-pizda(1,2)
7594 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7595 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7596 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7601 C Antiparallel orientation
7602 C Contribution from graph III
7604 call transpose2(EUg(1,1,j),auxmat(1,1))
7605 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7606 vv(1)=pizda(1,1)-pizda(2,2)
7607 vv(2)=pizda(1,2)+pizda(2,1)
7608 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7609 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7610 C Explicit gradient in virtual-dihedral angles.
7611 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7612 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7613 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7614 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7615 vv(1)=pizda(1,1)-pizda(2,2)
7616 vv(2)=pizda(1,2)+pizda(2,1)
7617 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7618 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7619 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7620 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7621 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7622 vv(1)=pizda(1,1)-pizda(2,2)
7623 vv(2)=pizda(1,2)+pizda(2,1)
7624 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7625 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7626 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7627 C Cartesian gradient
7631 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7633 vv(1)=pizda(1,1)-pizda(2,2)
7634 vv(2)=pizda(1,2)+pizda(2,1)
7635 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7636 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7637 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7642 C Contribution from graph IV
7644 call transpose2(EE(1,1,itj),auxmat(1,1))
7645 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7646 vv(1)=pizda(1,1)+pizda(2,2)
7647 vv(2)=pizda(2,1)-pizda(1,2)
7648 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7649 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7650 C Explicit gradient in virtual-dihedral angles.
7651 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7652 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7653 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7654 vv(1)=pizda(1,1)+pizda(2,2)
7655 vv(2)=pizda(2,1)-pizda(1,2)
7656 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7657 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7658 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7659 C Cartesian gradient
7663 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7665 vv(1)=pizda(1,1)+pizda(2,2)
7666 vv(2)=pizda(2,1)-pizda(1,2)
7667 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7668 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7669 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7675 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7676 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7677 cd write (2,*) 'ijkl',i,j,k,l
7678 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7679 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7681 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7682 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7683 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7684 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7685 if (j.lt.nres-1) then
7692 if (l.lt.nres-1) then
7702 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7703 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7704 C summed up outside the subrouine as for the other subroutines
7705 C handling long-range interactions. The old code is commented out
7706 C with "cgrad" to keep track of changes.
7708 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7709 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7710 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7711 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7712 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7713 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7714 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7715 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7716 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7717 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7719 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7720 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7721 cgrad ghalf=0.5d0*ggg1(ll)
7723 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7724 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7725 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7726 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7727 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7728 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7729 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7730 cgrad ghalf=0.5d0*ggg2(ll)
7732 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7733 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7734 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7735 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7736 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7737 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7742 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7743 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7748 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7749 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7755 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7760 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7764 cd write (2,*) iii,g_corr5_loc(iii)
7767 cd write (2,*) 'ekont',ekont
7768 cd write (iout,*) 'eello5',ekont*eel5
7771 c--------------------------------------------------------------------------
7772 double precision function eello6(i,j,k,l,jj,kk)
7773 implicit real*8 (a-h,o-z)
7774 include 'DIMENSIONS'
7775 include 'COMMON.IOUNITS'
7776 include 'COMMON.CHAIN'
7777 include 'COMMON.DERIV'
7778 include 'COMMON.INTERACT'
7779 include 'COMMON.CONTACTS'
7780 include 'COMMON.TORSION'
7781 include 'COMMON.VAR'
7782 include 'COMMON.GEO'
7783 include 'COMMON.FFIELD'
7784 double precision ggg1(3),ggg2(3)
7785 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7790 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7798 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7799 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7803 derx(lll,kkk,iii)=0.0d0
7807 cd eij=facont_hb(jj,i)
7808 cd ekl=facont_hb(kk,k)
7814 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7815 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7816 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7817 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7818 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7819 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7821 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7822 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7823 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7824 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7825 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7826 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7830 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7832 C If turn contributions are considered, they will be handled separately.
7833 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7834 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7835 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7836 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7837 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7838 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7839 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7841 if (j.lt.nres-1) then
7848 if (l.lt.nres-1) then
7856 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7857 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7858 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7859 cgrad ghalf=0.5d0*ggg1(ll)
7861 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7862 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7863 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7864 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7865 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7866 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7867 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7868 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7869 cgrad ghalf=0.5d0*ggg2(ll)
7870 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7872 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7873 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7874 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7875 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7876 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7877 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7882 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7883 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7888 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7889 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7895 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7900 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7904 cd write (2,*) iii,g_corr6_loc(iii)
7907 cd write (2,*) 'ekont',ekont
7908 cd write (iout,*) 'eello6',ekont*eel6
7911 c--------------------------------------------------------------------------
7912 double precision function eello6_graph1(i,j,k,l,imat,swap)
7913 implicit real*8 (a-h,o-z)
7914 include 'DIMENSIONS'
7915 include 'COMMON.IOUNITS'
7916 include 'COMMON.CHAIN'
7917 include 'COMMON.DERIV'
7918 include 'COMMON.INTERACT'
7919 include 'COMMON.CONTACTS'
7920 include 'COMMON.TORSION'
7921 include 'COMMON.VAR'
7922 include 'COMMON.GEO'
7923 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7927 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7929 C Parallel Antiparallel
7935 C \ j|/k\| / \ |/k\|l /
7940 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7941 itk=itortyp(itype(k))
7942 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7943 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7944 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7945 call transpose2(EUgC(1,1,k),auxmat(1,1))
7946 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7947 vv1(1)=pizda1(1,1)-pizda1(2,2)
7948 vv1(2)=pizda1(1,2)+pizda1(2,1)
7949 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7950 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7951 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7952 s5=scalar2(vv(1),Dtobr2(1,i))
7953 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7954 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7955 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7956 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7957 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7958 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7959 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7960 & +scalar2(vv(1),Dtobr2der(1,i)))
7961 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7962 vv1(1)=pizda1(1,1)-pizda1(2,2)
7963 vv1(2)=pizda1(1,2)+pizda1(2,1)
7964 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7965 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7967 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7968 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7969 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7970 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7971 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7973 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7974 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7975 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7976 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7977 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7979 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7980 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7981 vv1(1)=pizda1(1,1)-pizda1(2,2)
7982 vv1(2)=pizda1(1,2)+pizda1(2,1)
7983 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7984 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7985 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7986 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7995 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7996 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7997 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7998 call transpose2(EUgC(1,1,k),auxmat(1,1))
7999 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8001 vv1(1)=pizda1(1,1)-pizda1(2,2)
8002 vv1(2)=pizda1(1,2)+pizda1(2,1)
8003 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8004 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8005 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8006 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8007 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8008 s5=scalar2(vv(1),Dtobr2(1,i))
8009 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8015 c----------------------------------------------------------------------------
8016 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8017 implicit real*8 (a-h,o-z)
8018 include 'DIMENSIONS'
8019 include 'COMMON.IOUNITS'
8020 include 'COMMON.CHAIN'
8021 include 'COMMON.DERIV'
8022 include 'COMMON.INTERACT'
8023 include 'COMMON.CONTACTS'
8024 include 'COMMON.TORSION'
8025 include 'COMMON.VAR'
8026 include 'COMMON.GEO'
8028 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8029 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8032 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8034 C Parallel Antiparallel
8045 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8046 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8047 C AL 7/4/01 s1 would occur in the sixth-order moment,
8048 C but not in a cluster cumulant
8050 s1=dip(1,jj,i)*dip(1,kk,k)
8052 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8053 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8054 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8055 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8056 call transpose2(EUg(1,1,k),auxmat(1,1))
8057 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8058 vv(1)=pizda(1,1)-pizda(2,2)
8059 vv(2)=pizda(1,2)+pizda(2,1)
8060 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8061 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8063 eello6_graph2=-(s1+s2+s3+s4)
8065 eello6_graph2=-(s2+s3+s4)
8068 C Derivatives in gamma(i-1)
8071 s1=dipderg(1,jj,i)*dip(1,kk,k)
8073 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8074 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8075 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8076 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8078 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8080 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8082 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8084 C Derivatives in gamma(k-1)
8086 s1=dip(1,jj,i)*dipderg(1,kk,k)
8088 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8089 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8090 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8091 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8092 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8093 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8094 vv(1)=pizda(1,1)-pizda(2,2)
8095 vv(2)=pizda(1,2)+pizda(2,1)
8096 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8098 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8100 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8102 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8103 C Derivatives in gamma(j-1) or gamma(l-1)
8106 s1=dipderg(3,jj,i)*dip(1,kk,k)
8108 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8109 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8110 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8111 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8112 vv(1)=pizda(1,1)-pizda(2,2)
8113 vv(2)=pizda(1,2)+pizda(2,1)
8114 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8117 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8119 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8122 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8123 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8125 C Derivatives in gamma(l-1) or gamma(j-1)
8128 s1=dip(1,jj,i)*dipderg(3,kk,k)
8130 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8131 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8132 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8133 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8134 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8135 vv(1)=pizda(1,1)-pizda(2,2)
8136 vv(2)=pizda(1,2)+pizda(2,1)
8137 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8140 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8142 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8145 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8146 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8148 C Cartesian derivatives.
8150 write (2,*) 'In eello6_graph2'
8152 write (2,*) 'iii=',iii
8154 write (2,*) 'kkk=',kkk
8156 write (2,'(3(2f10.5),5x)')
8157 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8167 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8169 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8172 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8174 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8175 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8177 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8178 call transpose2(EUg(1,1,k),auxmat(1,1))
8179 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8181 vv(1)=pizda(1,1)-pizda(2,2)
8182 vv(2)=pizda(1,2)+pizda(2,1)
8183 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8184 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8186 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8188 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8191 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8193 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8200 c----------------------------------------------------------------------------
8201 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8202 implicit real*8 (a-h,o-z)
8203 include 'DIMENSIONS'
8204 include 'COMMON.IOUNITS'
8205 include 'COMMON.CHAIN'
8206 include 'COMMON.DERIV'
8207 include 'COMMON.INTERACT'
8208 include 'COMMON.CONTACTS'
8209 include 'COMMON.TORSION'
8210 include 'COMMON.VAR'
8211 include 'COMMON.GEO'
8212 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8214 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8216 C Parallel Antiparallel
8227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8229 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8230 C energy moment and not to the cluster cumulant.
8231 iti=itortyp(itype(i))
8232 if (j.lt.nres-1) then
8233 itj1=itortyp(itype(j+1))
8237 itk=itortyp(itype(k))
8238 itk1=itortyp(itype(k+1))
8239 if (l.lt.nres-1) then
8240 itl1=itortyp(itype(l+1))
8245 s1=dip(4,jj,i)*dip(4,kk,k)
8247 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8248 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8249 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8250 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8251 call transpose2(EE(1,1,itk),auxmat(1,1))
8252 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8253 vv(1)=pizda(1,1)+pizda(2,2)
8254 vv(2)=pizda(2,1)-pizda(1,2)
8255 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8256 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8257 cd & "sum",-(s2+s3+s4)
8259 eello6_graph3=-(s1+s2+s3+s4)
8261 eello6_graph3=-(s2+s3+s4)
8264 C Derivatives in gamma(k-1)
8265 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8266 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8267 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8268 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8269 C Derivatives in gamma(l-1)
8270 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8271 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8272 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8273 vv(1)=pizda(1,1)+pizda(2,2)
8274 vv(2)=pizda(2,1)-pizda(1,2)
8275 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8276 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8277 C Cartesian derivatives.
8283 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8285 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8288 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8290 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8291 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8293 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8294 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8296 vv(1)=pizda(1,1)+pizda(2,2)
8297 vv(2)=pizda(2,1)-pizda(1,2)
8298 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8300 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8302 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8305 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8307 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8309 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8315 c----------------------------------------------------------------------------
8316 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,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 include 'COMMON.FFIELD'
8328 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8329 & auxvec1(2),auxmat1(2,2)
8331 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8333 C Parallel Antiparallel
8344 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8346 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8347 C energy moment and not to the cluster cumulant.
8348 cd write (2,*) 'eello_graph4: wturn6',wturn6
8349 iti=itortyp(itype(i))
8350 itj=itortyp(itype(j))
8351 if (j.lt.nres-1) then
8352 itj1=itortyp(itype(j+1))
8356 itk=itortyp(itype(k))
8357 if (k.lt.nres-1) then
8358 itk1=itortyp(itype(k+1))
8362 itl=itortyp(itype(l))
8363 if (l.lt.nres-1) then
8364 itl1=itortyp(itype(l+1))
8368 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8369 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8370 cd & ' itl',itl,' itl1',itl1
8373 s1=dip(3,jj,i)*dip(3,kk,k)
8375 s1=dip(2,jj,j)*dip(2,kk,l)
8378 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8379 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8381 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8382 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8384 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8385 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8387 call transpose2(EUg(1,1,k),auxmat(1,1))
8388 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8389 vv(1)=pizda(1,1)-pizda(2,2)
8390 vv(2)=pizda(2,1)+pizda(1,2)
8391 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8392 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8394 eello6_graph4=-(s1+s2+s3+s4)
8396 eello6_graph4=-(s2+s3+s4)
8398 C Derivatives in gamma(i-1)
8402 s1=dipderg(2,jj,i)*dip(3,kk,k)
8404 s1=dipderg(4,jj,j)*dip(2,kk,l)
8407 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8409 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8410 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8412 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8413 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8415 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8416 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8417 cd write (2,*) 'turn6 derivatives'
8419 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8421 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8425 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8427 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8431 C Derivatives in gamma(k-1)
8434 s1=dip(3,jj,i)*dipderg(2,kk,k)
8436 s1=dip(2,jj,j)*dipderg(4,kk,l)
8439 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8440 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8442 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8443 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8445 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8446 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8448 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8449 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8450 vv(1)=pizda(1,1)-pizda(2,2)
8451 vv(2)=pizda(2,1)+pizda(1,2)
8452 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8453 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8455 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8457 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8461 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8463 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8466 C Derivatives in gamma(j-1) or gamma(l-1)
8467 if (l.eq.j+1 .and. l.gt.1) then
8468 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8469 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8470 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8471 vv(1)=pizda(1,1)-pizda(2,2)
8472 vv(2)=pizda(2,1)+pizda(1,2)
8473 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8474 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8475 else if (j.gt.1) then
8476 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8477 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8478 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8479 vv(1)=pizda(1,1)-pizda(2,2)
8480 vv(2)=pizda(2,1)+pizda(1,2)
8481 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8482 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8483 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8485 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8488 C Cartesian derivatives.
8495 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8497 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8501 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8503 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8507 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8509 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8511 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8512 & b1(1,itj1),auxvec(1))
8513 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8515 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8516 & b1(1,itl1),auxvec(1))
8517 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8519 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8521 vv(1)=pizda(1,1)-pizda(2,2)
8522 vv(2)=pizda(2,1)+pizda(1,2)
8523 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8525 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8527 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8530 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8533 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8536 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8538 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8540 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8544 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8546 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8549 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8551 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8559 c----------------------------------------------------------------------------
8560 double precision function eello_turn6(i,jj,kk)
8561 implicit real*8 (a-h,o-z)
8562 include 'DIMENSIONS'
8563 include 'COMMON.IOUNITS'
8564 include 'COMMON.CHAIN'
8565 include 'COMMON.DERIV'
8566 include 'COMMON.INTERACT'
8567 include 'COMMON.CONTACTS'
8568 include 'COMMON.TORSION'
8569 include 'COMMON.VAR'
8570 include 'COMMON.GEO'
8571 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8572 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8574 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8575 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8576 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8577 C the respective energy moment and not to the cluster cumulant.
8586 iti=itortyp(itype(i))
8587 itk=itortyp(itype(k))
8588 itk1=itortyp(itype(k+1))
8589 itl=itortyp(itype(l))
8590 itj=itortyp(itype(j))
8591 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8592 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8593 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8598 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8600 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8604 derx_turn(lll,kkk,iii)=0.0d0
8611 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8613 cd write (2,*) 'eello6_5',eello6_5
8615 call transpose2(AEA(1,1,1),auxmat(1,1))
8616 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8617 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8618 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8620 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8621 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8622 s2 = scalar2(b1(1,itk),vtemp1(1))
8624 call transpose2(AEA(1,1,2),atemp(1,1))
8625 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8626 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8627 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8629 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8630 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8631 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8633 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8634 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8635 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8636 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8637 ss13 = scalar2(b1(1,itk),vtemp4(1))
8638 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8640 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8646 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8647 C Derivatives in gamma(i+2)
8651 call transpose2(AEA(1,1,1),auxmatd(1,1))
8652 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8653 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8654 call transpose2(AEAderg(1,1,2),atempd(1,1))
8655 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8656 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8658 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8659 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8660 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8666 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8667 C Derivatives in gamma(i+3)
8669 call transpose2(AEA(1,1,1),auxmatd(1,1))
8670 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8671 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8672 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8674 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8675 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8676 s2d = scalar2(b1(1,itk),vtemp1d(1))
8678 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8679 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8681 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8683 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8684 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8685 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8693 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8694 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8696 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8697 & -0.5d0*ekont*(s2d+s12d)
8699 C Derivatives in gamma(i+4)
8700 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8701 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8702 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8704 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8705 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8706 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8714 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8716 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8718 C Derivatives in gamma(i+5)
8720 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8721 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8722 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8724 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8725 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8726 s2d = scalar2(b1(1,itk),vtemp1d(1))
8728 call transpose2(AEA(1,1,2),atempd(1,1))
8729 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8730 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8732 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8733 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8735 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8736 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8737 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8745 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8746 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8748 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8749 & -0.5d0*ekont*(s2d+s12d)
8751 C Cartesian derivatives
8756 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8757 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8758 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8760 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8761 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8763 s2d = scalar2(b1(1,itk),vtemp1d(1))
8765 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8766 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8767 s8d = -(atempd(1,1)+atempd(2,2))*
8768 & scalar2(cc(1,1,itl),vtemp2(1))
8770 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8772 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8773 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8780 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8783 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8787 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8788 & - 0.5d0*(s8d+s12d)
8790 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8799 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8801 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8802 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8803 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8804 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8805 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8807 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8808 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8809 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8813 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8814 cd & 16*eel_turn6_num
8816 if (j.lt.nres-1) then
8823 if (l.lt.nres-1) then
8831 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8832 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8833 cgrad ghalf=0.5d0*ggg1(ll)
8835 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8836 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8837 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8838 & +ekont*derx_turn(ll,2,1)
8839 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8840 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8841 & +ekont*derx_turn(ll,4,1)
8842 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8843 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8844 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8845 cgrad ghalf=0.5d0*ggg2(ll)
8847 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8848 & +ekont*derx_turn(ll,2,2)
8849 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8850 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8851 & +ekont*derx_turn(ll,4,2)
8852 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8853 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8854 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8859 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8864 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8870 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8875 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8879 cd write (2,*) iii,g_corr6_loc(iii)
8881 eello_turn6=ekont*eel_turn6
8882 cd write (2,*) 'ekont',ekont
8883 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8887 C-----------------------------------------------------------------------------
8888 double precision function scalar(u,v)
8889 !DIR$ INLINEALWAYS scalar
8891 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8894 double precision u(3),v(3)
8895 cd double precision sc
8903 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8906 crc-------------------------------------------------
8907 SUBROUTINE MATVEC2(A1,V1,V2)
8908 !DIR$ INLINEALWAYS MATVEC2
8910 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8912 implicit real*8 (a-h,o-z)
8913 include 'DIMENSIONS'
8914 DIMENSION A1(2,2),V1(2),V2(2)
8918 c 3 VI=VI+A1(I,K)*V1(K)
8922 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8923 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8928 C---------------------------------------
8929 SUBROUTINE MATMAT2(A1,A2,A3)
8931 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8933 implicit real*8 (a-h,o-z)
8934 include 'DIMENSIONS'
8935 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8936 c DIMENSION AI3(2,2)
8940 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8946 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8947 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8948 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8949 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8957 c-------------------------------------------------------------------------
8958 double precision function scalar2(u,v)
8959 !DIR$ INLINEALWAYS scalar2
8961 double precision u(2),v(2)
8964 scalar2=u(1)*v(1)+u(2)*v(2)
8968 C-----------------------------------------------------------------------------
8970 subroutine transpose2(a,at)
8971 !DIR$ INLINEALWAYS transpose2
8973 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8976 double precision a(2,2),at(2,2)
8983 c--------------------------------------------------------------------------
8984 subroutine transpose(n,a,at)
8987 double precision a(n,n),at(n,n)
8995 C---------------------------------------------------------------------------
8996 subroutine prodmat3(a1,a2,kk,transp,prod)
8997 !DIR$ INLINEALWAYS prodmat3
8999 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9003 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9005 crc double precision auxmat(2,2),prod_(2,2)
9008 crc call transpose2(kk(1,1),auxmat(1,1))
9009 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9010 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9012 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9013 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9014 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9015 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9016 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9017 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9018 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9019 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9022 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9023 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9025 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9026 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9027 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9028 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9029 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9030 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9031 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9032 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9035 c call transpose2(a2(1,1),a2t(1,1))
9038 crc print *,((prod_(i,j),i=1,2),j=1,2)
9039 crc print *,((prod(i,j),i=1,2),j=1,2)