1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
124 c print *,"Processor",myrank," computed USCSC"
130 time_vec=time_vec+MPI_Wtime()-time01
132 c print *,"Processor",myrank," left VEC_AND_DERIV"
135 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
136 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
137 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
138 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
140 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
154 c write (iout,*) "Soft-spheer ELEC potential"
155 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
158 c print *,"Processor",myrank," computed UELEC"
160 C Calculate excluded-volume interaction energy between peptide groups
165 call escp(evdw2,evdw2_14)
171 c write (iout,*) "Soft-sphere SCP potential"
172 call escp_soft_sphere(evdw2,evdw2_14)
175 c Calculate the bond-stretching energy
179 C Calculate the disulfide-bridge and other energy and the contributions
180 C from other distance constraints.
181 cd print *,'Calling EHPB'
183 cd print *,'EHPB exitted succesfully.'
185 C Calculate the virtual-bond-angle energy.
187 if (wang.gt.0d0) then
192 c print *,"Processor",myrank," computed UB"
194 C Calculate the SC local energy.
197 c print *,"Processor",myrank," computed USC"
199 C Calculate the virtual-bond torsional energy.
201 cd print *,'nterm=',nterm
203 call etor(etors,edihcnstr)
208 c print *,"Processor",myrank," computed Utor"
210 C 6/23/01 Calculate double-torsional energy
212 if (wtor_d.gt.0) then
217 c print *,"Processor",myrank," computed Utord"
219 C 21/5/07 Calculate local sicdechain correlation energy
221 if (wsccor.gt.0.0d0) then
222 call eback_sc_corr(esccor)
226 c print *,"Processor",myrank," computed Usccorr"
228 C 12/1/95 Multi-body terms
232 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
233 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
234 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
235 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
236 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
243 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
245 cd write (iout,*) "multibody_hb ecorr",ecorr
247 c print *,"Processor",myrank," computed Ucorr"
249 C If performing constraint dynamics, call the constraint energy
250 C after the equilibration time
251 if(usampl.and.totT.gt.eq_time) then
259 time_enecalc=time_enecalc+MPI_Wtime()-time00
261 c print *,"Processor",myrank," computed Uconstr"
270 energia(2)=evdw2-evdw2_14
287 energia(8)=eello_turn3
288 energia(9)=eello_turn4
295 energia(19)=edihcnstr
297 energia(20)=Uconst+Uconst_back
299 c Here are the energies showed per procesor if the are more processors
300 c per molecule then we sum it up in sum_energy subroutine
301 c print *," Processor",myrank," calls SUM_ENERGY"
302 call sum_energy(energia,.true.)
303 c print *," Processor",myrank," left SUM_ENERGY"
305 time_sumene=time_sumene+MPI_Wtime()-time00
309 c-------------------------------------------------------------------------------
310 subroutine sum_energy(energia,reduce)
311 implicit real*8 (a-h,o-z)
316 cMS$ATTRIBUTES C :: proc_proc
322 include 'COMMON.SETUP'
323 include 'COMMON.IOUNITS'
324 double precision energia(0:n_ene),enebuff(0:n_ene+1)
325 include 'COMMON.FFIELD'
326 include 'COMMON.DERIV'
327 include 'COMMON.INTERACT'
328 include 'COMMON.SBRIDGE'
329 include 'COMMON.CHAIN'
331 include 'COMMON.CONTROL'
332 include 'COMMON.TIME1'
335 if (nfgtasks.gt.1 .and. reduce) then
337 write (iout,*) "energies before REDUCE"
338 call enerprint(energia)
342 enebuff(i)=energia(i)
345 call MPI_Barrier(FG_COMM,IERR)
346 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
348 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
349 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
351 write (iout,*) "energies after REDUCE"
352 call enerprint(energia)
355 time_Reduce=time_Reduce+MPI_Wtime()-time00
357 if (fg_rank.eq.0) then
361 evdw2=energia(2)+energia(18)
377 eello_turn3=energia(8)
378 eello_turn4=energia(9)
385 edihcnstr=energia(19)
390 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
391 & +wang*ebe+wtor*etors+wscloc*escloc
392 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
393 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
394 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
395 & +wbond*estr+Uconst+wsccor*esccor
397 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
408 if (isnan(etot).ne.0) energia(0)=1.0d+99
410 if (isnan(etot)) energia(0)=1.0d+99
415 idumm=proc_proc(etot,i)
417 call proc_proc(etot,i)
419 if(i.eq.1)energia(0)=1.0d+99
426 c-------------------------------------------------------------------------------
427 subroutine sum_gradient
428 implicit real*8 (a-h,o-z)
433 cMS$ATTRIBUTES C :: proc_proc
438 double precision gradbufc(3,maxres),gradbufx(3,maxres),
439 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
441 include 'COMMON.SETUP'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.FFIELD'
444 include 'COMMON.DERIV'
445 include 'COMMON.INTERACT'
446 include 'COMMON.SBRIDGE'
447 include 'COMMON.CHAIN'
449 include 'COMMON.CONTROL'
450 include 'COMMON.TIME1'
451 include 'COMMON.MAXGRAD'
452 include 'COMMON.SCCOR'
457 write (iout,*) "sum_gradient gvdwc, gvdwx"
459 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
460 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
465 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
466 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
467 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
470 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
471 C in virtual-bond-vector coordinates
474 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
476 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
477 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
479 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
481 c write (iout,'(i5,3f10.5,2x,f10.5)')
482 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
484 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
486 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
487 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
495 gradbufc(j,i)=wsc*gvdwc(j,i)+
496 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
497 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
498 & wel_loc*gel_loc_long(j,i)+
499 & wcorr*gradcorr_long(j,i)+
500 & wcorr5*gradcorr5_long(j,i)+
501 & wcorr6*gradcorr6_long(j,i)+
502 & wturn6*gcorr6_turn_long(j,i)+
509 gradbufc(j,i)=wsc*gvdwc(j,i)+
510 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
511 & welec*gelc_long(j,i)+
513 & wel_loc*gel_loc_long(j,i)+
514 & wcorr*gradcorr_long(j,i)+
515 & wcorr5*gradcorr5_long(j,i)+
516 & wcorr6*gradcorr6_long(j,i)+
517 & wturn6*gcorr6_turn_long(j,i)+
523 if (nfgtasks.gt.1) then
526 write (iout,*) "gradbufc before allreduce"
528 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
534 gradbufc_sum(j,i)=gradbufc(j,i)
537 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
538 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
539 c time_reduce=time_reduce+MPI_Wtime()-time00
541 c write (iout,*) "gradbufc_sum after allreduce"
543 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
548 c time_allreduce=time_allreduce+MPI_Wtime()-time00
556 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
557 write (iout,*) (i," jgrad_start",jgrad_start(i),
558 & " jgrad_end ",jgrad_end(i),
559 & i=igrad_start,igrad_end)
562 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
563 c do not parallelize this part.
565 c do i=igrad_start,igrad_end
566 c do j=jgrad_start(i),jgrad_end(i)
568 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
573 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
577 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
581 write (iout,*) "gradbufc after summing"
583 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
590 write (iout,*) "gradbufc"
592 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
598 gradbufc_sum(j,i)=gradbufc(j,i)
603 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
607 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
612 c gradbufc(k,i)=0.0d0
616 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
621 write (iout,*) "gradbufc after summing"
623 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
631 gradbufc(k,nres)=0.0d0
636 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
637 & wel_loc*gel_loc(j,i)+
638 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
639 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
640 & wel_loc*gel_loc_long(j,i)+
641 & wcorr*gradcorr_long(j,i)+
642 & wcorr5*gradcorr5_long(j,i)+
643 & wcorr6*gradcorr6_long(j,i)+
644 & wturn6*gcorr6_turn_long(j,i))+
646 & wcorr*gradcorr(j,i)+
647 & wturn3*gcorr3_turn(j,i)+
648 & wturn4*gcorr4_turn(j,i)+
649 & wcorr5*gradcorr5(j,i)+
650 & wcorr6*gradcorr6(j,i)+
651 & wturn6*gcorr6_turn(j,i)+
652 & wsccor*gsccorc(j,i)
653 & +wscloc*gscloc(j,i)
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
676 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
677 & wsccor*gsccorx(j,i)
678 & +wscloc*gsclocx(j,i)
682 write (iout,*) "gloc before adding corr"
684 write (iout,*) i,gloc(i,icg)
688 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
689 & +wcorr5*g_corr5_loc(i)
690 & +wcorr6*g_corr6_loc(i)
691 & +wturn4*gel_loc_turn4(i)
692 & +wturn3*gel_loc_turn3(i)
693 & +wturn6*gel_loc_turn6(i)
694 & +wel_loc*gel_loc_loc(i)
697 write (iout,*) "gloc after adding corr"
699 write (iout,*) i,gloc(i,icg)
703 if (nfgtasks.gt.1) then
706 gradbufc(j,i)=gradc(j,i,icg)
707 gradbufx(j,i)=gradx(j,i,icg)
711 glocbuf(i)=gloc(i,icg)
715 write (iout,*) "gloc_sc before reduce"
718 write (iout,*) i,j,gloc_sc(j,i,icg)
725 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
729 call MPI_Barrier(FG_COMM,IERR)
730 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
732 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
734 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
736 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
737 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
738 time_reduce=time_reduce+MPI_Wtime()-time00
739 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 time_reduce=time_reduce+MPI_Wtime()-time00
744 write (iout,*) "gloc_sc after reduce"
747 write (iout,*) i,j,gloc_sc(j,i,icg)
753 write (iout,*) "gloc after reduce"
755 write (iout,*) i,gloc(i,icg)
760 if (gnorm_check) then
762 c Compute the maximum elements of the gradient
772 gcorr3_turn_max=0.0d0
773 gcorr4_turn_max=0.0d0
776 gcorr6_turn_max=0.0d0
786 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
787 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
788 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
789 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
790 & gvdwc_scp_max=gvdwc_scp_norm
791 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
792 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
793 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
794 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
795 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
796 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
797 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
798 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
799 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
800 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
801 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
802 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
803 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
805 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
806 & gcorr3_turn_max=gcorr3_turn_norm
807 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
809 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
810 & gcorr4_turn_max=gcorr4_turn_norm
811 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
812 if (gradcorr5_norm.gt.gradcorr5_max)
813 & gradcorr5_max=gradcorr5_norm
814 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
815 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
816 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
818 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
819 & gcorr6_turn_max=gcorr6_turn_norm
820 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
821 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
822 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
823 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
824 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
825 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
826 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
827 if (gradx_scp_norm.gt.gradx_scp_max)
828 & gradx_scp_max=gradx_scp_norm
829 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
830 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
831 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
832 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
833 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
834 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
835 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
836 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
840 open(istat,file=statname,position="append")
842 open(istat,file=statname,access="append")
844 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
845 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
846 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
847 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
848 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
849 & gsccorx_max,gsclocx_max
851 if (gvdwc_max.gt.1.0d4) then
852 write (iout,*) "gvdwc gvdwx gradb gradbx"
854 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
855 & gradb(j,i),gradbx(j,i),j=1,3)
857 call pdbout(0.0d0,'cipiszcze',iout)
863 write (iout,*) "gradc gradx gloc"
865 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
866 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
870 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
874 c-------------------------------------------------------------------------------
875 subroutine rescale_weights(t_bath)
876 implicit real*8 (a-h,o-z)
878 include 'COMMON.IOUNITS'
879 include 'COMMON.FFIELD'
880 include 'COMMON.SBRIDGE'
881 double precision kfac /2.4d0/
882 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
884 c facT=2*temp0/(t_bath+temp0)
885 if (rescale_mode.eq.0) then
891 else if (rescale_mode.eq.1) then
892 facT=kfac/(kfac-1.0d0+t_bath/temp0)
893 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
894 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
895 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
896 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
897 else if (rescale_mode.eq.2) then
903 facT=licznik/dlog(dexp(x)+dexp(-x))
904 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
905 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
906 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
907 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
909 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
910 write (*,*) "Wrong RESCALE_MODE",rescale_mode
912 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
916 welec=weights(3)*fact
917 wcorr=weights(4)*fact3
918 wcorr5=weights(5)*fact4
919 wcorr6=weights(6)*fact5
920 wel_loc=weights(7)*fact2
921 wturn3=weights(8)*fact2
922 wturn4=weights(9)*fact3
923 wturn6=weights(10)*fact5
924 wtor=weights(13)*fact
925 wtor_d=weights(14)*fact2
926 wsccor=weights(21)*fact
930 C------------------------------------------------------------------------
931 subroutine enerprint(energia)
932 implicit real*8 (a-h,o-z)
934 include 'COMMON.IOUNITS'
935 include 'COMMON.FFIELD'
936 include 'COMMON.SBRIDGE'
938 double precision energia(0:n_ene)
943 evdw2=energia(2)+energia(18)
955 eello_turn3=energia(8)
956 eello_turn4=energia(9)
957 eello_turn6=energia(10)
963 edihcnstr=energia(19)
968 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
969 & estr,wbond,ebe,wang,
970 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
972 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
973 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
976 10 format (/'Virtual-chain energies:'//
977 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
978 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
979 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
980 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
981 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
982 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
983 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
984 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
985 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
986 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
987 & ' (SS bridges & dist. cnstr.)'/
988 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
989 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
992 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
993 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
994 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
995 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
996 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
997 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
998 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
999 & 'ETOT= ',1pE16.6,' (total)')
1001 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1002 & estr,wbond,ebe,wang,
1003 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1005 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1006 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1007 & ebr*nss,Uconst,etot
1008 10 format (/'Virtual-chain energies:'//
1009 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1010 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1011 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1012 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1013 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1014 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1015 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1016 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1017 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1018 & ' (SS bridges & dist. cnstr.)'/
1019 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1021 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1022 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1023 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1024 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1025 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1026 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1027 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1028 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1029 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1030 & 'ETOT= ',1pE16.6,' (total)')
1034 C-----------------------------------------------------------------------
1035 subroutine elj(evdw)
1037 C This subroutine calculates the interaction energy of nonbonded side chains
1038 C assuming the LJ potential of interaction.
1040 implicit real*8 (a-h,o-z)
1041 include 'DIMENSIONS'
1042 parameter (accur=1.0d-10)
1043 include 'COMMON.GEO'
1044 include 'COMMON.VAR'
1045 include 'COMMON.LOCAL'
1046 include 'COMMON.CHAIN'
1047 include 'COMMON.DERIV'
1048 include 'COMMON.INTERACT'
1049 include 'COMMON.TORSION'
1050 include 'COMMON.SBRIDGE'
1051 include 'COMMON.NAMES'
1052 include 'COMMON.IOUNITS'
1053 include 'COMMON.CONTACTS'
1055 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1057 do i=iatsc_s,iatsc_e
1058 itypi=iabs(itype(i))
1059 if (itypi.eq.ntyp1) cycle
1060 itypi1=iabs(itype(i+1))
1067 C Calculate SC interaction energy.
1069 do iint=1,nint_gr(i)
1070 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1071 cd & 'iend=',iend(i,iint)
1072 do j=istart(i,iint),iend(i,iint)
1073 itypj=iabs(itype(j))
1074 if (itypj.eq.ntyp1) cycle
1078 C Change 12/1/95 to calculate four-body interactions
1079 rij=xj*xj+yj*yj+zj*zj
1081 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1082 eps0ij=eps(itypi,itypj)
1084 e1=fac*fac*aa(itypi,itypj)
1085 e2=fac*bb(itypi,itypj)
1087 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1088 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1089 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1090 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1091 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1092 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1095 C Calculate the components of the gradient in DC and X
1097 fac=-rrij*(e1+evdwij)
1102 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1103 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1104 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1105 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1109 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1113 C 12/1/95, revised on 5/20/97
1115 C Calculate the contact function. The ith column of the array JCONT will
1116 C contain the numbers of atoms that make contacts with the atom I (of numbers
1117 C greater than I). The arrays FACONT and GACONT will contain the values of
1118 C the contact function and its derivative.
1120 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1121 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1122 C Uncomment next line, if the correlation interactions are contact function only
1123 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1125 sigij=sigma(itypi,itypj)
1126 r0ij=rs0(itypi,itypj)
1128 C Check whether the SC's are not too far to make a contact.
1131 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1132 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1134 if (fcont.gt.0.0D0) then
1135 C If the SC-SC distance if close to sigma, apply spline.
1136 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1137 cAdam & fcont1,fprimcont1)
1138 cAdam fcont1=1.0d0-fcont1
1139 cAdam if (fcont1.gt.0.0d0) then
1140 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1141 cAdam fcont=fcont*fcont1
1143 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1144 cga eps0ij=1.0d0/dsqrt(eps0ij)
1146 cga gg(k)=gg(k)*eps0ij
1148 cga eps0ij=-evdwij*eps0ij
1149 C Uncomment for AL's type of SC correlation interactions.
1150 cadam eps0ij=-evdwij
1151 num_conti=num_conti+1
1152 jcont(num_conti,i)=j
1153 facont(num_conti,i)=fcont*eps0ij
1154 fprimcont=eps0ij*fprimcont/rij
1156 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1157 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1158 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1159 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1160 gacont(1,num_conti,i)=-fprimcont*xj
1161 gacont(2,num_conti,i)=-fprimcont*yj
1162 gacont(3,num_conti,i)=-fprimcont*zj
1163 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1164 cd write (iout,'(2i3,3f10.5)')
1165 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1171 num_cont(i)=num_conti
1175 gvdwc(j,i)=expon*gvdwc(j,i)
1176 gvdwx(j,i)=expon*gvdwx(j,i)
1179 C******************************************************************************
1183 C To save time, the factor of EXPON has been extracted from ALL components
1184 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1187 C******************************************************************************
1190 C-----------------------------------------------------------------------------
1191 subroutine eljk(evdw)
1193 C This subroutine calculates the interaction energy of nonbonded side chains
1194 C assuming the LJK potential of interaction.
1196 implicit real*8 (a-h,o-z)
1197 include 'DIMENSIONS'
1198 include 'COMMON.GEO'
1199 include 'COMMON.VAR'
1200 include 'COMMON.LOCAL'
1201 include 'COMMON.CHAIN'
1202 include 'COMMON.DERIV'
1203 include 'COMMON.INTERACT'
1204 include 'COMMON.IOUNITS'
1205 include 'COMMON.NAMES'
1208 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1210 do i=iatsc_s,iatsc_e
1211 itypi=iabs(itype(i))
1212 if (itypi.eq.ntyp1) cycle
1213 itypi1=iabs(itype(i+1))
1218 C Calculate SC interaction energy.
1220 do iint=1,nint_gr(i)
1221 do j=istart(i,iint),iend(i,iint)
1222 itypj=iabs(itype(j))
1223 if (itypj.eq.ntyp1) cycle
1227 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1228 fac_augm=rrij**expon
1229 e_augm=augm(itypi,itypj)*fac_augm
1230 r_inv_ij=dsqrt(rrij)
1232 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1233 fac=r_shift_inv**expon
1234 e1=fac*fac*aa(itypi,itypj)
1235 e2=fac*bb(itypi,itypj)
1237 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1238 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1239 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1240 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1241 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1242 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1243 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1246 C Calculate the components of the gradient in DC and X
1248 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1253 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1254 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1255 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1256 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1260 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1268 gvdwc(j,i)=expon*gvdwc(j,i)
1269 gvdwx(j,i)=expon*gvdwx(j,i)
1274 C-----------------------------------------------------------------------------
1275 subroutine ebp(evdw)
1277 C This subroutine calculates the interaction energy of nonbonded side chains
1278 C assuming the Berne-Pechukas potential of interaction.
1280 implicit real*8 (a-h,o-z)
1281 include 'DIMENSIONS'
1282 include 'COMMON.GEO'
1283 include 'COMMON.VAR'
1284 include 'COMMON.LOCAL'
1285 include 'COMMON.CHAIN'
1286 include 'COMMON.DERIV'
1287 include 'COMMON.NAMES'
1288 include 'COMMON.INTERACT'
1289 include 'COMMON.IOUNITS'
1290 include 'COMMON.CALC'
1291 common /srutu/ icall
1292 c double precision rrsave(maxdim)
1295 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1297 c if (icall.eq.0) then
1303 do i=iatsc_s,iatsc_e
1304 itypi=iabs(itype(i))
1305 if (itypi.eq.ntyp1) cycle
1306 itypi1=iabs(itype(i+1))
1310 dxi=dc_norm(1,nres+i)
1311 dyi=dc_norm(2,nres+i)
1312 dzi=dc_norm(3,nres+i)
1313 c dsci_inv=dsc_inv(itypi)
1314 dsci_inv=vbld_inv(i+nres)
1316 C Calculate SC interaction energy.
1318 do iint=1,nint_gr(i)
1319 do j=istart(i,iint),iend(i,iint)
1321 itypj=iabs(itype(j))
1322 if (itypj.eq.ntyp1) cycle
1323 c dscj_inv=dsc_inv(itypj)
1324 dscj_inv=vbld_inv(j+nres)
1325 chi1=chi(itypi,itypj)
1326 chi2=chi(itypj,itypi)
1333 alf12=0.5D0*(alf1+alf2)
1334 C For diagnostics only!!!
1347 dxj=dc_norm(1,nres+j)
1348 dyj=dc_norm(2,nres+j)
1349 dzj=dc_norm(3,nres+j)
1350 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1351 cd if (icall.eq.0) then
1357 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1359 C Calculate whole angle-dependent part of epsilon and contributions
1360 C to its derivatives
1361 fac=(rrij*sigsq)**expon2
1362 e1=fac*fac*aa(itypi,itypj)
1363 e2=fac*bb(itypi,itypj)
1364 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1365 eps2der=evdwij*eps3rt
1366 eps3der=evdwij*eps2rt
1367 evdwij=evdwij*eps2rt*eps3rt
1370 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1371 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1372 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1373 cd & restyp(itypi),i,restyp(itypj),j,
1374 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1375 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1376 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1379 C Calculate gradient components.
1380 e1=e1*eps1*eps2rt**2*eps3rt**2
1381 fac=-expon*(e1+evdwij)
1384 C Calculate radial part of the gradient
1388 C Calculate the angular part of the gradient and sum add the contributions
1389 C to the appropriate components of the Cartesian gradient.
1397 C-----------------------------------------------------------------------------
1398 subroutine egb(evdw)
1400 C This subroutine calculates the interaction energy of nonbonded side chains
1401 C assuming the Gay-Berne potential of interaction.
1403 implicit real*8 (a-h,o-z)
1404 include 'DIMENSIONS'
1405 include 'COMMON.GEO'
1406 include 'COMMON.VAR'
1407 include 'COMMON.LOCAL'
1408 include 'COMMON.CHAIN'
1409 include 'COMMON.DERIV'
1410 include 'COMMON.NAMES'
1411 include 'COMMON.INTERACT'
1412 include 'COMMON.IOUNITS'
1413 include 'COMMON.CALC'
1414 include 'COMMON.CONTROL'
1417 ccccc energy_dec=.false.
1418 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1421 c if (icall.eq.0) lprn=.false.
1423 do i=iatsc_s,iatsc_e
1424 itypi=iabs(itype(i))
1425 if (itypi.eq.ntyp1) cycle
1426 itypi1=iabs(itype(i+1))
1430 dxi=dc_norm(1,nres+i)
1431 dyi=dc_norm(2,nres+i)
1432 dzi=dc_norm(3,nres+i)
1433 c dsci_inv=dsc_inv(itypi)
1434 dsci_inv=vbld_inv(i+nres)
1435 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1436 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1438 C Calculate SC interaction energy.
1440 do iint=1,nint_gr(i)
1441 do j=istart(i,iint),iend(i,iint)
1443 itypj=iabs(itype(j))
1444 if (itypj.eq.ntyp1) cycle
1445 c dscj_inv=dsc_inv(itypj)
1446 dscj_inv=vbld_inv(j+nres)
1447 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1448 c & 1.0d0/vbld(j+nres)
1449 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1450 sig0ij=sigma(itypi,itypj)
1451 chi1=chi(itypi,itypj)
1452 chi2=chi(itypj,itypi)
1459 alf12=0.5D0*(alf1+alf2)
1460 C For diagnostics only!!!
1473 dxj=dc_norm(1,nres+j)
1474 dyj=dc_norm(2,nres+j)
1475 dzj=dc_norm(3,nres+j)
1476 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1477 c write (iout,*) "j",j," dc_norm",
1478 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1479 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1481 C Calculate angle-dependent terms of energy and contributions to their
1485 sig=sig0ij*dsqrt(sigsq)
1486 rij_shift=1.0D0/rij-sig+sig0ij
1487 c for diagnostics; uncomment
1488 c rij_shift=1.2*sig0ij
1489 C I hate to put IF's in the loops, but here don't have another choice!!!!
1490 if (rij_shift.le.0.0D0) then
1492 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1493 cd & restyp(itypi),i,restyp(itypj),j,
1494 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1498 c---------------------------------------------------------------
1499 rij_shift=1.0D0/rij_shift
1500 fac=rij_shift**expon
1501 e1=fac*fac*aa(itypi,itypj)
1502 e2=fac*bb(itypi,itypj)
1503 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1504 eps2der=evdwij*eps3rt
1505 eps3der=evdwij*eps2rt
1506 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1507 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1508 evdwij=evdwij*eps2rt*eps3rt
1511 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1512 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1513 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1514 & restyp(itypi),i,restyp(itypj),j,
1515 & epsi,sigm,chi1,chi2,chip1,chip2,
1516 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1517 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1521 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1524 C Calculate gradient components.
1525 e1=e1*eps1*eps2rt**2*eps3rt**2
1526 fac=-expon*(e1+evdwij)*rij_shift
1530 C Calculate the radial part of the gradient
1534 C Calculate angular part of the gradient.
1539 c write (iout,*) "Number of loop steps in EGB:",ind
1540 cccc energy_dec=.false.
1543 C-----------------------------------------------------------------------------
1544 subroutine egbv(evdw)
1546 C This subroutine calculates the interaction energy of nonbonded side chains
1547 C assuming the Gay-Berne-Vorobjev potential of interaction.
1549 implicit real*8 (a-h,o-z)
1550 include 'DIMENSIONS'
1551 include 'COMMON.GEO'
1552 include 'COMMON.VAR'
1553 include 'COMMON.LOCAL'
1554 include 'COMMON.CHAIN'
1555 include 'COMMON.DERIV'
1556 include 'COMMON.NAMES'
1557 include 'COMMON.INTERACT'
1558 include 'COMMON.IOUNITS'
1559 include 'COMMON.CALC'
1560 common /srutu/ icall
1563 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1566 c if (icall.eq.0) lprn=.true.
1568 do i=iatsc_s,iatsc_e
1569 itypi=iabs(itype(i))
1570 if (itypi.eq.ntyp1) cycle
1571 itypi1=iabs(itype(i+1))
1575 dxi=dc_norm(1,nres+i)
1576 dyi=dc_norm(2,nres+i)
1577 dzi=dc_norm(3,nres+i)
1578 c dsci_inv=dsc_inv(itypi)
1579 dsci_inv=vbld_inv(i+nres)
1581 C Calculate SC interaction energy.
1583 do iint=1,nint_gr(i)
1584 do j=istart(i,iint),iend(i,iint)
1586 itypj=iabs(itype(j))
1587 if (itypj.eq.ntyp1) cycle
1588 c dscj_inv=dsc_inv(itypj)
1589 dscj_inv=vbld_inv(j+nres)
1590 sig0ij=sigma(itypi,itypj)
1591 r0ij=r0(itypi,itypj)
1592 chi1=chi(itypi,itypj)
1593 chi2=chi(itypj,itypi)
1600 alf12=0.5D0*(alf1+alf2)
1601 C For diagnostics only!!!
1614 dxj=dc_norm(1,nres+j)
1615 dyj=dc_norm(2,nres+j)
1616 dzj=dc_norm(3,nres+j)
1617 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1619 C Calculate angle-dependent terms of energy and contributions to their
1623 sig=sig0ij*dsqrt(sigsq)
1624 rij_shift=1.0D0/rij-sig+r0ij
1625 C I hate to put IF's in the loops, but here don't have another choice!!!!
1626 if (rij_shift.le.0.0D0) then
1631 c---------------------------------------------------------------
1632 rij_shift=1.0D0/rij_shift
1633 fac=rij_shift**expon
1634 e1=fac*fac*aa(itypi,itypj)
1635 e2=fac*bb(itypi,itypj)
1636 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1637 eps2der=evdwij*eps3rt
1638 eps3der=evdwij*eps2rt
1639 fac_augm=rrij**expon
1640 e_augm=augm(itypi,itypj)*fac_augm
1641 evdwij=evdwij*eps2rt*eps3rt
1642 evdw=evdw+evdwij+e_augm
1644 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1645 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1646 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1647 & restyp(itypi),i,restyp(itypj),j,
1648 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1649 & chi1,chi2,chip1,chip2,
1650 & eps1,eps2rt**2,eps3rt**2,
1651 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1654 C Calculate gradient components.
1655 e1=e1*eps1*eps2rt**2*eps3rt**2
1656 fac=-expon*(e1+evdwij)*rij_shift
1658 fac=rij*fac-2*expon*rrij*e_augm
1659 C Calculate the radial part of the gradient
1663 C Calculate angular part of the gradient.
1669 C-----------------------------------------------------------------------------
1670 subroutine sc_angular
1671 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1672 C om12. Called by ebp, egb, and egbv.
1674 include 'COMMON.CALC'
1675 include 'COMMON.IOUNITS'
1679 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1680 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1681 om12=dxi*dxj+dyi*dyj+dzi*dzj
1683 C Calculate eps1(om12) and its derivative in om12
1684 faceps1=1.0D0-om12*chiom12
1685 faceps1_inv=1.0D0/faceps1
1686 eps1=dsqrt(faceps1_inv)
1687 C Following variable is eps1*deps1/dom12
1688 eps1_om12=faceps1_inv*chiom12
1693 c write (iout,*) "om12",om12," eps1",eps1
1694 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1699 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1700 sigsq=1.0D0-facsig*faceps1_inv
1701 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1702 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1703 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1709 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1710 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1712 C Calculate eps2 and its derivatives in om1, om2, and om12.
1715 chipom12=chip12*om12
1716 facp=1.0D0-om12*chipom12
1718 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1719 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1720 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1721 C Following variable is the square root of eps2
1722 eps2rt=1.0D0-facp1*facp_inv
1723 C Following three variables are the derivatives of the square root of eps
1724 C in om1, om2, and om12.
1725 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1726 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1727 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1728 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1729 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1730 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1731 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1732 c & " eps2rt_om12",eps2rt_om12
1733 C Calculate whole angle-dependent part of epsilon and contributions
1734 C to its derivatives
1737 C----------------------------------------------------------------------------
1739 implicit real*8 (a-h,o-z)
1740 include 'DIMENSIONS'
1741 include 'COMMON.CHAIN'
1742 include 'COMMON.DERIV'
1743 include 'COMMON.CALC'
1744 include 'COMMON.IOUNITS'
1745 double precision dcosom1(3),dcosom2(3)
1746 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1747 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1748 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1749 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1753 c eom12=evdwij*eps1_om12
1755 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1756 c & " sigder",sigder
1757 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1758 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1760 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1761 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1764 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1766 c write (iout,*) "gg",(gg(k),k=1,3)
1768 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1769 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1770 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1771 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1772 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1773 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1774 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1775 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1776 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1777 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1780 C Calculate the components of the gradient in DC and X
1784 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1788 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1789 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1793 C-----------------------------------------------------------------------
1794 subroutine e_softsphere(evdw)
1796 C This subroutine calculates the interaction energy of nonbonded side chains
1797 C assuming the LJ potential of interaction.
1799 implicit real*8 (a-h,o-z)
1800 include 'DIMENSIONS'
1801 parameter (accur=1.0d-10)
1802 include 'COMMON.GEO'
1803 include 'COMMON.VAR'
1804 include 'COMMON.LOCAL'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.INTERACT'
1808 include 'COMMON.TORSION'
1809 include 'COMMON.SBRIDGE'
1810 include 'COMMON.NAMES'
1811 include 'COMMON.IOUNITS'
1812 include 'COMMON.CONTACTS'
1814 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1816 do i=iatsc_s,iatsc_e
1817 itypi=iabs(itype(i))
1818 if (itypi.eq.ntyp1) cycle
1819 itypi1=iabs(itype(i+1))
1824 C Calculate SC interaction energy.
1826 do iint=1,nint_gr(i)
1827 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1828 cd & 'iend=',iend(i,iint)
1829 do j=istart(i,iint),iend(i,iint)
1830 itypj=iabs(itype(j))
1831 if (itypj.eq.ntyp1) cycle
1835 rij=xj*xj+yj*yj+zj*zj
1836 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1837 r0ij=r0(itypi,itypj)
1839 c print *,i,j,r0ij,dsqrt(rij)
1840 if (rij.lt.r0ijsq) then
1841 evdwij=0.25d0*(rij-r0ijsq)**2
1849 C Calculate the components of the gradient in DC and X
1855 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1856 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1857 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1858 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1862 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1870 C--------------------------------------------------------------------------
1871 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1874 C Soft-sphere potential of p-p interaction
1876 implicit real*8 (a-h,o-z)
1877 include 'DIMENSIONS'
1878 include 'COMMON.CONTROL'
1879 include 'COMMON.IOUNITS'
1880 include 'COMMON.GEO'
1881 include 'COMMON.VAR'
1882 include 'COMMON.LOCAL'
1883 include 'COMMON.CHAIN'
1884 include 'COMMON.DERIV'
1885 include 'COMMON.INTERACT'
1886 include 'COMMON.CONTACTS'
1887 include 'COMMON.TORSION'
1888 include 'COMMON.VECTORS'
1889 include 'COMMON.FFIELD'
1891 cd write(iout,*) 'In EELEC_soft_sphere'
1898 do i=iatel_s,iatel_e
1899 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1903 xmedi=c(1,i)+0.5d0*dxi
1904 ymedi=c(2,i)+0.5d0*dyi
1905 zmedi=c(3,i)+0.5d0*dzi
1907 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1908 do j=ielstart(i),ielend(i)
1909 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1913 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1914 r0ij=rpp(iteli,itelj)
1919 xj=c(1,j)+0.5D0*dxj-xmedi
1920 yj=c(2,j)+0.5D0*dyj-ymedi
1921 zj=c(3,j)+0.5D0*dzj-zmedi
1922 rij=xj*xj+yj*yj+zj*zj
1923 if (rij.lt.r0ijsq) then
1924 evdw1ij=0.25d0*(rij-r0ijsq)**2
1932 C Calculate contributions to the Cartesian gradient.
1938 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1939 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1942 * Loop over residues i+1 thru j-1.
1946 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1951 cgrad do i=nnt,nct-1
1953 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1955 cgrad do j=i+1,nct-1
1957 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1963 c------------------------------------------------------------------------------
1964 subroutine vec_and_deriv
1965 implicit real*8 (a-h,o-z)
1966 include 'DIMENSIONS'
1970 include 'COMMON.IOUNITS'
1971 include 'COMMON.GEO'
1972 include 'COMMON.VAR'
1973 include 'COMMON.LOCAL'
1974 include 'COMMON.CHAIN'
1975 include 'COMMON.VECTORS'
1976 include 'COMMON.SETUP'
1977 include 'COMMON.TIME1'
1978 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1979 C Compute the local reference systems. For reference system (i), the
1980 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1981 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1983 do i=ivec_start,ivec_end
1987 if (i.eq.nres-1) then
1988 C Case of the last full residue
1989 C Compute the Z-axis
1990 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1991 costh=dcos(pi-theta(nres))
1992 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1996 C Compute the derivatives of uz
1998 uzder(2,1,1)=-dc_norm(3,i-1)
1999 uzder(3,1,1)= dc_norm(2,i-1)
2000 uzder(1,2,1)= dc_norm(3,i-1)
2002 uzder(3,2,1)=-dc_norm(1,i-1)
2003 uzder(1,3,1)=-dc_norm(2,i-1)
2004 uzder(2,3,1)= dc_norm(1,i-1)
2007 uzder(2,1,2)= dc_norm(3,i)
2008 uzder(3,1,2)=-dc_norm(2,i)
2009 uzder(1,2,2)=-dc_norm(3,i)
2011 uzder(3,2,2)= dc_norm(1,i)
2012 uzder(1,3,2)= dc_norm(2,i)
2013 uzder(2,3,2)=-dc_norm(1,i)
2015 C Compute the Y-axis
2018 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2020 C Compute the derivatives of uy
2023 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2024 & -dc_norm(k,i)*dc_norm(j,i-1)
2025 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2027 uyder(j,j,1)=uyder(j,j,1)-costh
2028 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2033 uygrad(l,k,j,i)=uyder(l,k,j)
2034 uzgrad(l,k,j,i)=uzder(l,k,j)
2038 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2039 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2040 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2041 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2044 C Compute the Z-axis
2045 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2046 costh=dcos(pi-theta(i+2))
2047 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2051 C Compute the derivatives of uz
2053 uzder(2,1,1)=-dc_norm(3,i+1)
2054 uzder(3,1,1)= dc_norm(2,i+1)
2055 uzder(1,2,1)= dc_norm(3,i+1)
2057 uzder(3,2,1)=-dc_norm(1,i+1)
2058 uzder(1,3,1)=-dc_norm(2,i+1)
2059 uzder(2,3,1)= dc_norm(1,i+1)
2062 uzder(2,1,2)= dc_norm(3,i)
2063 uzder(3,1,2)=-dc_norm(2,i)
2064 uzder(1,2,2)=-dc_norm(3,i)
2066 uzder(3,2,2)= dc_norm(1,i)
2067 uzder(1,3,2)= dc_norm(2,i)
2068 uzder(2,3,2)=-dc_norm(1,i)
2070 C Compute the Y-axis
2073 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2075 C Compute the derivatives of uy
2078 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2079 & -dc_norm(k,i)*dc_norm(j,i+1)
2080 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2082 uyder(j,j,1)=uyder(j,j,1)-costh
2083 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2088 uygrad(l,k,j,i)=uyder(l,k,j)
2089 uzgrad(l,k,j,i)=uzder(l,k,j)
2093 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2094 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2095 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2096 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2100 vbld_inv_temp(1)=vbld_inv(i+1)
2101 if (i.lt.nres-1) then
2102 vbld_inv_temp(2)=vbld_inv(i+2)
2104 vbld_inv_temp(2)=vbld_inv(i)
2109 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2110 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2115 #if defined(PARVEC) && defined(MPI)
2116 if (nfgtasks1.gt.1) then
2118 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2119 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2120 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2121 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2122 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2124 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2125 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2127 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2128 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2129 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2130 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2131 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2132 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2133 time_gather=time_gather+MPI_Wtime()-time00
2135 c if (fg_rank.eq.0) then
2136 c write (iout,*) "Arrays UY and UZ"
2138 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2145 C-----------------------------------------------------------------------------
2146 subroutine check_vecgrad
2147 implicit real*8 (a-h,o-z)
2148 include 'DIMENSIONS'
2149 include 'COMMON.IOUNITS'
2150 include 'COMMON.GEO'
2151 include 'COMMON.VAR'
2152 include 'COMMON.LOCAL'
2153 include 'COMMON.CHAIN'
2154 include 'COMMON.VECTORS'
2155 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2156 dimension uyt(3,maxres),uzt(3,maxres)
2157 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2158 double precision delta /1.0d-7/
2161 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2162 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2163 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2164 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2165 cd & (dc_norm(if90,i),if90=1,3)
2166 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2167 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2168 cd write(iout,'(a)')
2174 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2175 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2188 cd write (iout,*) 'i=',i
2190 erij(k)=dc_norm(k,i)
2194 dc_norm(k,i)=erij(k)
2196 dc_norm(j,i)=dc_norm(j,i)+delta
2197 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2199 c dc_norm(k,i)=dc_norm(k,i)/fac
2201 c write (iout,*) (dc_norm(k,i),k=1,3)
2202 c write (iout,*) (erij(k),k=1,3)
2205 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2206 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2207 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2208 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2210 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2211 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2212 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2215 dc_norm(k,i)=erij(k)
2218 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2219 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2220 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2221 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2222 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2223 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2224 cd write (iout,'(a)')
2229 C--------------------------------------------------------------------------
2230 subroutine set_matrices
2231 implicit real*8 (a-h,o-z)
2232 include 'DIMENSIONS'
2235 include "COMMON.SETUP"
2237 integer status(MPI_STATUS_SIZE)
2239 include 'COMMON.IOUNITS'
2240 include 'COMMON.GEO'
2241 include 'COMMON.VAR'
2242 include 'COMMON.LOCAL'
2243 include 'COMMON.CHAIN'
2244 include 'COMMON.DERIV'
2245 include 'COMMON.INTERACT'
2246 include 'COMMON.CONTACTS'
2247 include 'COMMON.TORSION'
2248 include 'COMMON.VECTORS'
2249 include 'COMMON.FFIELD'
2250 double precision auxvec(2),auxmat(2,2)
2252 C Compute the virtual-bond-torsional-angle dependent quantities needed
2253 C to calculate the el-loc multibody terms of various order.
2256 do i=ivec_start+2,ivec_end+2
2260 if (i .lt. nres+1) then
2297 if (i .gt. 3 .and. i .lt. nres+1) then
2298 obrot_der(1,i-2)=-sin1
2299 obrot_der(2,i-2)= cos1
2300 Ugder(1,1,i-2)= sin1
2301 Ugder(1,2,i-2)=-cos1
2302 Ugder(2,1,i-2)=-cos1
2303 Ugder(2,2,i-2)=-sin1
2306 obrot2_der(1,i-2)=-dwasin2
2307 obrot2_der(2,i-2)= dwacos2
2308 Ug2der(1,1,i-2)= dwasin2
2309 Ug2der(1,2,i-2)=-dwacos2
2310 Ug2der(2,1,i-2)=-dwacos2
2311 Ug2der(2,2,i-2)=-dwasin2
2313 obrot_der(1,i-2)=0.0d0
2314 obrot_der(2,i-2)=0.0d0
2315 Ugder(1,1,i-2)=0.0d0
2316 Ugder(1,2,i-2)=0.0d0
2317 Ugder(2,1,i-2)=0.0d0
2318 Ugder(2,2,i-2)=0.0d0
2319 obrot2_der(1,i-2)=0.0d0
2320 obrot2_der(2,i-2)=0.0d0
2321 Ug2der(1,1,i-2)=0.0d0
2322 Ug2der(1,2,i-2)=0.0d0
2323 Ug2der(2,1,i-2)=0.0d0
2324 Ug2der(2,2,i-2)=0.0d0
2326 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2327 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2328 iti = itortyp(itype(i-2))
2332 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2333 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2334 iti1 = itortyp(itype(i-1))
2338 cd write (iout,*) '*******i',i,' iti1',iti
2339 cd write (iout,*) 'b1',b1(:,iti)
2340 cd write (iout,*) 'b2',b2(:,iti)
2341 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2342 c if (i .gt. iatel_s+2) then
2343 if (i .gt. nnt+2) then
2344 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2345 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2346 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2348 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2349 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2350 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2351 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2352 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2363 DtUg2(l,k,i-2)=0.0d0
2367 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2368 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2370 muder(k,i-2)=Ub2der(k,i-2)
2372 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2373 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2374 if (itype(i-1).le.ntyp) then
2375 iti1 = itortyp(itype(i-1))
2383 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2385 cd write (iout,*) 'mu ',mu(:,i-2)
2386 cd write (iout,*) 'mu1',mu1(:,i-2)
2387 cd write (iout,*) 'mu2',mu2(:,i-2)
2388 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2390 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2391 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2392 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2393 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2394 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2395 C Vectors and matrices dependent on a single virtual-bond dihedral.
2396 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2397 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2398 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2399 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2400 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2401 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2402 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2403 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2404 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2407 C Matrices dependent on two consecutive virtual-bond dihedrals.
2408 C The order of matrices is from left to right.
2409 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2411 c do i=max0(ivec_start,2),ivec_end
2413 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2414 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2415 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2416 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2417 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2418 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2419 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2420 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2423 #if defined(MPI) && defined(PARMAT)
2425 c if (fg_rank.eq.0) then
2426 write (iout,*) "Arrays UG and UGDER before GATHER"
2428 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2429 & ((ug(l,k,i),l=1,2),k=1,2),
2430 & ((ugder(l,k,i),l=1,2),k=1,2)
2432 write (iout,*) "Arrays UG2 and UG2DER"
2434 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2435 & ((ug2(l,k,i),l=1,2),k=1,2),
2436 & ((ug2der(l,k,i),l=1,2),k=1,2)
2438 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2440 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2441 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2442 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2444 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2446 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2447 & costab(i),sintab(i),costab2(i),sintab2(i)
2449 write (iout,*) "Array MUDER"
2451 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2455 if (nfgtasks.gt.1) then
2457 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2458 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2459 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2461 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2462 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2464 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2465 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2467 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2468 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2470 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2471 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2473 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2474 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2476 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2477 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2479 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2480 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2481 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2482 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2483 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2484 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2485 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2486 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2487 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2488 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2489 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2490 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2491 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2493 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2494 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2496 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2497 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2499 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2500 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2502 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2503 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2505 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2506 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2508 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2509 & ivec_count(fg_rank1),
2510 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2512 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2515 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2516 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2518 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2519 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2521 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2524 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2527 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2528 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2530 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2531 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2533 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2534 & ivec_count(fg_rank1),
2535 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2537 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2538 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2540 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2541 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2543 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2544 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2546 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2547 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2549 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2550 & ivec_count(fg_rank1),
2551 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2553 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2554 & ivec_count(fg_rank1),
2555 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2557 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2558 & ivec_count(fg_rank1),
2559 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2560 & MPI_MAT2,FG_COMM1,IERR)
2561 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2562 & ivec_count(fg_rank1),
2563 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2564 & MPI_MAT2,FG_COMM1,IERR)
2567 c Passes matrix info through the ring
2570 if (irecv.lt.0) irecv=nfgtasks1-1
2573 if (inext.ge.nfgtasks1) inext=0
2575 c write (iout,*) "isend",isend," irecv",irecv
2577 lensend=lentyp(isend)
2578 lenrecv=lentyp(irecv)
2579 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2580 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2581 c & MPI_ROTAT1(lensend),inext,2200+isend,
2582 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2583 c & iprev,2200+irecv,FG_COMM,status,IERR)
2584 c write (iout,*) "Gather ROTAT1"
2586 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2587 c & MPI_ROTAT2(lensend),inext,3300+isend,
2588 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2589 c & iprev,3300+irecv,FG_COMM,status,IERR)
2590 c write (iout,*) "Gather ROTAT2"
2592 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2593 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2594 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2595 & iprev,4400+irecv,FG_COMM,status,IERR)
2596 c write (iout,*) "Gather ROTAT_OLD"
2598 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2599 & MPI_PRECOMP11(lensend),inext,5500+isend,
2600 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2601 & iprev,5500+irecv,FG_COMM,status,IERR)
2602 c write (iout,*) "Gather PRECOMP11"
2604 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2605 & MPI_PRECOMP12(lensend),inext,6600+isend,
2606 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2607 & iprev,6600+irecv,FG_COMM,status,IERR)
2608 c write (iout,*) "Gather PRECOMP12"
2610 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2612 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2613 & MPI_ROTAT2(lensend),inext,7700+isend,
2614 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2615 & iprev,7700+irecv,FG_COMM,status,IERR)
2616 c write (iout,*) "Gather PRECOMP21"
2618 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2619 & MPI_PRECOMP22(lensend),inext,8800+isend,
2620 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2621 & iprev,8800+irecv,FG_COMM,status,IERR)
2622 c write (iout,*) "Gather PRECOMP22"
2624 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2625 & MPI_PRECOMP23(lensend),inext,9900+isend,
2626 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2627 & MPI_PRECOMP23(lenrecv),
2628 & iprev,9900+irecv,FG_COMM,status,IERR)
2629 c write (iout,*) "Gather PRECOMP23"
2634 if (irecv.lt.0) irecv=nfgtasks1-1
2637 time_gather=time_gather+MPI_Wtime()-time00
2640 c if (fg_rank.eq.0) then
2641 write (iout,*) "Arrays UG and UGDER"
2643 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2644 & ((ug(l,k,i),l=1,2),k=1,2),
2645 & ((ugder(l,k,i),l=1,2),k=1,2)
2647 write (iout,*) "Arrays UG2 and UG2DER"
2649 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2650 & ((ug2(l,k,i),l=1,2),k=1,2),
2651 & ((ug2der(l,k,i),l=1,2),k=1,2)
2653 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2655 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2656 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2657 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2659 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2661 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2662 & costab(i),sintab(i),costab2(i),sintab2(i)
2664 write (iout,*) "Array MUDER"
2666 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2672 cd iti = itortyp(itype(i))
2675 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2676 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2681 C--------------------------------------------------------------------------
2682 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2684 C This subroutine calculates the average interaction energy and its gradient
2685 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2686 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2687 C The potential depends both on the distance of peptide-group centers and on
2688 C the orientation of the CA-CA virtual bonds.
2690 implicit real*8 (a-h,o-z)
2694 include 'DIMENSIONS'
2695 include 'COMMON.CONTROL'
2696 include 'COMMON.SETUP'
2697 include 'COMMON.IOUNITS'
2698 include 'COMMON.GEO'
2699 include 'COMMON.VAR'
2700 include 'COMMON.LOCAL'
2701 include 'COMMON.CHAIN'
2702 include 'COMMON.DERIV'
2703 include 'COMMON.INTERACT'
2704 include 'COMMON.CONTACTS'
2705 include 'COMMON.TORSION'
2706 include 'COMMON.VECTORS'
2707 include 'COMMON.FFIELD'
2708 include 'COMMON.TIME1'
2709 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2710 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2711 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2712 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2713 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2714 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2716 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2718 double precision scal_el /1.0d0/
2720 double precision scal_el /0.5d0/
2723 C 13-go grudnia roku pamietnego...
2724 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2725 & 0.0d0,1.0d0,0.0d0,
2726 & 0.0d0,0.0d0,1.0d0/
2727 cd write(iout,*) 'In EELEC'
2729 cd write(iout,*) 'Type',i
2730 cd write(iout,*) 'B1',B1(:,i)
2731 cd write(iout,*) 'B2',B2(:,i)
2732 cd write(iout,*) 'CC',CC(:,:,i)
2733 cd write(iout,*) 'DD',DD(:,:,i)
2734 cd write(iout,*) 'EE',EE(:,:,i)
2736 cd call check_vecgrad
2738 if (icheckgrad.eq.1) then
2740 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2742 dc_norm(k,i)=dc(k,i)*fac
2744 c write (iout,*) 'i',i,' fac',fac
2747 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2748 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2749 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2750 c call vec_and_deriv
2756 time_mat=time_mat+MPI_Wtime()-time01
2760 cd write (iout,*) 'i=',i
2762 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2765 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2766 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2779 cd print '(a)','Enter EELEC'
2780 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2782 gel_loc_loc(i)=0.0d0
2787 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2789 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2791 do i=iturn3_start,iturn3_end
2792 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2793 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2797 dx_normi=dc_norm(1,i)
2798 dy_normi=dc_norm(2,i)
2799 dz_normi=dc_norm(3,i)
2800 xmedi=c(1,i)+0.5d0*dxi
2801 ymedi=c(2,i)+0.5d0*dyi
2802 zmedi=c(3,i)+0.5d0*dzi
2804 call eelecij(i,i+2,ees,evdw1,eel_loc)
2805 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2806 num_cont_hb(i)=num_conti
2808 do i=iturn4_start,iturn4_end
2809 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2810 & .or. itype(i+3).eq.ntyp1
2811 & .or. itype(i+4).eq.ntyp1) cycle
2815 dx_normi=dc_norm(1,i)
2816 dy_normi=dc_norm(2,i)
2817 dz_normi=dc_norm(3,i)
2818 xmedi=c(1,i)+0.5d0*dxi
2819 ymedi=c(2,i)+0.5d0*dyi
2820 zmedi=c(3,i)+0.5d0*dzi
2821 num_conti=num_cont_hb(i)
2822 call eelecij(i,i+3,ees,evdw1,eel_loc)
2823 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2824 & call eturn4(i,eello_turn4)
2825 num_cont_hb(i)=num_conti
2828 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2830 do i=iatel_s,iatel_e
2831 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2835 dx_normi=dc_norm(1,i)
2836 dy_normi=dc_norm(2,i)
2837 dz_normi=dc_norm(3,i)
2838 xmedi=c(1,i)+0.5d0*dxi
2839 ymedi=c(2,i)+0.5d0*dyi
2840 zmedi=c(3,i)+0.5d0*dzi
2841 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2842 num_conti=num_cont_hb(i)
2843 do j=ielstart(i),ielend(i)
2844 c write (iout,*) i,j,itype(i),itype(j)
2845 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2846 call eelecij(i,j,ees,evdw1,eel_loc)
2848 num_cont_hb(i)=num_conti
2850 c write (iout,*) "Number of loop steps in EELEC:",ind
2852 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2853 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2855 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2856 ccc eel_loc=eel_loc+eello_turn3
2857 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2860 C-------------------------------------------------------------------------------
2861 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2862 implicit real*8 (a-h,o-z)
2863 include 'DIMENSIONS'
2867 include 'COMMON.CONTROL'
2868 include 'COMMON.IOUNITS'
2869 include 'COMMON.GEO'
2870 include 'COMMON.VAR'
2871 include 'COMMON.LOCAL'
2872 include 'COMMON.CHAIN'
2873 include 'COMMON.DERIV'
2874 include 'COMMON.INTERACT'
2875 include 'COMMON.CONTACTS'
2876 include 'COMMON.TORSION'
2877 include 'COMMON.VECTORS'
2878 include 'COMMON.FFIELD'
2879 include 'COMMON.TIME1'
2880 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2881 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2882 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2883 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2884 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2885 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2887 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2889 double precision scal_el /1.0d0/
2891 double precision scal_el /0.5d0/
2894 C 13-go grudnia roku pamietnego...
2895 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2896 & 0.0d0,1.0d0,0.0d0,
2897 & 0.0d0,0.0d0,1.0d0/
2898 c time00=MPI_Wtime()
2899 cd write (iout,*) "eelecij",i,j
2903 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2904 aaa=app(iteli,itelj)
2905 bbb=bpp(iteli,itelj)
2906 ael6i=ael6(iteli,itelj)
2907 ael3i=ael3(iteli,itelj)
2911 dx_normj=dc_norm(1,j)
2912 dy_normj=dc_norm(2,j)
2913 dz_normj=dc_norm(3,j)
2914 xj=c(1,j)+0.5D0*dxj-xmedi
2915 yj=c(2,j)+0.5D0*dyj-ymedi
2916 zj=c(3,j)+0.5D0*dzj-zmedi
2917 rij=xj*xj+yj*yj+zj*zj
2923 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2924 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2925 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2926 fac=cosa-3.0D0*cosb*cosg
2928 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2929 if (j.eq.i+2) ev1=scal_el*ev1
2934 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2937 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2938 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2941 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2942 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2943 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2944 cd & xmedi,ymedi,zmedi,xj,yj,zj
2946 if (energy_dec) then
2947 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2949 &,iteli,itelj,aaa,evdw1
2950 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2954 C Calculate contributions to the Cartesian gradient.
2957 facvdw=-6*rrmij*(ev1+evdwij)
2958 facel=-3*rrmij*(el1+eesij)
2964 * Radial derivatives. First process both termini of the fragment (i,j)
2970 c ghalf=0.5D0*ggg(k)
2971 c gelc(k,i)=gelc(k,i)+ghalf
2972 c gelc(k,j)=gelc(k,j)+ghalf
2974 c 9/28/08 AL Gradient compotents will be summed only at the end
2976 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2977 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2980 * Loop over residues i+1 thru j-1.
2984 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2991 c ghalf=0.5D0*ggg(k)
2992 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2993 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2995 c 9/28/08 AL Gradient compotents will be summed only at the end
2997 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2998 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3001 * Loop over residues i+1 thru j-1.
3005 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3012 fac=-3*rrmij*(facvdw+facvdw+facel)
3017 * Radial derivatives. First process both termini of the fragment (i,j)
3023 c ghalf=0.5D0*ggg(k)
3024 c gelc(k,i)=gelc(k,i)+ghalf
3025 c gelc(k,j)=gelc(k,j)+ghalf
3027 c 9/28/08 AL Gradient compotents will be summed only at the end
3029 gelc_long(k,j)=gelc(k,j)+ggg(k)
3030 gelc_long(k,i)=gelc(k,i)-ggg(k)
3033 * Loop over residues i+1 thru j-1.
3037 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3040 c 9/28/08 AL Gradient compotents will be summed only at the end
3045 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3046 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3052 ecosa=2.0D0*fac3*fac1+fac4
3055 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3056 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3058 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3059 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3061 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3062 cd & (dcosg(k),k=1,3)
3064 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3067 c ghalf=0.5D0*ggg(k)
3068 c gelc(k,i)=gelc(k,i)+ghalf
3069 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3070 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3071 c gelc(k,j)=gelc(k,j)+ghalf
3072 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3073 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3077 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3082 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3083 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3085 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3086 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3087 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3088 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3090 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3091 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3092 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3094 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3095 C energy of a peptide unit is assumed in the form of a second-order
3096 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3097 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3098 C are computed for EVERY pair of non-contiguous peptide groups.
3100 if (j.lt.nres-1) then
3111 muij(kkk)=mu(k,i)*mu(l,j)
3114 cd write (iout,*) 'EELEC: i',i,' j',j
3115 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3116 cd write(iout,*) 'muij',muij
3117 ury=scalar(uy(1,i),erij)
3118 urz=scalar(uz(1,i),erij)
3119 vry=scalar(uy(1,j),erij)
3120 vrz=scalar(uz(1,j),erij)
3121 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3122 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3123 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3124 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3125 fac=dsqrt(-ael6i)*r3ij
3130 cd write (iout,'(4i5,4f10.5)')
3131 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3132 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3133 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3134 cd & uy(:,j),uz(:,j)
3135 cd write (iout,'(4f10.5)')
3136 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3137 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3138 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3139 cd write (iout,'(9f10.5/)')
3140 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3141 C Derivatives of the elements of A in virtual-bond vectors
3142 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3144 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3145 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3146 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3147 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3148 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3149 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3150 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3151 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3152 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3153 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3154 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3155 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3157 C Compute radial contributions to the gradient
3175 C Add the contributions coming from er
3178 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3179 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3180 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3181 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3184 C Derivatives in DC(i)
3185 cgrad ghalf1=0.5d0*agg(k,1)
3186 cgrad ghalf2=0.5d0*agg(k,2)
3187 cgrad ghalf3=0.5d0*agg(k,3)
3188 cgrad ghalf4=0.5d0*agg(k,4)
3189 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3190 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3191 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3192 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3193 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3194 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3195 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3196 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3197 C Derivatives in DC(i+1)
3198 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3199 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3200 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3201 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3202 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3203 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3204 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3205 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3206 C Derivatives in DC(j)
3207 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3208 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3209 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3210 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3211 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3212 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3213 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3214 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3215 C Derivatives in DC(j+1) or DC(nres-1)
3216 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3217 & -3.0d0*vryg(k,3)*ury)
3218 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3219 & -3.0d0*vrzg(k,3)*ury)
3220 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3221 & -3.0d0*vryg(k,3)*urz)
3222 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3223 & -3.0d0*vrzg(k,3)*urz)
3224 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3226 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3239 aggi(k,l)=-aggi(k,l)
3240 aggi1(k,l)=-aggi1(k,l)
3241 aggj(k,l)=-aggj(k,l)
3242 aggj1(k,l)=-aggj1(k,l)
3245 if (j.lt.nres-1) then
3251 aggi(k,l)=-aggi(k,l)
3252 aggi1(k,l)=-aggi1(k,l)
3253 aggj(k,l)=-aggj(k,l)
3254 aggj1(k,l)=-aggj1(k,l)
3265 aggi(k,l)=-aggi(k,l)
3266 aggi1(k,l)=-aggi1(k,l)
3267 aggj(k,l)=-aggj(k,l)
3268 aggj1(k,l)=-aggj1(k,l)
3273 IF (wel_loc.gt.0.0d0) THEN
3274 C Contribution to the local-electrostatic energy coming from the i-j pair
3275 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3277 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3279 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3280 & 'eelloc',i,j,eel_loc_ij
3281 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3283 eel_loc=eel_loc+eel_loc_ij
3284 C Partial derivatives in virtual-bond dihedral angles gamma
3286 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3287 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3288 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3289 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3290 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3291 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3292 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3294 ggg(l)=agg(l,1)*muij(1)+
3295 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3296 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3297 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3298 cgrad ghalf=0.5d0*ggg(l)
3299 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3300 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3304 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3307 C Remaining derivatives of eello
3309 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3310 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3311 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3312 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3313 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3314 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3315 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3316 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3319 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3320 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3321 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3322 & .and. num_conti.le.maxconts) then
3323 c write (iout,*) i,j," entered corr"
3325 C Calculate the contact function. The ith column of the array JCONT will
3326 C contain the numbers of atoms that make contacts with the atom I (of numbers
3327 C greater than I). The arrays FACONT and GACONT will contain the values of
3328 C the contact function and its derivative.
3329 c r0ij=1.02D0*rpp(iteli,itelj)
3330 c r0ij=1.11D0*rpp(iteli,itelj)
3331 r0ij=2.20D0*rpp(iteli,itelj)
3332 c r0ij=1.55D0*rpp(iteli,itelj)
3333 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3334 if (fcont.gt.0.0D0) then
3335 num_conti=num_conti+1
3336 if (num_conti.gt.maxconts) then
3337 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3338 & ' will skip next contacts for this conf.'
3340 jcont_hb(num_conti,i)=j
3341 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3342 cd & " jcont_hb",jcont_hb(num_conti,i)
3343 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3344 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3345 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3347 d_cont(num_conti,i)=rij
3348 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3349 C --- Electrostatic-interaction matrix ---
3350 a_chuj(1,1,num_conti,i)=a22
3351 a_chuj(1,2,num_conti,i)=a23
3352 a_chuj(2,1,num_conti,i)=a32
3353 a_chuj(2,2,num_conti,i)=a33
3354 C --- Gradient of rij
3356 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3363 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3364 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3365 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3366 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3367 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3372 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3373 C Calculate contact energies
3375 wij=cosa-3.0D0*cosb*cosg
3378 c fac3=dsqrt(-ael6i)/r0ij**3
3379 fac3=dsqrt(-ael6i)*r3ij
3380 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3381 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3382 if (ees0tmp.gt.0) then
3383 ees0pij=dsqrt(ees0tmp)
3387 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3388 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3389 if (ees0tmp.gt.0) then
3390 ees0mij=dsqrt(ees0tmp)
3395 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3396 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3397 C Diagnostics. Comment out or remove after debugging!
3398 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3399 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3400 c ees0m(num_conti,i)=0.0D0
3402 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3403 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3404 C Angular derivatives of the contact function
3405 ees0pij1=fac3/ees0pij
3406 ees0mij1=fac3/ees0mij
3407 fac3p=-3.0D0*fac3*rrmij
3408 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3409 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3411 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3412 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3413 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3414 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3415 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3416 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3417 ecosap=ecosa1+ecosa2
3418 ecosbp=ecosb1+ecosb2
3419 ecosgp=ecosg1+ecosg2
3420 ecosam=ecosa1-ecosa2
3421 ecosbm=ecosb1-ecosb2
3422 ecosgm=ecosg1-ecosg2
3431 facont_hb(num_conti,i)=fcont
3432 fprimcont=fprimcont/rij
3433 cd facont_hb(num_conti,i)=1.0D0
3434 C Following line is for diagnostics.
3437 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3438 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3441 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3442 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3444 gggp(1)=gggp(1)+ees0pijp*xj
3445 gggp(2)=gggp(2)+ees0pijp*yj
3446 gggp(3)=gggp(3)+ees0pijp*zj
3447 gggm(1)=gggm(1)+ees0mijp*xj
3448 gggm(2)=gggm(2)+ees0mijp*yj
3449 gggm(3)=gggm(3)+ees0mijp*zj
3450 C Derivatives due to the contact function
3451 gacont_hbr(1,num_conti,i)=fprimcont*xj
3452 gacont_hbr(2,num_conti,i)=fprimcont*yj
3453 gacont_hbr(3,num_conti,i)=fprimcont*zj
3456 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3457 c following the change of gradient-summation algorithm.
3459 cgrad ghalfp=0.5D0*gggp(k)
3460 cgrad ghalfm=0.5D0*gggm(k)
3461 gacontp_hb1(k,num_conti,i)=!ghalfp
3462 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3463 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3464 gacontp_hb2(k,num_conti,i)=!ghalfp
3465 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3466 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3467 gacontp_hb3(k,num_conti,i)=gggp(k)
3468 gacontm_hb1(k,num_conti,i)=!ghalfm
3469 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3470 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3471 gacontm_hb2(k,num_conti,i)=!ghalfm
3472 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3473 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3474 gacontm_hb3(k,num_conti,i)=gggm(k)
3476 C Diagnostics. Comment out or remove after debugging!
3478 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3479 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3480 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3481 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3482 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3483 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3486 endif ! num_conti.le.maxconts
3489 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3492 ghalf=0.5d0*agg(l,k)
3493 aggi(l,k)=aggi(l,k)+ghalf
3494 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3495 aggj(l,k)=aggj(l,k)+ghalf
3498 if (j.eq.nres-1 .and. i.lt.j-2) then
3501 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3506 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3509 C-----------------------------------------------------------------------------
3510 subroutine eturn3(i,eello_turn3)
3511 C Third- and fourth-order contributions from turns
3512 implicit real*8 (a-h,o-z)
3513 include 'DIMENSIONS'
3514 include 'COMMON.IOUNITS'
3515 include 'COMMON.GEO'
3516 include 'COMMON.VAR'
3517 include 'COMMON.LOCAL'
3518 include 'COMMON.CHAIN'
3519 include 'COMMON.DERIV'
3520 include 'COMMON.INTERACT'
3521 include 'COMMON.CONTACTS'
3522 include 'COMMON.TORSION'
3523 include 'COMMON.VECTORS'
3524 include 'COMMON.FFIELD'
3525 include 'COMMON.CONTROL'
3527 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3528 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3529 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3530 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3531 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3532 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3533 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3536 c write (iout,*) "eturn3",i,j,j1,j2
3541 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3543 C Third-order contributions
3550 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3551 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3552 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3553 call transpose2(auxmat(1,1),auxmat1(1,1))
3554 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3555 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3556 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3557 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3558 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3559 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3560 cd & ' eello_turn3_num',4*eello_turn3_num
3561 C Derivatives in gamma(i)
3562 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3563 call transpose2(auxmat2(1,1),auxmat3(1,1))
3564 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3565 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3566 C Derivatives in gamma(i+1)
3567 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3568 call transpose2(auxmat2(1,1),auxmat3(1,1))
3569 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3570 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3571 & +0.5d0*(pizda(1,1)+pizda(2,2))
3572 C Cartesian derivatives
3574 c ghalf1=0.5d0*agg(l,1)
3575 c ghalf2=0.5d0*agg(l,2)
3576 c ghalf3=0.5d0*agg(l,3)
3577 c ghalf4=0.5d0*agg(l,4)
3578 a_temp(1,1)=aggi(l,1)!+ghalf1
3579 a_temp(1,2)=aggi(l,2)!+ghalf2
3580 a_temp(2,1)=aggi(l,3)!+ghalf3
3581 a_temp(2,2)=aggi(l,4)!+ghalf4
3582 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3583 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3584 & +0.5d0*(pizda(1,1)+pizda(2,2))
3585 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3586 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3587 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3588 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3589 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3590 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3591 & +0.5d0*(pizda(1,1)+pizda(2,2))
3592 a_temp(1,1)=aggj(l,1)!+ghalf1
3593 a_temp(1,2)=aggj(l,2)!+ghalf2
3594 a_temp(2,1)=aggj(l,3)!+ghalf3
3595 a_temp(2,2)=aggj(l,4)!+ghalf4
3596 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3597 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3598 & +0.5d0*(pizda(1,1)+pizda(2,2))
3599 a_temp(1,1)=aggj1(l,1)
3600 a_temp(1,2)=aggj1(l,2)
3601 a_temp(2,1)=aggj1(l,3)
3602 a_temp(2,2)=aggj1(l,4)
3603 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3604 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3605 & +0.5d0*(pizda(1,1)+pizda(2,2))
3609 C-------------------------------------------------------------------------------
3610 subroutine eturn4(i,eello_turn4)
3611 C Third- and fourth-order contributions from turns
3612 implicit real*8 (a-h,o-z)
3613 include 'DIMENSIONS'
3614 include 'COMMON.IOUNITS'
3615 include 'COMMON.GEO'
3616 include 'COMMON.VAR'
3617 include 'COMMON.LOCAL'
3618 include 'COMMON.CHAIN'
3619 include 'COMMON.DERIV'
3620 include 'COMMON.INTERACT'
3621 include 'COMMON.CONTACTS'
3622 include 'COMMON.TORSION'
3623 include 'COMMON.VECTORS'
3624 include 'COMMON.FFIELD'
3625 include 'COMMON.CONTROL'
3627 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3628 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3629 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3630 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3631 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3632 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3633 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3636 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3638 C Fourth-order contributions
3646 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3647 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3648 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3653 iti1=itortyp(itype(i+1))
3654 iti2=itortyp(itype(i+2))
3655 iti3=itortyp(itype(i+3))
3656 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3657 call transpose2(EUg(1,1,i+1),e1t(1,1))
3658 call transpose2(Eug(1,1,i+2),e2t(1,1))
3659 call transpose2(Eug(1,1,i+3),e3t(1,1))
3660 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3661 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3662 s1=scalar2(b1(1,iti2),auxvec(1))
3663 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3664 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3665 s2=scalar2(b1(1,iti1),auxvec(1))
3666 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3667 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3668 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3669 eello_turn4=eello_turn4-(s1+s2+s3)
3670 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3671 & 'eturn4',i,j,-(s1+s2+s3)
3672 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3673 cd & ' eello_turn4_num',8*eello_turn4_num
3674 C Derivatives in gamma(i)
3675 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3676 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3677 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3678 s1=scalar2(b1(1,iti2),auxvec(1))
3679 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3681 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3682 C Derivatives in gamma(i+1)
3683 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3684 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3685 s2=scalar2(b1(1,iti1),auxvec(1))
3686 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3687 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3688 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3689 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3690 C Derivatives in gamma(i+2)
3691 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3692 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3693 s1=scalar2(b1(1,iti2),auxvec(1))
3694 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3695 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3696 s2=scalar2(b1(1,iti1),auxvec(1))
3697 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3698 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3700 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3701 C Cartesian derivatives
3702 C Derivatives of this turn contributions in DC(i+2)
3703 if (j.lt.nres-1) then
3705 a_temp(1,1)=agg(l,1)
3706 a_temp(1,2)=agg(l,2)
3707 a_temp(2,1)=agg(l,3)
3708 a_temp(2,2)=agg(l,4)
3709 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3710 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3711 s1=scalar2(b1(1,iti2),auxvec(1))
3712 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3713 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3714 s2=scalar2(b1(1,iti1),auxvec(1))
3715 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3716 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3717 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3719 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3722 C Remaining derivatives of this turn contribution
3724 a_temp(1,1)=aggi(l,1)
3725 a_temp(1,2)=aggi(l,2)
3726 a_temp(2,1)=aggi(l,3)
3727 a_temp(2,2)=aggi(l,4)
3728 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3729 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3730 s1=scalar2(b1(1,iti2),auxvec(1))
3731 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3732 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3733 s2=scalar2(b1(1,iti1),auxvec(1))
3734 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3735 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3736 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3737 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3738 a_temp(1,1)=aggi1(l,1)
3739 a_temp(1,2)=aggi1(l,2)
3740 a_temp(2,1)=aggi1(l,3)
3741 a_temp(2,2)=aggi1(l,4)
3742 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3743 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3744 s1=scalar2(b1(1,iti2),auxvec(1))
3745 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3746 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3747 s2=scalar2(b1(1,iti1),auxvec(1))
3748 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3749 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3750 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3751 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3752 a_temp(1,1)=aggj(l,1)
3753 a_temp(1,2)=aggj(l,2)
3754 a_temp(2,1)=aggj(l,3)
3755 a_temp(2,2)=aggj(l,4)
3756 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3757 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3758 s1=scalar2(b1(1,iti2),auxvec(1))
3759 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3760 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3761 s2=scalar2(b1(1,iti1),auxvec(1))
3762 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3763 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3764 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3765 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3766 a_temp(1,1)=aggj1(l,1)
3767 a_temp(1,2)=aggj1(l,2)
3768 a_temp(2,1)=aggj1(l,3)
3769 a_temp(2,2)=aggj1(l,4)
3770 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3771 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3772 s1=scalar2(b1(1,iti2),auxvec(1))
3773 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3774 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3775 s2=scalar2(b1(1,iti1),auxvec(1))
3776 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3777 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3779 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3780 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3784 C-----------------------------------------------------------------------------
3785 subroutine vecpr(u,v,w)
3786 implicit real*8(a-h,o-z)
3787 dimension u(3),v(3),w(3)
3788 w(1)=u(2)*v(3)-u(3)*v(2)
3789 w(2)=-u(1)*v(3)+u(3)*v(1)
3790 w(3)=u(1)*v(2)-u(2)*v(1)
3793 C-----------------------------------------------------------------------------
3794 subroutine unormderiv(u,ugrad,unorm,ungrad)
3795 C This subroutine computes the derivatives of a normalized vector u, given
3796 C the derivatives computed without normalization conditions, ugrad. Returns
3799 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3800 double precision vec(3)
3801 double precision scalar
3803 c write (2,*) 'ugrad',ugrad
3806 vec(i)=scalar(ugrad(1,i),u(1))
3808 c write (2,*) 'vec',vec
3811 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3814 c write (2,*) 'ungrad',ungrad
3817 C-----------------------------------------------------------------------------
3818 subroutine escp_soft_sphere(evdw2,evdw2_14)
3820 C This subroutine calculates the excluded-volume interaction energy between
3821 C peptide-group centers and side chains and its gradient in virtual-bond and
3822 C side-chain vectors.
3824 implicit real*8 (a-h,o-z)
3825 include 'DIMENSIONS'
3826 include 'COMMON.GEO'
3827 include 'COMMON.VAR'
3828 include 'COMMON.LOCAL'
3829 include 'COMMON.CHAIN'
3830 include 'COMMON.DERIV'
3831 include 'COMMON.INTERACT'
3832 include 'COMMON.FFIELD'
3833 include 'COMMON.IOUNITS'
3834 include 'COMMON.CONTROL'
3839 cd print '(a)','Enter ESCP'
3840 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3841 do i=iatscp_s,iatscp_e
3842 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3844 xi=0.5D0*(c(1,i)+c(1,i+1))
3845 yi=0.5D0*(c(2,i)+c(2,i+1))
3846 zi=0.5D0*(c(3,i)+c(3,i+1))
3848 do iint=1,nscp_gr(i)
3850 do j=iscpstart(i,iint),iscpend(i,iint)
3851 if (itype(j).eq.ntyp1) cycle
3852 itypj=iabs(itype(j))
3853 C Uncomment following three lines for SC-p interactions
3857 C Uncomment following three lines for Ca-p interactions
3861 rij=xj*xj+yj*yj+zj*zj
3864 if (rij.lt.r0ijsq) then
3865 evdwij=0.25d0*(rij-r0ijsq)**2
3873 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3878 cgrad if (j.lt.i) then
3879 cd write (iout,*) 'j<i'
3880 C Uncomment following three lines for SC-p interactions
3882 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3885 cd write (iout,*) 'j>i'
3887 cgrad ggg(k)=-ggg(k)
3888 C Uncomment following line for SC-p interactions
3889 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3893 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3895 cgrad kstart=min0(i+1,j)
3896 cgrad kend=max0(i-1,j-1)
3897 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3898 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3899 cgrad do k=kstart,kend
3901 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3905 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3906 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3914 C-----------------------------------------------------------------------------
3915 subroutine escp(evdw2,evdw2_14)
3917 C This subroutine calculates the excluded-volume interaction energy between
3918 C peptide-group centers and side chains and its gradient in virtual-bond and
3919 C side-chain vectors.
3921 implicit real*8 (a-h,o-z)
3922 include 'DIMENSIONS'
3923 include 'COMMON.GEO'
3924 include 'COMMON.VAR'
3925 include 'COMMON.LOCAL'
3926 include 'COMMON.CHAIN'
3927 include 'COMMON.DERIV'
3928 include 'COMMON.INTERACT'
3929 include 'COMMON.FFIELD'
3930 include 'COMMON.IOUNITS'
3931 include 'COMMON.CONTROL'
3935 cd print '(a)','Enter ESCP'
3936 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3937 do i=iatscp_s,iatscp_e
3938 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3940 xi=0.5D0*(c(1,i)+c(1,i+1))
3941 yi=0.5D0*(c(2,i)+c(2,i+1))
3942 zi=0.5D0*(c(3,i)+c(3,i+1))
3944 do iint=1,nscp_gr(i)
3946 do j=iscpstart(i,iint),iscpend(i,iint)
3947 itypj=iabs(itype(j))
3948 if (itypj.eq.ntyp1) cycle
3949 C Uncomment following three lines for SC-p interactions
3953 C Uncomment following three lines for Ca-p interactions
3957 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3959 e1=fac*fac*aad(itypj,iteli)
3960 e2=fac*bad(itypj,iteli)
3961 if (iabs(j-i) .le. 2) then
3964 evdw2_14=evdw2_14+e1+e2
3968 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3969 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3972 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3974 fac=-(evdwij+e1)*rrij
3978 cgrad if (j.lt.i) then
3979 cd write (iout,*) 'j<i'
3980 C Uncomment following three lines for SC-p interactions
3982 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3985 cd write (iout,*) 'j>i'
3987 cgrad ggg(k)=-ggg(k)
3988 C Uncomment following line for SC-p interactions
3989 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3990 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3994 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3996 cgrad kstart=min0(i+1,j)
3997 cgrad kend=max0(i-1,j-1)
3998 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3999 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4000 cgrad do k=kstart,kend
4002 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4006 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4007 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4015 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4016 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4017 gradx_scp(j,i)=expon*gradx_scp(j,i)
4020 C******************************************************************************
4024 C To save time the factor EXPON has been extracted from ALL components
4025 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4028 C******************************************************************************
4031 C--------------------------------------------------------------------------
4032 subroutine edis(ehpb)
4034 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4036 implicit real*8 (a-h,o-z)
4037 include 'DIMENSIONS'
4038 include 'COMMON.SBRIDGE'
4039 include 'COMMON.CHAIN'
4040 include 'COMMON.DERIV'
4041 include 'COMMON.VAR'
4042 include 'COMMON.INTERACT'
4043 include 'COMMON.IOUNITS'
4046 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4047 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4048 if (link_end.eq.0) return
4049 do i=link_start,link_end
4050 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4051 C CA-CA distance used in regularization of structure.
4054 C iii and jjj point to the residues for which the distance is assigned.
4055 if (ii.gt.nres) then
4062 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4063 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4064 C distance and angle dependent SS bond potential.
4065 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4066 & iabs(itype(jjj)).eq.1) then
4067 call ssbond_ene(iii,jjj,eij)
4069 cd write (iout,*) "eij",eij
4071 C Calculate the distance between the two points and its difference from the
4075 C Get the force constant corresponding to this distance.
4077 C Calculate the contribution to energy.
4078 ehpb=ehpb+waga*rdis*rdis
4080 C Evaluate gradient.
4083 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4084 cd & ' waga=',waga,' fac=',fac
4086 ggg(j)=fac*(c(j,jj)-c(j,ii))
4088 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4089 C If this is a SC-SC distance, we need to calculate the contributions to the
4090 C Cartesian gradient in the SC vectors (ghpbx).
4093 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4094 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4097 cgrad do j=iii,jjj-1
4099 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4103 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4104 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4111 C--------------------------------------------------------------------------
4112 subroutine ssbond_ene(i,j,eij)
4114 C Calculate the distance and angle dependent SS-bond potential energy
4115 C using a free-energy function derived based on RHF/6-31G** ab initio
4116 C calculations of diethyl disulfide.
4118 C A. Liwo and U. Kozlowska, 11/24/03
4120 implicit real*8 (a-h,o-z)
4121 include 'DIMENSIONS'
4122 include 'COMMON.SBRIDGE'
4123 include 'COMMON.CHAIN'
4124 include 'COMMON.DERIV'
4125 include 'COMMON.LOCAL'
4126 include 'COMMON.INTERACT'
4127 include 'COMMON.VAR'
4128 include 'COMMON.IOUNITS'
4129 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4130 itypi=iabs(itype(i))
4134 dxi=dc_norm(1,nres+i)
4135 dyi=dc_norm(2,nres+i)
4136 dzi=dc_norm(3,nres+i)
4137 c dsci_inv=dsc_inv(itypi)
4138 dsci_inv=vbld_inv(nres+i)
4139 itypj=iabs(itype(j))
4140 c dscj_inv=dsc_inv(itypj)
4141 dscj_inv=vbld_inv(nres+j)
4145 dxj=dc_norm(1,nres+j)
4146 dyj=dc_norm(2,nres+j)
4147 dzj=dc_norm(3,nres+j)
4148 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4153 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4154 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4155 om12=dxi*dxj+dyi*dyj+dzi*dzj
4157 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4158 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4164 deltat12=om2-om1+2.0d0
4166 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4167 & +akct*deltad*deltat12
4168 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4169 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4170 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4171 c & " deltat12",deltat12," eij",eij
4172 ed=2*akcm*deltad+akct*deltat12
4174 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4175 eom1=-2*akth*deltat1-pom1-om2*pom2
4176 eom2= 2*akth*deltat2+pom1-om1*pom2
4179 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4180 ghpbx(k,i)=ghpbx(k,i)-ggk
4181 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4182 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4183 ghpbx(k,j)=ghpbx(k,j)+ggk
4184 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4185 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4186 ghpbc(k,i)=ghpbc(k,i)-ggk
4187 ghpbc(k,j)=ghpbc(k,j)+ggk
4190 C Calculate the components of the gradient in DC and X
4194 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4199 C--------------------------------------------------------------------------
4200 subroutine ebond(estr)
4202 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4204 implicit real*8 (a-h,o-z)
4205 include 'DIMENSIONS'
4206 include 'COMMON.LOCAL'
4207 include 'COMMON.GEO'
4208 include 'COMMON.INTERACT'
4209 include 'COMMON.DERIV'
4210 include 'COMMON.VAR'
4211 include 'COMMON.CHAIN'
4212 include 'COMMON.IOUNITS'
4213 include 'COMMON.NAMES'
4214 include 'COMMON.FFIELD'
4215 include 'COMMON.CONTROL'
4216 include 'COMMON.SETUP'
4217 double precision u(3),ud(3)
4220 do i=ibondp_start,ibondp_end
4221 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4222 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4224 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4225 & *dc(j,i-1)/vbld(i)
4227 if (energy_dec) write(iout,*)
4228 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4230 diff = vbld(i)-vbldp0
4231 if (energy_dec) write (iout,*)
4232 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4235 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4237 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4240 estr=0.5d0*AKP*estr+estr1
4242 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4244 do i=ibond_start,ibond_end
4246 if (iti.ne.10 .and. iti.ne.ntyp1) then
4249 diff=vbld(i+nres)-vbldsc0(1,iti)
4250 if (energy_dec) write (iout,*)
4251 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4252 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4253 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4255 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4259 diff=vbld(i+nres)-vbldsc0(j,iti)
4260 ud(j)=aksc(j,iti)*diff
4261 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4275 uprod2=uprod2*u(k)*u(k)
4279 usumsqder=usumsqder+ud(j)*uprod2
4281 estr=estr+uprod/usum
4283 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4291 C--------------------------------------------------------------------------
4292 subroutine ebend(etheta)
4294 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4295 C angles gamma and its derivatives in consecutive thetas and gammas.
4297 implicit real*8 (a-h,o-z)
4298 include 'DIMENSIONS'
4299 include 'COMMON.LOCAL'
4300 include 'COMMON.GEO'
4301 include 'COMMON.INTERACT'
4302 include 'COMMON.DERIV'
4303 include 'COMMON.VAR'
4304 include 'COMMON.CHAIN'
4305 include 'COMMON.IOUNITS'
4306 include 'COMMON.NAMES'
4307 include 'COMMON.FFIELD'
4308 include 'COMMON.CONTROL'
4309 common /calcthet/ term1,term2,termm,diffak,ratak,
4310 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4311 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4312 double precision y(2),z(2)
4314 c time11=dexp(-2*time)
4317 c write (*,'(a,i2)') 'EBEND ICG=',icg
4318 do i=ithet_start,ithet_end
4319 if (itype(i-1).eq.ntyp1) cycle
4320 C Zero the energy function and its derivative at 0 or pi.
4321 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4323 ichir1=isign(1,itype(i-2))
4324 ichir2=isign(1,itype(i))
4325 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4326 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4327 if (itype(i-1).eq.10) then
4328 itype1=isign(10,itype(i-2))
4329 ichir11=isign(1,itype(i-2))
4330 ichir12=isign(1,itype(i-2))
4331 itype2=isign(10,itype(i))
4332 ichir21=isign(1,itype(i))
4333 ichir22=isign(1,itype(i))
4336 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4339 if (phii.ne.phii) phii=150.0
4349 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4352 if (phii1.ne.phii1) phii1=150.0
4364 C Calculate the "mean" value of theta from the part of the distribution
4365 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4366 C In following comments this theta will be referred to as t_c.
4367 thet_pred_mean=0.0d0
4369 athetk=athet(k,it,ichir1,ichir2)
4370 bthetk=bthet(k,it,ichir1,ichir2)
4372 athetk=athet(k,itype1,ichir11,ichir12)
4373 bthetk=bthet(k,itype2,ichir21,ichir22)
4375 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4377 dthett=thet_pred_mean*ssd
4378 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4379 C Derivatives of the "mean" values in gamma1 and gamma2.
4380 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4381 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4382 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4383 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4385 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4386 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4387 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4388 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4390 if (theta(i).gt.pi-delta) then
4391 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4393 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4394 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4395 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4397 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4399 else if (theta(i).lt.delta) then
4400 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4401 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4402 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4404 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4405 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4408 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4411 etheta=etheta+ethetai
4412 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4414 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4415 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4416 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4418 C Ufff.... We've done all this!!!
4421 C---------------------------------------------------------------------------
4422 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4424 implicit real*8 (a-h,o-z)
4425 include 'DIMENSIONS'
4426 include 'COMMON.LOCAL'
4427 include 'COMMON.IOUNITS'
4428 common /calcthet/ term1,term2,termm,diffak,ratak,
4429 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4430 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4431 C Calculate the contributions to both Gaussian lobes.
4432 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4433 C The "polynomial part" of the "standard deviation" of this part of
4437 sig=sig*thet_pred_mean+polthet(j,it)
4439 C Derivative of the "interior part" of the "standard deviation of the"
4440 C gamma-dependent Gaussian lobe in t_c.
4441 sigtc=3*polthet(3,it)
4443 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4446 C Set the parameters of both Gaussian lobes of the distribution.
4447 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4448 fac=sig*sig+sigc0(it)
4451 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4452 sigsqtc=-4.0D0*sigcsq*sigtc
4453 c print *,i,sig,sigtc,sigsqtc
4454 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4455 sigtc=-sigtc/(fac*fac)
4456 C Following variable is sigma(t_c)**(-2)
4457 sigcsq=sigcsq*sigcsq
4459 sig0inv=1.0D0/sig0i**2
4460 delthec=thetai-thet_pred_mean
4461 delthe0=thetai-theta0i
4462 term1=-0.5D0*sigcsq*delthec*delthec
4463 term2=-0.5D0*sig0inv*delthe0*delthe0
4464 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4465 C NaNs in taking the logarithm. We extract the largest exponent which is added
4466 C to the energy (this being the log of the distribution) at the end of energy
4467 C term evaluation for this virtual-bond angle.
4468 if (term1.gt.term2) then
4470 term2=dexp(term2-termm)
4474 term1=dexp(term1-termm)
4477 C The ratio between the gamma-independent and gamma-dependent lobes of
4478 C the distribution is a Gaussian function of thet_pred_mean too.
4479 diffak=gthet(2,it)-thet_pred_mean
4480 ratak=diffak/gthet(3,it)**2
4481 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4482 C Let's differentiate it in thet_pred_mean NOW.
4484 C Now put together the distribution terms to make complete distribution.
4485 termexp=term1+ak*term2
4486 termpre=sigc+ak*sig0i
4487 C Contribution of the bending energy from this theta is just the -log of
4488 C the sum of the contributions from the two lobes and the pre-exponential
4489 C factor. Simple enough, isn't it?
4490 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4491 C NOW the derivatives!!!
4492 C 6/6/97 Take into account the deformation.
4493 E_theta=(delthec*sigcsq*term1
4494 & +ak*delthe0*sig0inv*term2)/termexp
4495 E_tc=((sigtc+aktc*sig0i)/termpre
4496 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4497 & aktc*term2)/termexp)
4500 c-----------------------------------------------------------------------------
4501 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4502 implicit real*8 (a-h,o-z)
4503 include 'DIMENSIONS'
4504 include 'COMMON.LOCAL'
4505 include 'COMMON.IOUNITS'
4506 common /calcthet/ term1,term2,termm,diffak,ratak,
4507 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4508 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4509 delthec=thetai-thet_pred_mean
4510 delthe0=thetai-theta0i
4511 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4512 t3 = thetai-thet_pred_mean
4516 t14 = t12+t6*sigsqtc
4518 t21 = thetai-theta0i
4524 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4525 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4526 & *(-t12*t9-ak*sig0inv*t27)
4530 C--------------------------------------------------------------------------
4531 subroutine ebend(etheta)
4533 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4534 C angles gamma and its derivatives in consecutive thetas and gammas.
4535 C ab initio-derived potentials from
4536 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4538 implicit real*8 (a-h,o-z)
4539 include 'DIMENSIONS'
4540 include 'COMMON.LOCAL'
4541 include 'COMMON.GEO'
4542 include 'COMMON.INTERACT'
4543 include 'COMMON.DERIV'
4544 include 'COMMON.VAR'
4545 include 'COMMON.CHAIN'
4546 include 'COMMON.IOUNITS'
4547 include 'COMMON.NAMES'
4548 include 'COMMON.FFIELD'
4549 include 'COMMON.CONTROL'
4550 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4551 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4552 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4553 & sinph1ph2(maxdouble,maxdouble)
4554 logical lprn /.false./, lprn1 /.false./
4556 do i=ithet_start,ithet_end
4557 if (itype(i-1).eq.ntyp1) cycle
4558 if (iabs(itype(i+1)).eq.20) iblock=2
4559 if (iabs(itype(i+1)).ne.20) iblock=1
4563 theti2=0.5d0*theta(i)
4564 ityp2=ithetyp((itype(i-1)))
4566 coskt(k)=dcos(k*theti2)
4567 sinkt(k)=dsin(k*theti2)
4569 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4572 if (phii.ne.phii) phii=150.0
4576 ityp1=ithetyp((itype(i-2)))
4577 C propagation of chirality for glycine type
4579 cosph1(k)=dcos(k*phii)
4580 sinph1(k)=dsin(k*phii)
4590 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4593 if (phii1.ne.phii1) phii1=150.0
4598 ityp3=ithetyp((itype(i)))
4600 cosph2(k)=dcos(k*phii1)
4601 sinph2(k)=dsin(k*phii1)
4611 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4614 ccl=cosph1(l)*cosph2(k-l)
4615 ssl=sinph1(l)*sinph2(k-l)
4616 scl=sinph1(l)*cosph2(k-l)
4617 csl=cosph1(l)*sinph2(k-l)
4618 cosph1ph2(l,k)=ccl-ssl
4619 cosph1ph2(k,l)=ccl+ssl
4620 sinph1ph2(l,k)=scl+csl
4621 sinph1ph2(k,l)=scl-csl
4625 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4626 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4627 write (iout,*) "coskt and sinkt"
4629 write (iout,*) k,coskt(k),sinkt(k)
4633 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4634 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4637 & write (iout,*) "k",k,"
4638 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4639 & " ethetai",ethetai
4642 write (iout,*) "cosph and sinph"
4644 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4646 write (iout,*) "cosph1ph2 and sinph2ph2"
4649 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4650 & sinph1ph2(l,k),sinph1ph2(k,l)
4653 write(iout,*) "ethetai",ethetai
4657 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4658 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4659 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4660 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4661 ethetai=ethetai+sinkt(m)*aux
4662 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4663 dephii=dephii+k*sinkt(m)*(
4664 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4665 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4666 dephii1=dephii1+k*sinkt(m)*(
4667 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4668 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4670 & write (iout,*) "m",m," k",k," bbthet",
4671 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4672 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4673 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4674 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4678 & write(iout,*) "ethetai",ethetai
4682 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4683 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4684 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4685 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4686 ethetai=ethetai+sinkt(m)*aux
4687 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4688 dephii=dephii+l*sinkt(m)*(
4689 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4690 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4691 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4692 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4693 dephii1=dephii1+(k-l)*sinkt(m)*(
4694 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4695 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4696 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4697 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4699 write (iout,*) "m",m," k",k," l",l," ffthet",
4700 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4701 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4702 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4703 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4704 & " ethetai",ethetai
4705 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4706 & cosph1ph2(k,l)*sinkt(m),
4707 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4715 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4716 & i,theta(i)*rad2deg,phii*rad2deg,
4717 & phii1*rad2deg,ethetai
4719 etheta=etheta+ethetai
4720 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4721 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4722 gloc(nphi+i-2,icg)=wang*dethetai
4728 c-----------------------------------------------------------------------------
4729 subroutine esc(escloc)
4730 C Calculate the local energy of a side chain and its derivatives in the
4731 C corresponding virtual-bond valence angles THETA and the spherical angles
4733 implicit real*8 (a-h,o-z)
4734 include 'DIMENSIONS'
4735 include 'COMMON.GEO'
4736 include 'COMMON.LOCAL'
4737 include 'COMMON.VAR'
4738 include 'COMMON.INTERACT'
4739 include 'COMMON.DERIV'
4740 include 'COMMON.CHAIN'
4741 include 'COMMON.IOUNITS'
4742 include 'COMMON.NAMES'
4743 include 'COMMON.FFIELD'
4744 include 'COMMON.CONTROL'
4745 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4746 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4747 common /sccalc/ time11,time12,time112,theti,it,nlobit
4750 c write (iout,'(a)') 'ESC'
4751 do i=loc_start,loc_end
4753 if (it.eq.ntyp1) cycle
4754 if (it.eq.10) goto 1
4755 nlobit=nlob(iabs(it))
4756 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4757 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4758 theti=theta(i+1)-pipol
4763 if (x(2).gt.pi-delta) then
4767 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4769 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4770 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4772 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4773 & ddersc0(1),dersc(1))
4774 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4775 & ddersc0(3),dersc(3))
4777 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4779 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4780 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4781 & dersc0(2),esclocbi,dersc02)
4782 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4784 call splinthet(x(2),0.5d0*delta,ss,ssd)
4789 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4791 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4792 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4794 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4796 c write (iout,*) escloci
4797 else if (x(2).lt.delta) then
4801 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4803 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4804 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4806 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4807 & ddersc0(1),dersc(1))
4808 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4809 & ddersc0(3),dersc(3))
4811 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4813 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4814 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4815 & dersc0(2),esclocbi,dersc02)
4816 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4821 call splinthet(x(2),0.5d0*delta,ss,ssd)
4823 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4825 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4826 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4828 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4829 c write (iout,*) escloci
4831 call enesc(x,escloci,dersc,ddummy,.false.)
4834 escloc=escloc+escloci
4835 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4836 & 'escloc',i,escloci
4837 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4839 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4841 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4842 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4847 C---------------------------------------------------------------------------
4848 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4849 implicit real*8 (a-h,o-z)
4850 include 'DIMENSIONS'
4851 include 'COMMON.GEO'
4852 include 'COMMON.LOCAL'
4853 include 'COMMON.IOUNITS'
4854 common /sccalc/ time11,time12,time112,theti,it,nlobit
4855 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4856 double precision contr(maxlob,-1:1)
4858 c write (iout,*) 'it=',it,' nlobit=',nlobit
4862 if (mixed) ddersc(j)=0.0d0
4866 C Because of periodicity of the dependence of the SC energy in omega we have
4867 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4868 C To avoid underflows, first compute & store the exponents.
4876 z(k)=x(k)-censc(k,j,it)
4881 Axk=Axk+gaussc(l,k,j,it)*z(l)
4887 expfac=expfac+Ax(k,j,iii)*z(k)
4895 C As in the case of ebend, we want to avoid underflows in exponentiation and
4896 C subsequent NaNs and INFs in energy calculation.
4897 C Find the largest exponent
4901 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4905 cd print *,'it=',it,' emin=',emin
4907 C Compute the contribution to SC energy and derivatives
4912 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4913 if(adexp.ne.adexp) adexp=1.0
4916 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4918 cd print *,'j=',j,' expfac=',expfac
4919 escloc_i=escloc_i+expfac
4921 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4925 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4926 & +gaussc(k,2,j,it))*expfac
4933 dersc(1)=dersc(1)/cos(theti)**2
4934 ddersc(1)=ddersc(1)/cos(theti)**2
4937 escloci=-(dlog(escloc_i)-emin)
4939 dersc(j)=dersc(j)/escloc_i
4943 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4948 C------------------------------------------------------------------------------
4949 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4950 implicit real*8 (a-h,o-z)
4951 include 'DIMENSIONS'
4952 include 'COMMON.GEO'
4953 include 'COMMON.LOCAL'
4954 include 'COMMON.IOUNITS'
4955 common /sccalc/ time11,time12,time112,theti,it,nlobit
4956 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4957 double precision contr(maxlob)
4968 z(k)=x(k)-censc(k,j,it)
4974 Axk=Axk+gaussc(l,k,j,it)*z(l)
4980 expfac=expfac+Ax(k,j)*z(k)
4985 C As in the case of ebend, we want to avoid underflows in exponentiation and
4986 C subsequent NaNs and INFs in energy calculation.
4987 C Find the largest exponent
4990 if (emin.gt.contr(j)) emin=contr(j)
4994 C Compute the contribution to SC energy and derivatives
4998 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4999 escloc_i=escloc_i+expfac
5001 dersc(k)=dersc(k)+Ax(k,j)*expfac
5003 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5004 & +gaussc(1,2,j,it))*expfac
5008 dersc(1)=dersc(1)/cos(theti)**2
5009 dersc12=dersc12/cos(theti)**2
5010 escloci=-(dlog(escloc_i)-emin)
5012 dersc(j)=dersc(j)/escloc_i
5014 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5018 c----------------------------------------------------------------------------------
5019 subroutine esc(escloc)
5020 C Calculate the local energy of a side chain and its derivatives in the
5021 C corresponding virtual-bond valence angles THETA and the spherical angles
5022 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5023 C added by Urszula Kozlowska. 07/11/2007
5025 implicit real*8 (a-h,o-z)
5026 include 'DIMENSIONS'
5027 include 'COMMON.GEO'
5028 include 'COMMON.LOCAL'
5029 include 'COMMON.VAR'
5030 include 'COMMON.SCROT'
5031 include 'COMMON.INTERACT'
5032 include 'COMMON.DERIV'
5033 include 'COMMON.CHAIN'
5034 include 'COMMON.IOUNITS'
5035 include 'COMMON.NAMES'
5036 include 'COMMON.FFIELD'
5037 include 'COMMON.CONTROL'
5038 include 'COMMON.VECTORS'
5039 double precision x_prime(3),y_prime(3),z_prime(3)
5040 & , sumene,dsc_i,dp2_i,x(65),
5041 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5042 & de_dxx,de_dyy,de_dzz,de_dt
5043 double precision s1_t,s1_6_t,s2_t,s2_6_t
5045 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5046 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5047 & dt_dCi(3),dt_dCi1(3)
5048 common /sccalc/ time11,time12,time112,theti,it,nlobit
5051 do i=loc_start,loc_end
5052 if (itype(i).eq.ntyp1) cycle
5053 costtab(i+1) =dcos(theta(i+1))
5054 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5055 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5056 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5057 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5058 cosfac=dsqrt(cosfac2)
5059 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5060 sinfac=dsqrt(sinfac2)
5062 if (it.eq.10) goto 1
5064 C Compute the axes of tghe local cartesian coordinates system; store in
5065 c x_prime, y_prime and z_prime
5072 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5073 C & dc_norm(3,i+nres)
5075 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5076 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5079 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5082 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5083 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5084 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5085 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5086 c & " xy",scalar(x_prime(1),y_prime(1)),
5087 c & " xz",scalar(x_prime(1),z_prime(1)),
5088 c & " yy",scalar(y_prime(1),y_prime(1)),
5089 c & " yz",scalar(y_prime(1),z_prime(1)),
5090 c & " zz",scalar(z_prime(1),z_prime(1))
5092 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5093 C to local coordinate system. Store in xx, yy, zz.
5099 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5100 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5101 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5108 C Compute the energy of the ith side cbain
5110 c write (2,*) "xx",xx," yy",yy," zz",zz
5113 x(j) = sc_parmin(j,it)
5116 Cc diagnostics - remove later
5118 yy1 = dsin(alph(2))*dcos(omeg(2))
5119 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5120 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5121 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5123 C," --- ", xx_w,yy_w,zz_w
5126 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5127 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5129 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5130 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5132 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5133 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5134 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5135 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5136 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5138 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5139 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5140 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5141 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5142 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5144 dsc_i = 0.743d0+x(61)
5146 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5147 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5148 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5149 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5150 s1=(1+x(63))/(0.1d0 + dscp1)
5151 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5152 s2=(1+x(65))/(0.1d0 + dscp2)
5153 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5154 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5155 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5156 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5158 c & dscp1,dscp2,sumene
5159 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5160 escloc = escloc + sumene
5161 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5166 C This section to check the numerical derivatives of the energy of ith side
5167 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5168 C #define DEBUG in the code to turn it on.
5170 write (2,*) "sumene =",sumene
5174 write (2,*) xx,yy,zz
5175 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5176 de_dxx_num=(sumenep-sumene)/aincr
5178 write (2,*) "xx+ sumene from enesc=",sumenep
5181 write (2,*) xx,yy,zz
5182 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5183 de_dyy_num=(sumenep-sumene)/aincr
5185 write (2,*) "yy+ sumene from enesc=",sumenep
5188 write (2,*) xx,yy,zz
5189 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5190 de_dzz_num=(sumenep-sumene)/aincr
5192 write (2,*) "zz+ sumene from enesc=",sumenep
5193 costsave=cost2tab(i+1)
5194 sintsave=sint2tab(i+1)
5195 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5196 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5197 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5198 de_dt_num=(sumenep-sumene)/aincr
5199 write (2,*) " t+ sumene from enesc=",sumenep
5200 cost2tab(i+1)=costsave
5201 sint2tab(i+1)=sintsave
5202 C End of diagnostics section.
5205 C Compute the gradient of esc
5207 c zz=zz*dsign(1.0,dfloat(itype(i)))
5208 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5209 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5210 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5211 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5212 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5213 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5214 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5215 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5216 pom1=(sumene3*sint2tab(i+1)+sumene1)
5217 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5218 pom2=(sumene4*cost2tab(i+1)+sumene2)
5219 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5220 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5221 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5222 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5224 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5225 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5226 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5228 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5229 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5230 & +(pom1+pom2)*pom_dx
5232 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5235 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5236 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5237 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5239 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5240 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5241 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5242 & +x(59)*zz**2 +x(60)*xx*zz
5243 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5244 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5245 & +(pom1-pom2)*pom_dy
5247 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5250 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5251 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5252 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5253 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5254 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5255 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5256 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5257 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5259 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5262 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5263 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5264 & +pom1*pom_dt1+pom2*pom_dt2
5266 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5271 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5272 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5273 cosfac2xx=cosfac2*xx
5274 sinfac2yy=sinfac2*yy
5276 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5278 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5280 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5281 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5282 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5283 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5284 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5285 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5286 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5287 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5288 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5289 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5293 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5294 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5295 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5296 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5299 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5300 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5301 dZZ_XYZ(k)=vbld_inv(i+nres)*
5302 & (z_prime(k)-zz*dC_norm(k,i+nres))
5304 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5305 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5309 dXX_Ctab(k,i)=dXX_Ci(k)
5310 dXX_C1tab(k,i)=dXX_Ci1(k)
5311 dYY_Ctab(k,i)=dYY_Ci(k)
5312 dYY_C1tab(k,i)=dYY_Ci1(k)
5313 dZZ_Ctab(k,i)=dZZ_Ci(k)
5314 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5315 dXX_XYZtab(k,i)=dXX_XYZ(k)
5316 dYY_XYZtab(k,i)=dYY_XYZ(k)
5317 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5321 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5322 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5323 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5324 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5325 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5327 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5328 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5329 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5330 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5331 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5332 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5333 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5334 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5336 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5337 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5339 C to check gradient call subroutine check_grad
5345 c------------------------------------------------------------------------------
5346 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5348 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5349 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5350 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5351 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5353 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5354 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5356 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5357 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5358 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5359 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5360 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5362 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5363 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5364 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5365 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5366 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5368 dsc_i = 0.743d0+x(61)
5370 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5371 & *(xx*cost2+yy*sint2))
5372 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5373 & *(xx*cost2-yy*sint2))
5374 s1=(1+x(63))/(0.1d0 + dscp1)
5375 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5376 s2=(1+x(65))/(0.1d0 + dscp2)
5377 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5378 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5379 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5384 c------------------------------------------------------------------------------
5385 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5387 C This procedure calculates two-body contact function g(rij) and its derivative:
5390 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5393 C where x=(rij-r0ij)/delta
5395 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5398 double precision rij,r0ij,eps0ij,fcont,fprimcont
5399 double precision x,x2,x4,delta
5403 if (x.lt.-1.0D0) then
5406 else if (x.le.1.0D0) then
5409 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5410 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5417 c------------------------------------------------------------------------------
5418 subroutine splinthet(theti,delta,ss,ssder)
5419 implicit real*8 (a-h,o-z)
5420 include 'DIMENSIONS'
5421 include 'COMMON.VAR'
5422 include 'COMMON.GEO'
5425 if (theti.gt.pipol) then
5426 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5428 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5433 c------------------------------------------------------------------------------
5434 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5436 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5437 double precision ksi,ksi2,ksi3,a1,a2,a3
5438 a1=fprim0*delta/(f1-f0)
5444 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5445 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5448 c------------------------------------------------------------------------------
5449 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5451 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5452 double precision ksi,ksi2,ksi3,a1,a2,a3
5457 a2=3*(f1x-f0x)-2*fprim0x*delta
5458 a3=fprim0x*delta-2*(f1x-f0x)
5459 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5462 C-----------------------------------------------------------------------------
5464 C-----------------------------------------------------------------------------
5465 subroutine etor(etors,edihcnstr)
5466 implicit real*8 (a-h,o-z)
5467 include 'DIMENSIONS'
5468 include 'COMMON.VAR'
5469 include 'COMMON.GEO'
5470 include 'COMMON.LOCAL'
5471 include 'COMMON.TORSION'
5472 include 'COMMON.INTERACT'
5473 include 'COMMON.DERIV'
5474 include 'COMMON.CHAIN'
5475 include 'COMMON.NAMES'
5476 include 'COMMON.IOUNITS'
5477 include 'COMMON.FFIELD'
5478 include 'COMMON.TORCNSTR'
5479 include 'COMMON.CONTROL'
5481 C Set lprn=.true. for debugging
5485 do i=iphi_start,iphi_end
5487 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5488 & .or. itype(i).eq.ntyp1) cycle
5489 itori=itortyp(itype(i-2))
5490 itori1=itortyp(itype(i-1))
5493 C Proline-Proline pair is a special case...
5494 if (itori.eq.3 .and. itori1.eq.3) then
5495 if (phii.gt.-dwapi3) then
5497 fac=1.0D0/(1.0D0-cosphi)
5498 etorsi=v1(1,3,3)*fac
5499 etorsi=etorsi+etorsi
5500 etors=etors+etorsi-v1(1,3,3)
5501 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5502 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5505 v1ij=v1(j+1,itori,itori1)
5506 v2ij=v2(j+1,itori,itori1)
5509 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5510 if (energy_dec) etors_ii=etors_ii+
5511 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5512 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5516 v1ij=v1(j,itori,itori1)
5517 v2ij=v2(j,itori,itori1)
5520 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5521 if (energy_dec) etors_ii=etors_ii+
5522 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5523 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5526 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5529 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5530 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5531 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5532 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5533 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5535 ! 6/20/98 - dihedral angle constraints
5538 itori=idih_constr(i)
5541 if (difi.gt.drange(i)) then
5543 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5544 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5545 else if (difi.lt.-drange(i)) then
5547 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5548 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5550 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5551 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5553 ! write (iout,*) 'edihcnstr',edihcnstr
5556 c------------------------------------------------------------------------------
5557 subroutine etor_d(etors_d)
5561 c----------------------------------------------------------------------------
5563 subroutine etor(etors,edihcnstr)
5564 implicit real*8 (a-h,o-z)
5565 include 'DIMENSIONS'
5566 include 'COMMON.VAR'
5567 include 'COMMON.GEO'
5568 include 'COMMON.LOCAL'
5569 include 'COMMON.TORSION'
5570 include 'COMMON.INTERACT'
5571 include 'COMMON.DERIV'
5572 include 'COMMON.CHAIN'
5573 include 'COMMON.NAMES'
5574 include 'COMMON.IOUNITS'
5575 include 'COMMON.FFIELD'
5576 include 'COMMON.TORCNSTR'
5577 include 'COMMON.CONTROL'
5579 C Set lprn=.true. for debugging
5583 do i=iphi_start,iphi_end
5584 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5585 & .or. itype(i).eq.ntyp1) cycle
5587 if (iabs(itype(i)).eq.20) then
5592 itori=itortyp(itype(i-2))
5593 itori1=itortyp(itype(i-1))
5596 C Regular cosine and sine terms
5597 do j=1,nterm(itori,itori1,iblock)
5598 v1ij=v1(j,itori,itori1,iblock)
5599 v2ij=v2(j,itori,itori1,iblock)
5602 etors=etors+v1ij*cosphi+v2ij*sinphi
5603 if (energy_dec) etors_ii=etors_ii+
5604 & v1ij*cosphi+v2ij*sinphi
5605 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5609 C E = SUM ----------------------------------- - v1
5610 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5612 cosphi=dcos(0.5d0*phii)
5613 sinphi=dsin(0.5d0*phii)
5614 do j=1,nlor(itori,itori1,iblock)
5615 vl1ij=vlor1(j,itori,itori1)
5616 vl2ij=vlor2(j,itori,itori1)
5617 vl3ij=vlor3(j,itori,itori1)
5618 pom=vl2ij*cosphi+vl3ij*sinphi
5619 pom1=1.0d0/(pom*pom+1.0d0)
5620 etors=etors+vl1ij*pom1
5621 if (energy_dec) etors_ii=etors_ii+
5624 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5626 C Subtract the constant term
5627 etors=etors-v0(itori,itori1,iblock)
5628 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5629 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5631 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5632 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5633 & (v1(j,itori,itori1,iblock),j=1,6),
5634 & (v2(j,itori,itori1,iblock),j=1,6)
5635 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5636 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5638 ! 6/20/98 - dihedral angle constraints
5640 c do i=1,ndih_constr
5641 do i=idihconstr_start,idihconstr_end
5642 itori=idih_constr(i)
5644 difi=pinorm(phii-phi0(i))
5645 if (difi.gt.drange(i)) then
5647 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5648 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5649 else if (difi.lt.-drange(i)) then
5651 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5652 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5656 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5657 cd & rad2deg*phi0(i), rad2deg*drange(i),
5658 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5660 cd write (iout,*) 'edihcnstr',edihcnstr
5663 c----------------------------------------------------------------------------
5664 subroutine etor_d(etors_d)
5665 C 6/23/01 Compute double torsional energy
5666 implicit real*8 (a-h,o-z)
5667 include 'DIMENSIONS'
5668 include 'COMMON.VAR'
5669 include 'COMMON.GEO'
5670 include 'COMMON.LOCAL'
5671 include 'COMMON.TORSION'
5672 include 'COMMON.INTERACT'
5673 include 'COMMON.DERIV'
5674 include 'COMMON.CHAIN'
5675 include 'COMMON.NAMES'
5676 include 'COMMON.IOUNITS'
5677 include 'COMMON.FFIELD'
5678 include 'COMMON.TORCNSTR'
5680 C Set lprn=.true. for debugging
5684 c write(iout,*) "a tu??"
5685 do i=iphid_start,iphid_end
5686 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5687 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5688 itori=itortyp(itype(i-2))
5689 itori1=itortyp(itype(i-1))
5690 itori2=itortyp(itype(i))
5696 if (iabs(itype(i+1)).eq.20) iblock=2
5698 C Regular cosine and sine terms
5699 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5700 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5701 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5702 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5703 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5704 cosphi1=dcos(j*phii)
5705 sinphi1=dsin(j*phii)
5706 cosphi2=dcos(j*phii1)
5707 sinphi2=dsin(j*phii1)
5708 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5709 & v2cij*cosphi2+v2sij*sinphi2
5710 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5711 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5713 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5715 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5716 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5717 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5718 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5719 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5720 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5721 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5722 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5723 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5724 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5725 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5726 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5727 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5728 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5731 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5732 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5737 c------------------------------------------------------------------------------
5738 subroutine eback_sc_corr(esccor)
5739 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5740 c conformational states; temporarily implemented as differences
5741 c between UNRES torsional potentials (dependent on three types of
5742 c residues) and the torsional potentials dependent on all 20 types
5743 c of residues computed from AM1 energy surfaces of terminally-blocked
5744 c amino-acid residues.
5745 implicit real*8 (a-h,o-z)
5746 include 'DIMENSIONS'
5747 include 'COMMON.VAR'
5748 include 'COMMON.GEO'
5749 include 'COMMON.LOCAL'
5750 include 'COMMON.TORSION'
5751 include 'COMMON.SCCOR'
5752 include 'COMMON.INTERACT'
5753 include 'COMMON.DERIV'
5754 include 'COMMON.CHAIN'
5755 include 'COMMON.NAMES'
5756 include 'COMMON.IOUNITS'
5757 include 'COMMON.FFIELD'
5758 include 'COMMON.CONTROL'
5760 C Set lprn=.true. for debugging
5763 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5765 do i=itau_start,itau_end
5766 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5768 isccori=isccortyp(itype(i-2))
5769 isccori1=isccortyp(itype(i-1))
5770 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5772 do intertyp=1,3 !intertyp
5773 cc Added 09 May 2012 (Adasko)
5774 cc Intertyp means interaction type of backbone mainchain correlation:
5775 c 1 = SC...Ca...Ca...Ca
5776 c 2 = Ca...Ca...Ca...SC
5777 c 3 = SC...Ca...Ca...SCi
5779 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5780 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5781 & (itype(i-1).eq.ntyp1)))
5782 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5783 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5784 & .or.(itype(i).eq.ntyp1)))
5785 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5786 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5787 & (itype(i-3).eq.ntyp1)))) cycle
5788 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5789 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5791 do j=1,nterm_sccor(isccori,isccori1)
5792 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5793 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5794 cosphi=dcos(j*tauangle(intertyp,i))
5795 sinphi=dsin(j*tauangle(intertyp,i))
5796 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5797 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5799 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5800 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5802 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5803 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5804 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5805 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5806 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5812 c----------------------------------------------------------------------------
5813 subroutine multibody(ecorr)
5814 C This subroutine calculates multi-body contributions to energy following
5815 C the idea of Skolnick et al. If side chains I and J make a contact and
5816 C at the same time side chains I+1 and J+1 make a contact, an extra
5817 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5818 implicit real*8 (a-h,o-z)
5819 include 'DIMENSIONS'
5820 include 'COMMON.IOUNITS'
5821 include 'COMMON.DERIV'
5822 include 'COMMON.INTERACT'
5823 include 'COMMON.CONTACTS'
5824 double precision gx(3),gx1(3)
5827 C Set lprn=.true. for debugging
5831 write (iout,'(a)') 'Contact function values:'
5833 write (iout,'(i2,20(1x,i2,f10.5))')
5834 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5849 num_conti=num_cont(i)
5850 num_conti1=num_cont(i1)
5855 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5856 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5857 cd & ' ishift=',ishift
5858 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5859 C The system gains extra energy.
5860 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5861 endif ! j1==j+-ishift
5870 c------------------------------------------------------------------------------
5871 double precision function esccorr(i,j,k,l,jj,kk)
5872 implicit real*8 (a-h,o-z)
5873 include 'DIMENSIONS'
5874 include 'COMMON.IOUNITS'
5875 include 'COMMON.DERIV'
5876 include 'COMMON.INTERACT'
5877 include 'COMMON.CONTACTS'
5878 double precision gx(3),gx1(3)
5883 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5884 C Calculate the multi-body contribution to energy.
5885 C Calculate multi-body contributions to the gradient.
5886 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5887 cd & k,l,(gacont(m,kk,k),m=1,3)
5889 gx(m) =ekl*gacont(m,jj,i)
5890 gx1(m)=eij*gacont(m,kk,k)
5891 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5892 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5893 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5894 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5898 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5903 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5909 c------------------------------------------------------------------------------
5910 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5911 C This subroutine calculates multi-body contributions to hydrogen-bonding
5912 implicit real*8 (a-h,o-z)
5913 include 'DIMENSIONS'
5914 include 'COMMON.IOUNITS'
5917 parameter (max_cont=maxconts)
5918 parameter (max_dim=26)
5919 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5920 double precision zapas(max_dim,maxconts,max_fg_procs),
5921 & zapas_recv(max_dim,maxconts,max_fg_procs)
5922 common /przechowalnia/ zapas
5923 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5924 & status_array(MPI_STATUS_SIZE,maxconts*2)
5926 include 'COMMON.SETUP'
5927 include 'COMMON.FFIELD'
5928 include 'COMMON.DERIV'
5929 include 'COMMON.INTERACT'
5930 include 'COMMON.CONTACTS'
5931 include 'COMMON.CONTROL'
5932 include 'COMMON.LOCAL'
5933 double precision gx(3),gx1(3),time00
5936 C Set lprn=.true. for debugging
5941 if (nfgtasks.le.1) goto 30
5943 write (iout,'(a)') 'Contact function values before RECEIVE:'
5945 write (iout,'(2i3,50(1x,i2,f5.2))')
5946 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5947 & j=1,num_cont_hb(i))
5951 do i=1,ntask_cont_from
5954 do i=1,ntask_cont_to
5957 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5959 C Make the list of contacts to send to send to other procesors
5960 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5962 do i=iturn3_start,iturn3_end
5963 c write (iout,*) "make contact list turn3",i," num_cont",
5965 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5967 do i=iturn4_start,iturn4_end
5968 c write (iout,*) "make contact list turn4",i," num_cont",
5970 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5974 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5976 do j=1,num_cont_hb(i)
5979 iproc=iint_sent_local(k,jjc,ii)
5980 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5981 if (iproc.gt.0) then
5982 ncont_sent(iproc)=ncont_sent(iproc)+1
5983 nn=ncont_sent(iproc)
5985 zapas(2,nn,iproc)=jjc
5986 zapas(3,nn,iproc)=facont_hb(j,i)
5987 zapas(4,nn,iproc)=ees0p(j,i)
5988 zapas(5,nn,iproc)=ees0m(j,i)
5989 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5990 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5991 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5992 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5993 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5994 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5995 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5996 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5997 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5998 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5999 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6000 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6001 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6002 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6003 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6004 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6005 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6006 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6007 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6008 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6009 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6016 & "Numbers of contacts to be sent to other processors",
6017 & (ncont_sent(i),i=1,ntask_cont_to)
6018 write (iout,*) "Contacts sent"
6019 do ii=1,ntask_cont_to
6021 iproc=itask_cont_to(ii)
6022 write (iout,*) nn," contacts to processor",iproc,
6023 & " of CONT_TO_COMM group"
6025 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6033 CorrelID1=nfgtasks+fg_rank+1
6035 C Receive the numbers of needed contacts from other processors
6036 do ii=1,ntask_cont_from
6037 iproc=itask_cont_from(ii)
6039 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6040 & FG_COMM,req(ireq),IERR)
6042 c write (iout,*) "IRECV ended"
6044 C Send the number of contacts needed by other processors
6045 do ii=1,ntask_cont_to
6046 iproc=itask_cont_to(ii)
6048 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6049 & FG_COMM,req(ireq),IERR)
6051 c write (iout,*) "ISEND ended"
6052 c write (iout,*) "number of requests (nn)",ireq
6055 & call MPI_Waitall(ireq,req,status_array,ierr)
6057 c & "Numbers of contacts to be received from other processors",
6058 c & (ncont_recv(i),i=1,ntask_cont_from)
6062 do ii=1,ntask_cont_from
6063 iproc=itask_cont_from(ii)
6065 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6066 c & " of CONT_TO_COMM group"
6070 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6071 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6072 c write (iout,*) "ireq,req",ireq,req(ireq)
6075 C Send the contacts to processors that need them
6076 do ii=1,ntask_cont_to
6077 iproc=itask_cont_to(ii)
6079 c write (iout,*) nn," contacts to processor",iproc,
6080 c & " of CONT_TO_COMM group"
6083 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6084 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6085 c write (iout,*) "ireq,req",ireq,req(ireq)
6087 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6091 c write (iout,*) "number of requests (contacts)",ireq
6092 c write (iout,*) "req",(req(i),i=1,4)
6095 & call MPI_Waitall(ireq,req,status_array,ierr)
6096 do iii=1,ntask_cont_from
6097 iproc=itask_cont_from(iii)
6100 write (iout,*) "Received",nn," contacts from processor",iproc,
6101 & " of CONT_FROM_COMM group"
6104 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6109 ii=zapas_recv(1,i,iii)
6110 c Flag the received contacts to prevent double-counting
6111 jj=-zapas_recv(2,i,iii)
6112 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6114 nnn=num_cont_hb(ii)+1
6117 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6118 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6119 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6120 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6121 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6122 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6123 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6124 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6125 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6126 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6127 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6128 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6129 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6130 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6131 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6132 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6133 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6134 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6135 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6136 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6137 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6138 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6139 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6140 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6145 write (iout,'(a)') 'Contact function values after receive:'
6147 write (iout,'(2i3,50(1x,i3,f5.2))')
6148 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6149 & j=1,num_cont_hb(i))
6156 write (iout,'(a)') 'Contact function values:'
6158 write (iout,'(2i3,50(1x,i3,f5.2))')
6159 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6160 & j=1,num_cont_hb(i))
6164 C Remove the loop below after debugging !!!
6171 C Calculate the local-electrostatic correlation terms
6172 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6174 num_conti=num_cont_hb(i)
6175 num_conti1=num_cont_hb(i+1)
6182 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6183 c & ' jj=',jj,' kk=',kk
6184 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6185 & .or. j.lt.0 .and. j1.gt.0) .and.
6186 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6187 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6188 C The system gains extra energy.
6189 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6190 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6191 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6193 else if (j1.eq.j) then
6194 C Contacts I-J and I-(J+1) occur simultaneously.
6195 C The system loses extra energy.
6196 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6201 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6202 c & ' jj=',jj,' kk=',kk
6204 C Contacts I-J and (I+1)-J occur simultaneously.
6205 C The system loses extra energy.
6206 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6213 c------------------------------------------------------------------------------
6214 subroutine add_hb_contact(ii,jj,itask)
6215 implicit real*8 (a-h,o-z)
6216 include "DIMENSIONS"
6217 include "COMMON.IOUNITS"
6220 parameter (max_cont=maxconts)
6221 parameter (max_dim=26)
6222 include "COMMON.CONTACTS"
6223 double precision zapas(max_dim,maxconts,max_fg_procs),
6224 & zapas_recv(max_dim,maxconts,max_fg_procs)
6225 common /przechowalnia/ zapas
6226 integer i,j,ii,jj,iproc,itask(4),nn
6227 c write (iout,*) "itask",itask
6230 if (iproc.gt.0) then
6231 do j=1,num_cont_hb(ii)
6233 c write (iout,*) "i",ii," j",jj," jjc",jjc
6235 ncont_sent(iproc)=ncont_sent(iproc)+1
6236 nn=ncont_sent(iproc)
6237 zapas(1,nn,iproc)=ii
6238 zapas(2,nn,iproc)=jjc
6239 zapas(3,nn,iproc)=facont_hb(j,ii)
6240 zapas(4,nn,iproc)=ees0p(j,ii)
6241 zapas(5,nn,iproc)=ees0m(j,ii)
6242 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6243 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6244 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6245 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6246 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6247 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6248 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6249 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6250 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6251 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6252 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6253 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6254 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6255 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6256 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6257 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6258 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6259 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6260 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6261 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6262 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6270 c------------------------------------------------------------------------------
6271 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6273 C This subroutine calculates multi-body contributions to hydrogen-bonding
6274 implicit real*8 (a-h,o-z)
6275 include 'DIMENSIONS'
6276 include 'COMMON.IOUNITS'
6279 parameter (max_cont=maxconts)
6280 parameter (max_dim=70)
6281 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6282 double precision zapas(max_dim,maxconts,max_fg_procs),
6283 & zapas_recv(max_dim,maxconts,max_fg_procs)
6284 common /przechowalnia/ zapas
6285 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6286 & status_array(MPI_STATUS_SIZE,maxconts*2)
6288 include 'COMMON.SETUP'
6289 include 'COMMON.FFIELD'
6290 include 'COMMON.DERIV'
6291 include 'COMMON.LOCAL'
6292 include 'COMMON.INTERACT'
6293 include 'COMMON.CONTACTS'
6294 include 'COMMON.CHAIN'
6295 include 'COMMON.CONTROL'
6296 double precision gx(3),gx1(3)
6297 integer num_cont_hb_old(maxres)
6299 double precision eello4,eello5,eelo6,eello_turn6
6300 external eello4,eello5,eello6,eello_turn6
6301 C Set lprn=.true. for debugging
6306 num_cont_hb_old(i)=num_cont_hb(i)
6310 if (nfgtasks.le.1) goto 30
6312 write (iout,'(a)') 'Contact function values before RECEIVE:'
6314 write (iout,'(2i3,50(1x,i2,f5.2))')
6315 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6316 & j=1,num_cont_hb(i))
6320 do i=1,ntask_cont_from
6323 do i=1,ntask_cont_to
6326 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6328 C Make the list of contacts to send to send to other procesors
6329 do i=iturn3_start,iturn3_end
6330 c write (iout,*) "make contact list turn3",i," num_cont",
6332 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6334 do i=iturn4_start,iturn4_end
6335 c write (iout,*) "make contact list turn4",i," num_cont",
6337 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6341 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6343 do j=1,num_cont_hb(i)
6346 iproc=iint_sent_local(k,jjc,ii)
6347 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6348 if (iproc.ne.0) then
6349 ncont_sent(iproc)=ncont_sent(iproc)+1
6350 nn=ncont_sent(iproc)
6352 zapas(2,nn,iproc)=jjc
6353 zapas(3,nn,iproc)=d_cont(j,i)
6357 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6362 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6370 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6381 & "Numbers of contacts to be sent to other processors",
6382 & (ncont_sent(i),i=1,ntask_cont_to)
6383 write (iout,*) "Contacts sent"
6384 do ii=1,ntask_cont_to
6386 iproc=itask_cont_to(ii)
6387 write (iout,*) nn," contacts to processor",iproc,
6388 & " of CONT_TO_COMM group"
6390 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6398 CorrelID1=nfgtasks+fg_rank+1
6400 C Receive the numbers of needed contacts from other processors
6401 do ii=1,ntask_cont_from
6402 iproc=itask_cont_from(ii)
6404 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6405 & FG_COMM,req(ireq),IERR)
6407 c write (iout,*) "IRECV ended"
6409 C Send the number of contacts needed by other processors
6410 do ii=1,ntask_cont_to
6411 iproc=itask_cont_to(ii)
6413 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6414 & FG_COMM,req(ireq),IERR)
6416 c write (iout,*) "ISEND ended"
6417 c write (iout,*) "number of requests (nn)",ireq
6420 & call MPI_Waitall(ireq,req,status_array,ierr)
6422 c & "Numbers of contacts to be received from other processors",
6423 c & (ncont_recv(i),i=1,ntask_cont_from)
6427 do ii=1,ntask_cont_from
6428 iproc=itask_cont_from(ii)
6430 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6431 c & " of CONT_TO_COMM group"
6435 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6436 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6437 c write (iout,*) "ireq,req",ireq,req(ireq)
6440 C Send the contacts to processors that need them
6441 do ii=1,ntask_cont_to
6442 iproc=itask_cont_to(ii)
6444 c write (iout,*) nn," contacts to processor",iproc,
6445 c & " of CONT_TO_COMM group"
6448 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6449 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6450 c write (iout,*) "ireq,req",ireq,req(ireq)
6452 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6456 c write (iout,*) "number of requests (contacts)",ireq
6457 c write (iout,*) "req",(req(i),i=1,4)
6460 & call MPI_Waitall(ireq,req,status_array,ierr)
6461 do iii=1,ntask_cont_from
6462 iproc=itask_cont_from(iii)
6465 write (iout,*) "Received",nn," contacts from processor",iproc,
6466 & " of CONT_FROM_COMM group"
6469 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6474 ii=zapas_recv(1,i,iii)
6475 c Flag the received contacts to prevent double-counting
6476 jj=-zapas_recv(2,i,iii)
6477 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6479 nnn=num_cont_hb(ii)+1
6482 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6486 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6491 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6499 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6508 write (iout,'(a)') 'Contact function values after receive:'
6510 write (iout,'(2i3,50(1x,i3,5f6.3))')
6511 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6512 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6519 write (iout,'(a)') 'Contact function values:'
6521 write (iout,'(2i3,50(1x,i2,5f6.3))')
6522 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6523 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6529 C Remove the loop below after debugging !!!
6536 C Calculate the dipole-dipole interaction energies
6537 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6538 do i=iatel_s,iatel_e+1
6539 num_conti=num_cont_hb(i)
6548 C Calculate the local-electrostatic correlation terms
6549 c write (iout,*) "gradcorr5 in eello5 before loop"
6551 c write (iout,'(i5,3f10.5)')
6552 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6554 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6555 c write (iout,*) "corr loop i",i
6557 num_conti=num_cont_hb(i)
6558 num_conti1=num_cont_hb(i+1)
6565 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6566 c & ' jj=',jj,' kk=',kk
6567 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6568 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6569 & .or. j.lt.0 .and. j1.gt.0) .and.
6570 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6571 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6572 C The system gains extra energy.
6574 sqd1=dsqrt(d_cont(jj,i))
6575 sqd2=dsqrt(d_cont(kk,i1))
6576 sred_geom = sqd1*sqd2
6577 IF (sred_geom.lt.cutoff_corr) THEN
6578 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6580 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6581 cd & ' jj=',jj,' kk=',kk
6582 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6583 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6585 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6586 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6589 cd write (iout,*) 'sred_geom=',sred_geom,
6590 cd & ' ekont=',ekont,' fprim=',fprimcont,
6591 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6592 cd write (iout,*) "g_contij",g_contij
6593 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6594 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6595 call calc_eello(i,jp,i+1,jp1,jj,kk)
6596 if (wcorr4.gt.0.0d0)
6597 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6598 if (energy_dec.and.wcorr4.gt.0.0d0)
6599 1 write (iout,'(a6,4i5,0pf7.3)')
6600 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6601 c write (iout,*) "gradcorr5 before eello5"
6603 c write (iout,'(i5,3f10.5)')
6604 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6606 if (wcorr5.gt.0.0d0)
6607 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6608 c write (iout,*) "gradcorr5 after eello5"
6610 c write (iout,'(i5,3f10.5)')
6611 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6613 if (energy_dec.and.wcorr5.gt.0.0d0)
6614 1 write (iout,'(a6,4i5,0pf7.3)')
6615 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6616 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6617 cd write(2,*)'ijkl',i,jp,i+1,jp1
6618 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6619 & .or. wturn6.eq.0.0d0))then
6620 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6621 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6622 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6623 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6624 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6625 cd & 'ecorr6=',ecorr6
6626 cd write (iout,'(4e15.5)') sred_geom,
6627 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6628 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6629 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6630 else if (wturn6.gt.0.0d0
6631 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6632 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6633 eturn6=eturn6+eello_turn6(i,jj,kk)
6634 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6635 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6636 cd write (2,*) 'multibody_eello:eturn6',eturn6
6645 num_cont_hb(i)=num_cont_hb_old(i)
6647 c write (iout,*) "gradcorr5 in eello5"
6649 c write (iout,'(i5,3f10.5)')
6650 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6654 c------------------------------------------------------------------------------
6655 subroutine add_hb_contact_eello(ii,jj,itask)
6656 implicit real*8 (a-h,o-z)
6657 include "DIMENSIONS"
6658 include "COMMON.IOUNITS"
6661 parameter (max_cont=maxconts)
6662 parameter (max_dim=70)
6663 include "COMMON.CONTACTS"
6664 double precision zapas(max_dim,maxconts,max_fg_procs),
6665 & zapas_recv(max_dim,maxconts,max_fg_procs)
6666 common /przechowalnia/ zapas
6667 integer i,j,ii,jj,iproc,itask(4),nn
6668 c write (iout,*) "itask",itask
6671 if (iproc.gt.0) then
6672 do j=1,num_cont_hb(ii)
6674 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6676 ncont_sent(iproc)=ncont_sent(iproc)+1
6677 nn=ncont_sent(iproc)
6678 zapas(1,nn,iproc)=ii
6679 zapas(2,nn,iproc)=jjc
6680 zapas(3,nn,iproc)=d_cont(j,ii)
6684 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6689 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6697 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6709 c------------------------------------------------------------------------------
6710 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6711 implicit real*8 (a-h,o-z)
6712 include 'DIMENSIONS'
6713 include 'COMMON.IOUNITS'
6714 include 'COMMON.DERIV'
6715 include 'COMMON.INTERACT'
6716 include 'COMMON.CONTACTS'
6717 double precision gx(3),gx1(3)
6727 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6728 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6729 C Following 4 lines for diagnostics.
6734 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6735 c & 'Contacts ',i,j,
6736 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6737 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6739 C Calculate the multi-body contribution to energy.
6740 c ecorr=ecorr+ekont*ees
6741 C Calculate multi-body contributions to the gradient.
6742 coeffpees0pij=coeffp*ees0pij
6743 coeffmees0mij=coeffm*ees0mij
6744 coeffpees0pkl=coeffp*ees0pkl
6745 coeffmees0mkl=coeffm*ees0mkl
6747 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6748 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6749 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6750 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6751 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6752 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6753 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6754 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6755 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6756 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6757 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6758 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6759 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6760 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6761 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6762 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6763 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6764 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6765 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6766 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6767 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6768 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6769 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6770 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6771 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6776 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6777 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6778 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6779 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6784 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6785 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6786 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6787 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6790 c write (iout,*) "ehbcorr",ekont*ees
6795 C---------------------------------------------------------------------------
6796 subroutine dipole(i,j,jj)
6797 implicit real*8 (a-h,o-z)
6798 include 'DIMENSIONS'
6799 include 'COMMON.IOUNITS'
6800 include 'COMMON.CHAIN'
6801 include 'COMMON.FFIELD'
6802 include 'COMMON.DERIV'
6803 include 'COMMON.INTERACT'
6804 include 'COMMON.CONTACTS'
6805 include 'COMMON.TORSION'
6806 include 'COMMON.VAR'
6807 include 'COMMON.GEO'
6808 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6810 iti1 = itortyp(itype(i+1))
6811 if (j.lt.nres-1) then
6812 itj1 = itortyp(itype(j+1))
6817 dipi(iii,1)=Ub2(iii,i)
6818 dipderi(iii)=Ub2der(iii,i)
6819 dipi(iii,2)=b1(iii,iti1)
6820 dipj(iii,1)=Ub2(iii,j)
6821 dipderj(iii)=Ub2der(iii,j)
6822 dipj(iii,2)=b1(iii,itj1)
6826 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6829 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6836 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6840 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6845 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6846 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6848 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6850 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6852 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6857 C---------------------------------------------------------------------------
6858 subroutine calc_eello(i,j,k,l,jj,kk)
6860 C This subroutine computes matrices and vectors needed to calculate
6861 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6863 implicit real*8 (a-h,o-z)
6864 include 'DIMENSIONS'
6865 include 'COMMON.IOUNITS'
6866 include 'COMMON.CHAIN'
6867 include 'COMMON.DERIV'
6868 include 'COMMON.INTERACT'
6869 include 'COMMON.CONTACTS'
6870 include 'COMMON.TORSION'
6871 include 'COMMON.VAR'
6872 include 'COMMON.GEO'
6873 include 'COMMON.FFIELD'
6874 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6875 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6878 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6879 cd & ' jj=',jj,' kk=',kk
6880 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6881 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6882 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6885 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6886 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6889 call transpose2(aa1(1,1),aa1t(1,1))
6890 call transpose2(aa2(1,1),aa2t(1,1))
6893 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6894 & aa1tder(1,1,lll,kkk))
6895 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6896 & aa2tder(1,1,lll,kkk))
6900 C parallel orientation of the two CA-CA-CA frames.
6902 iti=itortyp(itype(i))
6906 itk1=itortyp(itype(k+1))
6907 itj=itortyp(itype(j))
6908 if (l.lt.nres-1) then
6909 itl1=itortyp(itype(l+1))
6913 C A1 kernel(j+1) A2T
6915 cd write (iout,'(3f10.5,5x,3f10.5)')
6916 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6918 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6919 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6920 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6921 C Following matrices are needed only for 6-th order cumulants
6922 IF (wcorr6.gt.0.0d0) THEN
6923 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6924 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6925 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6926 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6927 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6928 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6929 & ADtEAderx(1,1,1,1,1,1))
6931 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6932 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6933 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6934 & ADtEA1derx(1,1,1,1,1,1))
6936 C End 6-th order cumulants
6939 cd write (2,*) 'In calc_eello6'
6941 cd write (2,*) 'iii=',iii
6943 cd write (2,*) 'kkk=',kkk
6945 cd write (2,'(3(2f10.5),5x)')
6946 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6951 call transpose2(EUgder(1,1,k),auxmat(1,1))
6952 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6953 call transpose2(EUg(1,1,k),auxmat(1,1))
6954 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6955 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6959 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6960 & EAEAderx(1,1,lll,kkk,iii,1))
6964 C A1T kernel(i+1) A2
6965 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6966 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6967 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6968 C Following matrices are needed only for 6-th order cumulants
6969 IF (wcorr6.gt.0.0d0) THEN
6970 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6971 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6972 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6973 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6974 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6975 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6976 & ADtEAderx(1,1,1,1,1,2))
6977 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6978 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6979 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6980 & ADtEA1derx(1,1,1,1,1,2))
6982 C End 6-th order cumulants
6983 call transpose2(EUgder(1,1,l),auxmat(1,1))
6984 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6985 call transpose2(EUg(1,1,l),auxmat(1,1))
6986 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6987 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6991 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6992 & EAEAderx(1,1,lll,kkk,iii,2))
6997 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6998 C They are needed only when the fifth- or the sixth-order cumulants are
7000 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7001 call transpose2(AEA(1,1,1),auxmat(1,1))
7002 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7003 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7004 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7005 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7006 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7007 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7008 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7009 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7010 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7011 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7012 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7013 call transpose2(AEA(1,1,2),auxmat(1,1))
7014 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7015 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7016 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7017 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7018 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7019 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7020 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7021 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7022 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7023 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7024 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7025 C Calculate the Cartesian derivatives of the vectors.
7029 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7030 call matvec2(auxmat(1,1),b1(1,iti),
7031 & AEAb1derx(1,lll,kkk,iii,1,1))
7032 call matvec2(auxmat(1,1),Ub2(1,i),
7033 & AEAb2derx(1,lll,kkk,iii,1,1))
7034 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7035 & AEAb1derx(1,lll,kkk,iii,2,1))
7036 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7037 & AEAb2derx(1,lll,kkk,iii,2,1))
7038 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7039 call matvec2(auxmat(1,1),b1(1,itj),
7040 & AEAb1derx(1,lll,kkk,iii,1,2))
7041 call matvec2(auxmat(1,1),Ub2(1,j),
7042 & AEAb2derx(1,lll,kkk,iii,1,2))
7043 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7044 & AEAb1derx(1,lll,kkk,iii,2,2))
7045 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7046 & AEAb2derx(1,lll,kkk,iii,2,2))
7053 C Antiparallel orientation of the two CA-CA-CA frames.
7055 iti=itortyp(itype(i))
7059 itk1=itortyp(itype(k+1))
7060 itl=itortyp(itype(l))
7061 itj=itortyp(itype(j))
7062 if (j.lt.nres-1) then
7063 itj1=itortyp(itype(j+1))
7067 C A2 kernel(j-1)T A1T
7068 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7069 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7070 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7071 C Following matrices are needed only for 6-th order cumulants
7072 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7073 & j.eq.i+4 .and. l.eq.i+3)) THEN
7074 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7075 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7076 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7077 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7078 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7079 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7080 & ADtEAderx(1,1,1,1,1,1))
7081 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7082 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7083 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7084 & ADtEA1derx(1,1,1,1,1,1))
7086 C End 6-th order cumulants
7087 call transpose2(EUgder(1,1,k),auxmat(1,1))
7088 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7089 call transpose2(EUg(1,1,k),auxmat(1,1))
7090 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7091 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7095 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7096 & EAEAderx(1,1,lll,kkk,iii,1))
7100 C A2T kernel(i+1)T A1
7101 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7102 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7103 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7104 C Following matrices are needed only for 6-th order cumulants
7105 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7106 & j.eq.i+4 .and. l.eq.i+3)) THEN
7107 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7108 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7109 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7110 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7111 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7112 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7113 & ADtEAderx(1,1,1,1,1,2))
7114 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7115 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7116 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7117 & ADtEA1derx(1,1,1,1,1,2))
7119 C End 6-th order cumulants
7120 call transpose2(EUgder(1,1,j),auxmat(1,1))
7121 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7122 call transpose2(EUg(1,1,j),auxmat(1,1))
7123 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7124 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7128 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7129 & EAEAderx(1,1,lll,kkk,iii,2))
7134 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7135 C They are needed only when the fifth- or the sixth-order cumulants are
7137 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7138 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7139 call transpose2(AEA(1,1,1),auxmat(1,1))
7140 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7141 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7142 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7143 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7144 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7145 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7146 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7147 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7148 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7149 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7150 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7151 call transpose2(AEA(1,1,2),auxmat(1,1))
7152 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7153 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7154 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7155 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7156 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7157 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7158 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7159 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7160 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7161 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7162 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7163 C Calculate the Cartesian derivatives of the vectors.
7167 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7168 call matvec2(auxmat(1,1),b1(1,iti),
7169 & AEAb1derx(1,lll,kkk,iii,1,1))
7170 call matvec2(auxmat(1,1),Ub2(1,i),
7171 & AEAb2derx(1,lll,kkk,iii,1,1))
7172 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7173 & AEAb1derx(1,lll,kkk,iii,2,1))
7174 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7175 & AEAb2derx(1,lll,kkk,iii,2,1))
7176 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7177 call matvec2(auxmat(1,1),b1(1,itl),
7178 & AEAb1derx(1,lll,kkk,iii,1,2))
7179 call matvec2(auxmat(1,1),Ub2(1,l),
7180 & AEAb2derx(1,lll,kkk,iii,1,2))
7181 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7182 & AEAb1derx(1,lll,kkk,iii,2,2))
7183 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7184 & AEAb2derx(1,lll,kkk,iii,2,2))
7193 C---------------------------------------------------------------------------
7194 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7195 & KK,KKderg,AKA,AKAderg,AKAderx)
7199 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7200 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7201 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7206 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7208 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7211 cd if (lprn) write (2,*) 'In kernel'
7213 cd if (lprn) write (2,*) 'kkk=',kkk
7215 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7216 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7218 cd write (2,*) 'lll=',lll
7219 cd write (2,*) 'iii=1'
7221 cd write (2,'(3(2f10.5),5x)')
7222 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7225 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7226 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7228 cd write (2,*) 'lll=',lll
7229 cd write (2,*) 'iii=2'
7231 cd write (2,'(3(2f10.5),5x)')
7232 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7239 C---------------------------------------------------------------------------
7240 double precision function eello4(i,j,k,l,jj,kk)
7241 implicit real*8 (a-h,o-z)
7242 include 'DIMENSIONS'
7243 include 'COMMON.IOUNITS'
7244 include 'COMMON.CHAIN'
7245 include 'COMMON.DERIV'
7246 include 'COMMON.INTERACT'
7247 include 'COMMON.CONTACTS'
7248 include 'COMMON.TORSION'
7249 include 'COMMON.VAR'
7250 include 'COMMON.GEO'
7251 double precision pizda(2,2),ggg1(3),ggg2(3)
7252 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7256 cd print *,'eello4:',i,j,k,l,jj,kk
7257 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7258 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7259 cold eij=facont_hb(jj,i)
7260 cold ekl=facont_hb(kk,k)
7262 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7263 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7264 gcorr_loc(k-1)=gcorr_loc(k-1)
7265 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7267 gcorr_loc(l-1)=gcorr_loc(l-1)
7268 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7270 gcorr_loc(j-1)=gcorr_loc(j-1)
7271 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7276 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7277 & -EAEAderx(2,2,lll,kkk,iii,1)
7278 cd derx(lll,kkk,iii)=0.0d0
7282 cd gcorr_loc(l-1)=0.0d0
7283 cd gcorr_loc(j-1)=0.0d0
7284 cd gcorr_loc(k-1)=0.0d0
7286 cd write (iout,*)'Contacts have occurred for peptide groups',
7287 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7288 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7289 if (j.lt.nres-1) then
7296 if (l.lt.nres-1) then
7304 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7305 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7306 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7307 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7308 cgrad ghalf=0.5d0*ggg1(ll)
7309 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7310 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7311 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7312 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7313 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7314 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7315 cgrad ghalf=0.5d0*ggg2(ll)
7316 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7317 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7318 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7319 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7320 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7321 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7325 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7330 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7335 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7340 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7344 cd write (2,*) iii,gcorr_loc(iii)
7347 cd write (2,*) 'ekont',ekont
7348 cd write (iout,*) 'eello4',ekont*eel4
7351 C---------------------------------------------------------------------------
7352 double precision function eello5(i,j,k,l,jj,kk)
7353 implicit real*8 (a-h,o-z)
7354 include 'DIMENSIONS'
7355 include 'COMMON.IOUNITS'
7356 include 'COMMON.CHAIN'
7357 include 'COMMON.DERIV'
7358 include 'COMMON.INTERACT'
7359 include 'COMMON.CONTACTS'
7360 include 'COMMON.TORSION'
7361 include 'COMMON.VAR'
7362 include 'COMMON.GEO'
7363 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7364 double precision ggg1(3),ggg2(3)
7365 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7370 C /l\ / \ \ / \ / \ / C
7371 C / \ / \ \ / \ / \ / C
7372 C j| o |l1 | o | o| o | | o |o C
7373 C \ |/k\| |/ \| / |/ \| |/ \| C
7374 C \i/ \ / \ / / \ / \ C
7376 C (I) (II) (III) (IV) C
7378 C eello5_1 eello5_2 eello5_3 eello5_4 C
7380 C Antiparallel chains C
7383 C /j\ / \ \ / \ / \ / C
7384 C / \ / \ \ / \ / \ / C
7385 C j1| o |l | o | o| o | | o |o C
7386 C \ |/k\| |/ \| / |/ \| |/ \| C
7387 C \i/ \ / \ / / \ / \ C
7389 C (I) (II) (III) (IV) C
7391 C eello5_1 eello5_2 eello5_3 eello5_4 C
7393 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7396 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7401 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7403 itk=itortyp(itype(k))
7404 itl=itortyp(itype(l))
7405 itj=itortyp(itype(j))
7410 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7411 cd & eel5_3_num,eel5_4_num)
7415 derx(lll,kkk,iii)=0.0d0
7419 cd eij=facont_hb(jj,i)
7420 cd ekl=facont_hb(kk,k)
7422 cd write (iout,*)'Contacts have occurred for peptide groups',
7423 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7425 C Contribution from the graph I.
7426 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7427 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7428 call transpose2(EUg(1,1,k),auxmat(1,1))
7429 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7430 vv(1)=pizda(1,1)-pizda(2,2)
7431 vv(2)=pizda(1,2)+pizda(2,1)
7432 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7433 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7434 C Explicit gradient in virtual-dihedral angles.
7435 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7436 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7437 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7438 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7439 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7440 vv(1)=pizda(1,1)-pizda(2,2)
7441 vv(2)=pizda(1,2)+pizda(2,1)
7442 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7443 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7444 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7445 call matmat2(AEAderg(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)
7449 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7450 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7451 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7453 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7454 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7455 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7457 C Cartesian gradient
7461 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7463 vv(1)=pizda(1,1)-pizda(2,2)
7464 vv(2)=pizda(1,2)+pizda(2,1)
7465 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7466 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7467 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7473 C Contribution from graph II
7474 call transpose2(EE(1,1,itk),auxmat(1,1))
7475 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7476 vv(1)=pizda(1,1)+pizda(2,2)
7477 vv(2)=pizda(2,1)-pizda(1,2)
7478 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7479 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7480 C Explicit gradient in virtual-dihedral angles.
7481 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7482 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7483 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7484 vv(1)=pizda(1,1)+pizda(2,2)
7485 vv(2)=pizda(2,1)-pizda(1,2)
7487 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7488 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7489 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7491 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7492 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7493 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7495 C Cartesian gradient
7499 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7501 vv(1)=pizda(1,1)+pizda(2,2)
7502 vv(2)=pizda(2,1)-pizda(1,2)
7503 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7504 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7505 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7513 C Parallel orientation
7514 C Contribution from graph III
7515 call transpose2(EUg(1,1,l),auxmat(1,1))
7516 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7517 vv(1)=pizda(1,1)-pizda(2,2)
7518 vv(2)=pizda(1,2)+pizda(2,1)
7519 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7520 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7521 C Explicit gradient in virtual-dihedral angles.
7522 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7523 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7524 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7525 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7526 vv(1)=pizda(1,1)-pizda(2,2)
7527 vv(2)=pizda(1,2)+pizda(2,1)
7528 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7529 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7530 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7531 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7532 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7533 vv(1)=pizda(1,1)-pizda(2,2)
7534 vv(2)=pizda(1,2)+pizda(2,1)
7535 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7536 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7537 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7538 C Cartesian gradient
7542 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7544 vv(1)=pizda(1,1)-pizda(2,2)
7545 vv(2)=pizda(1,2)+pizda(2,1)
7546 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7547 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7548 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7553 C Contribution from graph IV
7555 call transpose2(EE(1,1,itl),auxmat(1,1))
7556 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7557 vv(1)=pizda(1,1)+pizda(2,2)
7558 vv(2)=pizda(2,1)-pizda(1,2)
7559 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7560 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7561 C Explicit gradient in virtual-dihedral angles.
7562 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7563 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7564 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7565 vv(1)=pizda(1,1)+pizda(2,2)
7566 vv(2)=pizda(2,1)-pizda(1,2)
7567 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7568 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7569 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7570 C Cartesian gradient
7574 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7576 vv(1)=pizda(1,1)+pizda(2,2)
7577 vv(2)=pizda(2,1)-pizda(1,2)
7578 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7579 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7580 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7585 C Antiparallel orientation
7586 C Contribution from graph III
7588 call transpose2(EUg(1,1,j),auxmat(1,1))
7589 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7590 vv(1)=pizda(1,1)-pizda(2,2)
7591 vv(2)=pizda(1,2)+pizda(2,1)
7592 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7593 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7594 C Explicit gradient in virtual-dihedral angles.
7595 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7596 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7597 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7598 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7599 vv(1)=pizda(1,1)-pizda(2,2)
7600 vv(2)=pizda(1,2)+pizda(2,1)
7601 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7602 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7603 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7604 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7605 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7606 vv(1)=pizda(1,1)-pizda(2,2)
7607 vv(2)=pizda(1,2)+pizda(2,1)
7608 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7609 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7610 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7611 C Cartesian gradient
7615 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7617 vv(1)=pizda(1,1)-pizda(2,2)
7618 vv(2)=pizda(1,2)+pizda(2,1)
7619 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7620 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7621 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7626 C Contribution from graph IV
7628 call transpose2(EE(1,1,itj),auxmat(1,1))
7629 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7630 vv(1)=pizda(1,1)+pizda(2,2)
7631 vv(2)=pizda(2,1)-pizda(1,2)
7632 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7633 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7634 C Explicit gradient in virtual-dihedral angles.
7635 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7636 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7637 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7638 vv(1)=pizda(1,1)+pizda(2,2)
7639 vv(2)=pizda(2,1)-pizda(1,2)
7640 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7641 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7642 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7643 C Cartesian gradient
7647 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7649 vv(1)=pizda(1,1)+pizda(2,2)
7650 vv(2)=pizda(2,1)-pizda(1,2)
7651 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7652 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7653 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7659 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7660 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7661 cd write (2,*) 'ijkl',i,j,k,l
7662 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7663 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7665 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7666 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7667 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7668 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7669 if (j.lt.nres-1) then
7676 if (l.lt.nres-1) then
7686 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7687 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7688 C summed up outside the subrouine as for the other subroutines
7689 C handling long-range interactions. The old code is commented out
7690 C with "cgrad" to keep track of changes.
7692 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7693 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7694 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7695 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7696 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7697 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7698 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7699 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7700 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7701 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7703 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7704 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7705 cgrad ghalf=0.5d0*ggg1(ll)
7707 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7708 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7709 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7710 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7711 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7712 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7713 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7714 cgrad ghalf=0.5d0*ggg2(ll)
7716 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7717 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7718 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7719 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7720 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7721 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7726 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7727 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7732 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7733 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7739 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7744 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7748 cd write (2,*) iii,g_corr5_loc(iii)
7751 cd write (2,*) 'ekont',ekont
7752 cd write (iout,*) 'eello5',ekont*eel5
7755 c--------------------------------------------------------------------------
7756 double precision function eello6(i,j,k,l,jj,kk)
7757 implicit real*8 (a-h,o-z)
7758 include 'DIMENSIONS'
7759 include 'COMMON.IOUNITS'
7760 include 'COMMON.CHAIN'
7761 include 'COMMON.DERIV'
7762 include 'COMMON.INTERACT'
7763 include 'COMMON.CONTACTS'
7764 include 'COMMON.TORSION'
7765 include 'COMMON.VAR'
7766 include 'COMMON.GEO'
7767 include 'COMMON.FFIELD'
7768 double precision ggg1(3),ggg2(3)
7769 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7774 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7782 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7783 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7787 derx(lll,kkk,iii)=0.0d0
7791 cd eij=facont_hb(jj,i)
7792 cd ekl=facont_hb(kk,k)
7798 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7799 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7800 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7801 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7802 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7803 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7805 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7806 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7807 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7808 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7809 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7810 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7814 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7816 C If turn contributions are considered, they will be handled separately.
7817 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7818 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7819 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7820 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7821 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7822 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7823 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7825 if (j.lt.nres-1) then
7832 if (l.lt.nres-1) then
7840 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7841 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7842 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7843 cgrad ghalf=0.5d0*ggg1(ll)
7845 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7846 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7847 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7848 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7849 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7850 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7851 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7852 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7853 cgrad ghalf=0.5d0*ggg2(ll)
7854 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7856 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7857 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7858 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7859 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7860 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7861 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7866 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7867 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7872 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7873 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7879 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7884 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7888 cd write (2,*) iii,g_corr6_loc(iii)
7891 cd write (2,*) 'ekont',ekont
7892 cd write (iout,*) 'eello6',ekont*eel6
7895 c--------------------------------------------------------------------------
7896 double precision function eello6_graph1(i,j,k,l,imat,swap)
7897 implicit real*8 (a-h,o-z)
7898 include 'DIMENSIONS'
7899 include 'COMMON.IOUNITS'
7900 include 'COMMON.CHAIN'
7901 include 'COMMON.DERIV'
7902 include 'COMMON.INTERACT'
7903 include 'COMMON.CONTACTS'
7904 include 'COMMON.TORSION'
7905 include 'COMMON.VAR'
7906 include 'COMMON.GEO'
7907 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7911 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7913 C Parallel Antiparallel C
7919 C \ j|/k\| / \ |/k\|l / C
7924 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7925 itk=itortyp(itype(k))
7926 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7927 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7928 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7929 call transpose2(EUgC(1,1,k),auxmat(1,1))
7930 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7931 vv1(1)=pizda1(1,1)-pizda1(2,2)
7932 vv1(2)=pizda1(1,2)+pizda1(2,1)
7933 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7934 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7935 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7936 s5=scalar2(vv(1),Dtobr2(1,i))
7937 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7938 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7939 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7940 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7941 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7942 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7943 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7944 & +scalar2(vv(1),Dtobr2der(1,i)))
7945 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7946 vv1(1)=pizda1(1,1)-pizda1(2,2)
7947 vv1(2)=pizda1(1,2)+pizda1(2,1)
7948 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7949 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7951 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7952 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7953 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7954 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7955 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7957 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7958 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7959 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7960 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7961 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7963 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7964 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7965 vv1(1)=pizda1(1,1)-pizda1(2,2)
7966 vv1(2)=pizda1(1,2)+pizda1(2,1)
7967 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7968 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7969 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7970 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7979 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7980 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7981 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7982 call transpose2(EUgC(1,1,k),auxmat(1,1))
7983 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7985 vv1(1)=pizda1(1,1)-pizda1(2,2)
7986 vv1(2)=pizda1(1,2)+pizda1(2,1)
7987 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7988 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7989 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7990 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7991 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7992 s5=scalar2(vv(1),Dtobr2(1,i))
7993 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7999 c----------------------------------------------------------------------------
8000 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8001 implicit real*8 (a-h,o-z)
8002 include 'DIMENSIONS'
8003 include 'COMMON.IOUNITS'
8004 include 'COMMON.CHAIN'
8005 include 'COMMON.DERIV'
8006 include 'COMMON.INTERACT'
8007 include 'COMMON.CONTACTS'
8008 include 'COMMON.TORSION'
8009 include 'COMMON.VAR'
8010 include 'COMMON.GEO'
8012 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8013 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8016 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8018 C Parallel Antiparallel C
8024 C \ j|/k\| \ |/k\|l C
8029 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8030 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8031 C AL 7/4/01 s1 would occur in the sixth-order moment,
8032 C but not in a cluster cumulant
8034 s1=dip(1,jj,i)*dip(1,kk,k)
8036 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8037 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8038 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8039 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8040 call transpose2(EUg(1,1,k),auxmat(1,1))
8041 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8042 vv(1)=pizda(1,1)-pizda(2,2)
8043 vv(2)=pizda(1,2)+pizda(2,1)
8044 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8045 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8047 eello6_graph2=-(s1+s2+s3+s4)
8049 eello6_graph2=-(s2+s3+s4)
8052 C Derivatives in gamma(i-1)
8055 s1=dipderg(1,jj,i)*dip(1,kk,k)
8057 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8058 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8059 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8060 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8062 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8064 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8066 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8068 C Derivatives in gamma(k-1)
8070 s1=dip(1,jj,i)*dipderg(1,kk,k)
8072 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8073 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8074 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8075 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8076 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8077 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8078 vv(1)=pizda(1,1)-pizda(2,2)
8079 vv(2)=pizda(1,2)+pizda(2,1)
8080 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8082 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8084 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8086 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8087 C Derivatives in gamma(j-1) or gamma(l-1)
8090 s1=dipderg(3,jj,i)*dip(1,kk,k)
8092 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8093 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8094 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8095 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8096 vv(1)=pizda(1,1)-pizda(2,2)
8097 vv(2)=pizda(1,2)+pizda(2,1)
8098 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8101 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8103 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8106 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8107 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8109 C Derivatives in gamma(l-1) or gamma(j-1)
8112 s1=dip(1,jj,i)*dipderg(3,kk,k)
8114 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8115 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8116 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8117 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8118 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8119 vv(1)=pizda(1,1)-pizda(2,2)
8120 vv(2)=pizda(1,2)+pizda(2,1)
8121 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8124 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8126 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8129 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8130 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8132 C Cartesian derivatives.
8134 write (2,*) 'In eello6_graph2'
8136 write (2,*) 'iii=',iii
8138 write (2,*) 'kkk=',kkk
8140 write (2,'(3(2f10.5),5x)')
8141 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8151 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8153 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8156 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8158 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8159 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8161 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8162 call transpose2(EUg(1,1,k),auxmat(1,1))
8163 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8165 vv(1)=pizda(1,1)-pizda(2,2)
8166 vv(2)=pizda(1,2)+pizda(2,1)
8167 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8168 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8170 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8172 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8175 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8177 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8184 c----------------------------------------------------------------------------
8185 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8186 implicit real*8 (a-h,o-z)
8187 include 'DIMENSIONS'
8188 include 'COMMON.IOUNITS'
8189 include 'COMMON.CHAIN'
8190 include 'COMMON.DERIV'
8191 include 'COMMON.INTERACT'
8192 include 'COMMON.CONTACTS'
8193 include 'COMMON.TORSION'
8194 include 'COMMON.VAR'
8195 include 'COMMON.GEO'
8196 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8198 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8200 C Parallel Antiparallel C
8206 C j|/k\| / |/k\|l / C
8211 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8213 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8214 C energy moment and not to the cluster cumulant.
8215 iti=itortyp(itype(i))
8216 if (j.lt.nres-1) then
8217 itj1=itortyp(itype(j+1))
8221 itk=itortyp(itype(k))
8222 itk1=itortyp(itype(k+1))
8223 if (l.lt.nres-1) then
8224 itl1=itortyp(itype(l+1))
8229 s1=dip(4,jj,i)*dip(4,kk,k)
8231 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8232 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8233 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8234 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8235 call transpose2(EE(1,1,itk),auxmat(1,1))
8236 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8237 vv(1)=pizda(1,1)+pizda(2,2)
8238 vv(2)=pizda(2,1)-pizda(1,2)
8239 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8240 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8241 cd & "sum",-(s2+s3+s4)
8243 eello6_graph3=-(s1+s2+s3+s4)
8245 eello6_graph3=-(s2+s3+s4)
8248 C Derivatives in gamma(k-1)
8249 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8250 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8251 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8252 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8253 C Derivatives in gamma(l-1)
8254 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8255 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8256 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8257 vv(1)=pizda(1,1)+pizda(2,2)
8258 vv(2)=pizda(2,1)-pizda(1,2)
8259 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8260 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8261 C Cartesian derivatives.
8267 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8269 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8272 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8274 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8275 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8277 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8278 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8280 vv(1)=pizda(1,1)+pizda(2,2)
8281 vv(2)=pizda(2,1)-pizda(1,2)
8282 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8284 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8286 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8289 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8291 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8293 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8299 c----------------------------------------------------------------------------
8300 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8301 implicit real*8 (a-h,o-z)
8302 include 'DIMENSIONS'
8303 include 'COMMON.IOUNITS'
8304 include 'COMMON.CHAIN'
8305 include 'COMMON.DERIV'
8306 include 'COMMON.INTERACT'
8307 include 'COMMON.CONTACTS'
8308 include 'COMMON.TORSION'
8309 include 'COMMON.VAR'
8310 include 'COMMON.GEO'
8311 include 'COMMON.FFIELD'
8312 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8313 & auxvec1(2),auxmat1(2,2)
8315 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8317 C Parallel Antiparallel C
8323 C \ j|/k\| \ |/k\|l C
8328 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8330 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8331 C energy moment and not to the cluster cumulant.
8332 cd write (2,*) 'eello_graph4: wturn6',wturn6
8333 iti=itortyp(itype(i))
8334 itj=itortyp(itype(j))
8335 if (j.lt.nres-1) then
8336 itj1=itortyp(itype(j+1))
8340 itk=itortyp(itype(k))
8341 if (k.lt.nres-1) then
8342 itk1=itortyp(itype(k+1))
8346 itl=itortyp(itype(l))
8347 if (l.lt.nres-1) then
8348 itl1=itortyp(itype(l+1))
8352 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8353 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8354 cd & ' itl',itl,' itl1',itl1
8357 s1=dip(3,jj,i)*dip(3,kk,k)
8359 s1=dip(2,jj,j)*dip(2,kk,l)
8362 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8363 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8365 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8366 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8368 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8369 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8371 call transpose2(EUg(1,1,k),auxmat(1,1))
8372 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8373 vv(1)=pizda(1,1)-pizda(2,2)
8374 vv(2)=pizda(2,1)+pizda(1,2)
8375 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8376 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8378 eello6_graph4=-(s1+s2+s3+s4)
8380 eello6_graph4=-(s2+s3+s4)
8382 C Derivatives in gamma(i-1)
8386 s1=dipderg(2,jj,i)*dip(3,kk,k)
8388 s1=dipderg(4,jj,j)*dip(2,kk,l)
8391 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8393 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8394 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8396 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8397 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8399 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8400 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8401 cd write (2,*) 'turn6 derivatives'
8403 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8405 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8409 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8411 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8415 C Derivatives in gamma(k-1)
8418 s1=dip(3,jj,i)*dipderg(2,kk,k)
8420 s1=dip(2,jj,j)*dipderg(4,kk,l)
8423 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8424 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8426 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8427 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8429 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8430 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8432 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8433 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8434 vv(1)=pizda(1,1)-pizda(2,2)
8435 vv(2)=pizda(2,1)+pizda(1,2)
8436 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8437 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8439 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8441 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8445 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8447 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8450 C Derivatives in gamma(j-1) or gamma(l-1)
8451 if (l.eq.j+1 .and. l.gt.1) then
8452 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8453 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8454 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)-pizda(2,2)
8456 vv(2)=pizda(2,1)+pizda(1,2)
8457 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8458 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8459 else if (j.gt.1) then
8460 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8461 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8462 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8463 vv(1)=pizda(1,1)-pizda(2,2)
8464 vv(2)=pizda(2,1)+pizda(1,2)
8465 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8466 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8467 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8469 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8472 C Cartesian derivatives.
8479 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8481 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8485 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8487 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8491 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8493 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8495 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8496 & b1(1,itj1),auxvec(1))
8497 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8499 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8500 & b1(1,itl1),auxvec(1))
8501 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8503 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8505 vv(1)=pizda(1,1)-pizda(2,2)
8506 vv(2)=pizda(2,1)+pizda(1,2)
8507 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8509 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8511 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8514 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8517 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8520 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8522 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8524 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8528 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8530 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8533 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8535 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8543 c----------------------------------------------------------------------------
8544 double precision function eello_turn6(i,jj,kk)
8545 implicit real*8 (a-h,o-z)
8546 include 'DIMENSIONS'
8547 include 'COMMON.IOUNITS'
8548 include 'COMMON.CHAIN'
8549 include 'COMMON.DERIV'
8550 include 'COMMON.INTERACT'
8551 include 'COMMON.CONTACTS'
8552 include 'COMMON.TORSION'
8553 include 'COMMON.VAR'
8554 include 'COMMON.GEO'
8555 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8556 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8558 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8559 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8560 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8561 C the respective energy moment and not to the cluster cumulant.
8570 iti=itortyp(itype(i))
8571 itk=itortyp(itype(k))
8572 itk1=itortyp(itype(k+1))
8573 itl=itortyp(itype(l))
8574 itj=itortyp(itype(j))
8575 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8576 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8577 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8582 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8584 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8588 derx_turn(lll,kkk,iii)=0.0d0
8595 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8597 cd write (2,*) 'eello6_5',eello6_5
8599 call transpose2(AEA(1,1,1),auxmat(1,1))
8600 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8601 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8602 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8604 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8605 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8606 s2 = scalar2(b1(1,itk),vtemp1(1))
8608 call transpose2(AEA(1,1,2),atemp(1,1))
8609 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8610 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8611 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8613 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8614 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8615 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8617 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8618 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8619 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8620 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8621 ss13 = scalar2(b1(1,itk),vtemp4(1))
8622 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8624 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8630 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8631 C Derivatives in gamma(i+2)
8635 call transpose2(AEA(1,1,1),auxmatd(1,1))
8636 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8637 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8638 call transpose2(AEAderg(1,1,2),atempd(1,1))
8639 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8640 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8642 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8643 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8644 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8650 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8651 C Derivatives in gamma(i+3)
8653 call transpose2(AEA(1,1,1),auxmatd(1,1))
8654 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8655 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8656 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8658 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8659 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8660 s2d = scalar2(b1(1,itk),vtemp1d(1))
8662 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8663 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8665 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8667 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8668 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8669 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8677 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8678 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8680 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8681 & -0.5d0*ekont*(s2d+s12d)
8683 C Derivatives in gamma(i+4)
8684 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8685 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8686 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8688 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8689 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8690 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8698 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8700 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8702 C Derivatives in gamma(i+5)
8704 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8705 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8706 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8708 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8709 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8710 s2d = scalar2(b1(1,itk),vtemp1d(1))
8712 call transpose2(AEA(1,1,2),atempd(1,1))
8713 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8714 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8716 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8717 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8719 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8720 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8721 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8729 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8730 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8732 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8733 & -0.5d0*ekont*(s2d+s12d)
8735 C Cartesian derivatives
8740 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8741 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8742 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8744 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8745 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8747 s2d = scalar2(b1(1,itk),vtemp1d(1))
8749 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8750 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8751 s8d = -(atempd(1,1)+atempd(2,2))*
8752 & scalar2(cc(1,1,itl),vtemp2(1))
8754 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8756 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8757 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8764 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8767 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8771 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8772 & - 0.5d0*(s8d+s12d)
8774 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8783 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8785 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8786 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8787 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8788 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8789 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8791 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8792 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8793 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8797 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8798 cd & 16*eel_turn6_num
8800 if (j.lt.nres-1) then
8807 if (l.lt.nres-1) then
8815 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8816 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8817 cgrad ghalf=0.5d0*ggg1(ll)
8819 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8820 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8821 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8822 & +ekont*derx_turn(ll,2,1)
8823 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8824 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8825 & +ekont*derx_turn(ll,4,1)
8826 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8827 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8828 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8829 cgrad ghalf=0.5d0*ggg2(ll)
8831 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8832 & +ekont*derx_turn(ll,2,2)
8833 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8834 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8835 & +ekont*derx_turn(ll,4,2)
8836 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8837 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8838 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8843 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8848 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8854 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8859 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8863 cd write (2,*) iii,g_corr6_loc(iii)
8865 eello_turn6=ekont*eel_turn6
8866 cd write (2,*) 'ekont',ekont
8867 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8871 C-----------------------------------------------------------------------------
8872 double precision function scalar(u,v)
8873 !DIR$ INLINEALWAYS scalar
8875 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8878 double precision u(3),v(3)
8879 cd double precision sc
8887 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8890 crc-------------------------------------------------
8891 SUBROUTINE MATVEC2(A1,V1,V2)
8892 !DIR$ INLINEALWAYS MATVEC2
8894 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8896 implicit real*8 (a-h,o-z)
8897 include 'DIMENSIONS'
8898 DIMENSION A1(2,2),V1(2),V2(2)
8902 c 3 VI=VI+A1(I,K)*V1(K)
8906 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8907 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8912 C---------------------------------------
8913 SUBROUTINE MATMAT2(A1,A2,A3)
8915 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8917 implicit real*8 (a-h,o-z)
8918 include 'DIMENSIONS'
8919 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8920 c DIMENSION AI3(2,2)
8924 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8930 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8931 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8932 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8933 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8941 c-------------------------------------------------------------------------
8942 double precision function scalar2(u,v)
8943 !DIR$ INLINEALWAYS scalar2
8945 double precision u(2),v(2)
8948 scalar2=u(1)*v(1)+u(2)*v(2)
8952 C-----------------------------------------------------------------------------
8954 subroutine transpose2(a,at)
8955 !DIR$ INLINEALWAYS transpose2
8957 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8960 double precision a(2,2),at(2,2)
8967 c--------------------------------------------------------------------------
8968 subroutine transpose(n,a,at)
8971 double precision a(n,n),at(n,n)
8979 C---------------------------------------------------------------------------
8980 subroutine prodmat3(a1,a2,kk,transp,prod)
8981 !DIR$ INLINEALWAYS prodmat3
8983 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8987 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8989 crc double precision auxmat(2,2),prod_(2,2)
8992 crc call transpose2(kk(1,1),auxmat(1,1))
8993 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8994 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8996 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8997 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8998 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8999 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9000 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9001 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9002 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9003 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9006 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9007 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9009 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9010 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9011 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9012 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9013 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9014 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9015 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9016 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9019 c call transpose2(a2(1,1),a2t(1,1))
9022 crc print *,((prod_(i,j),i=1,2),j=1,2)
9023 crc print *,((prod(i,j),i=1,2),j=1,2)