1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
37 if (fg_rank.eq.0) then
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
39 c print *,"Processor",myrank," BROADCAST iorder"
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
41 C FG slaves as WEIGHTS array.
62 C FG Master broadcasts the WEIGHTS_ array
63 call MPI_Bcast(weights_(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
66 C FG slaves receive the WEIGHTS array
67 call MPI_Bcast(weights(1),n_ene,
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
92 c call chainbuild_cart
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
98 c call int_from_cart1(.false.)
109 C Compute the side-chain and electrostatic interaction energy
111 goto (101,102,103,104,105,106) ipot
112 C Lennard-Jones potential.
113 101 call elj(evdw,evdw_p,evdw_m)
114 cd print '(a)','Exit ELJ'
116 C Lennard-Jones-Kihara potential (shifted).
117 102 call eljk(evdw,evdw_p,evdw_m)
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
120 103 call ebp(evdw,evdw_p,evdw_m)
122 C Gay-Berne potential (shifted LJ, angular dependence).
123 104 call egb(evdw,evdw_p,evdw_m)
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
126 105 call egbv(evdw,evdw_p,evdw_m)
128 C Soft-sphere potential
129 106 call e_softsphere(evdw)
131 C Calculate electrostatic (H-bonding) energy of the main chain.
134 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 time_vec=time_vec+tcpu()-time01
150 c print *,"Processor",myrank," left VEC_AND_DERIV"
153 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
154 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
155 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
156 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
158 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
159 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
160 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
161 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
163 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
172 c write (iout,*) "Soft-spheer ELEC potential"
173 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
176 c print *,"Processor",myrank," computed UELEC"
178 C Calculate excluded-volume interaction energy between peptide groups
183 call escp(evdw2,evdw2_14)
189 c write (iout,*) "Soft-sphere SCP potential"
190 call escp_soft_sphere(evdw2,evdw2_14)
193 c Calculate the bond-stretching energy
197 C Calculate the disulfide-bridge and other energy and the contributions
198 C from other distance constraints.
199 cd print *,'Calling EHPB'
201 cd print *,'EHPB exitted succesfully.'
203 C Calculate the virtual-bond-angle energy.
205 if (wang.gt.0d0) then
210 c print *,"Processor",myrank," computed UB"
212 C Calculate the SC local energy.
215 c print *,"Processor",myrank," computed USC"
217 C Calculate the virtual-bond torsional energy.
219 cd print *,'nterm=',nterm
221 call etor(etors,edihcnstr)
226 c print *,"Processor",myrank," computed Utor"
228 C 6/23/01 Calculate double-torsional energy
230 if (wtor_d.gt.0) then
235 c print *,"Processor",myrank," computed Utord"
237 C 21/5/07 Calculate local sicdechain correlation energy
239 if (wsccor.gt.0.0d0) then
240 call eback_sc_corr(esccor)
244 c print *,"Processor",myrank," computed Usccorr"
246 C 12/1/95 Multi-body terms
250 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
251 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
252 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
253 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
254 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
261 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
262 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
263 cd write (iout,*) "multibody_hb ecorr",ecorr
265 c print *,"Processor",myrank," computed Ucorr"
267 C If performing constraint dynamics, call the constraint energy
268 C after the equilibration time
269 if(usampl.and.totT.gt.eq_time) then
278 time_enecalc=time_enecalc+MPI_Wtime()-time00
280 time_enecalc=time_enecalc+tcpu()-time00
283 c print *,"Processor",myrank," computed Uconstr"
296 energia(2)=evdw2-evdw2_14
313 energia(8)=eello_turn3
314 energia(9)=eello_turn4
321 energia(19)=edihcnstr
323 energia(20)=Uconst+Uconst_back
327 c print *," Processor",myrank," calls SUM_ENERGY"
328 call sum_energy(energia,.true.)
329 c print *," Processor",myrank," left SUM_ENERGY"
332 time_sumene=time_sumene+MPI_Wtime()-time00
334 time_sumene=time_sumene+tcpu()-time00
339 c-------------------------------------------------------------------------------
340 subroutine sum_energy(energia,reduce)
341 implicit real*8 (a-h,o-z)
346 cMS$ATTRIBUTES C :: proc_proc
352 include 'COMMON.SETUP'
353 include 'COMMON.IOUNITS'
354 double precision energia(0:n_ene),enebuff(0:n_ene+1)
355 include 'COMMON.FFIELD'
356 include 'COMMON.DERIV'
357 include 'COMMON.INTERACT'
358 include 'COMMON.SBRIDGE'
359 include 'COMMON.CHAIN'
361 include 'COMMON.CONTROL'
362 include 'COMMON.TIME1'
365 if (nfgtasks.gt.1 .and. reduce) then
367 write (iout,*) "energies before REDUCE"
368 call enerprint(energia)
372 enebuff(i)=energia(i)
375 call MPI_Barrier(FG_COMM,IERR)
376 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
378 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
379 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
381 write (iout,*) "energies after REDUCE"
382 call enerprint(energia)
385 time_Reduce=time_Reduce+MPI_Wtime()-time00
387 if (fg_rank.eq.0) then
390 evdw=energia(22)+wsct*energia(23)
395 evdw2=energia(2)+energia(18)
411 eello_turn3=energia(8)
412 eello_turn4=energia(9)
419 edihcnstr=energia(19)
424 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
425 & +wang*ebe+wtor*etors+wscloc*escloc
426 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
427 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
428 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
429 & +wbond*estr+Uconst+wsccor*esccor
431 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
432 & +wang*ebe+wtor*etors+wscloc*escloc
433 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
434 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
435 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
436 & +wbond*estr+Uconst+wsccor*esccor
442 if (isnan(etot).ne.0) energia(0)=1.0d+99
444 if (isnan(etot)) energia(0)=1.0d+99
449 idumm=proc_proc(etot,i)
451 call proc_proc(etot,i)
453 if(i.eq.1)energia(0)=1.0d+99
460 c-------------------------------------------------------------------------------
461 subroutine sum_gradient
462 implicit real*8 (a-h,o-z)
467 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
475 include 'COMMON.SETUP'
476 include 'COMMON.IOUNITS'
477 include 'COMMON.FFIELD'
478 include 'COMMON.DERIV'
479 include 'COMMON.INTERACT'
480 include 'COMMON.SBRIDGE'
481 include 'COMMON.CHAIN'
483 include 'COMMON.CONTROL'
484 include 'COMMON.TIME1'
485 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
498 & (gvdwcT(j,i),j=1,3)
503 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
504 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
505 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
508 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
509 C in virtual-bond-vector coordinates
512 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
514 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
515 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
517 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
519 c write (iout,'(i5,3f10.5,2x,f10.5)')
520 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
522 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
524 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
525 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
534 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
548 gradbufc(j,i)=wsc*gvdwc(j,i)+
549 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
550 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
551 & wel_loc*gel_loc_long(j,i)+
552 & wcorr*gradcorr_long(j,i)+
553 & wcorr5*gradcorr5_long(j,i)+
554 & wcorr6*gradcorr6_long(j,i)+
555 & wturn6*gcorr6_turn_long(j,i)+
563 gradbufc(j,i)=wsc*gvdwc(j,i)+
564 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
565 & welec*gelc_long(j,i)+
567 & wel_loc*gel_loc_long(j,i)+
568 & wcorr*gradcorr_long(j,i)+
569 & wcorr5*gradcorr5_long(j,i)+
570 & wcorr6*gradcorr6_long(j,i)+
571 & wturn6*gcorr6_turn_long(j,i)+
577 if (nfgtasks.gt.1) then
580 write (iout,*) "gradbufc before allreduce"
582 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
588 gradbufc_sum(j,i)=gradbufc(j,i)
591 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
592 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
593 c time_reduce=time_reduce+MPI_Wtime()-time00
595 c write (iout,*) "gradbufc_sum after allreduce"
597 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
602 c time_allreduce=time_allreduce+MPI_Wtime()-time00
610 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
611 write (iout,*) (i," jgrad_start",jgrad_start(i),
612 & " jgrad_end ",jgrad_end(i),
613 & i=igrad_start,igrad_end)
616 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
617 c do not parallelize this part.
619 c do i=igrad_start,igrad_end
620 c do j=jgrad_start(i),jgrad_end(i)
622 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
627 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
631 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
635 write (iout,*) "gradbufc after summing"
637 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
644 write (iout,*) "gradbufc"
646 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
652 gradbufc_sum(j,i)=gradbufc(j,i)
657 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
661 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
666 c gradbufc(k,i)=0.0d0
670 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
675 write (iout,*) "gradbufc after summing"
677 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
685 gradbufc(k,nres)=0.0d0
690 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
691 & wel_loc*gel_loc(j,i)+
692 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
693 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
694 & wel_loc*gel_loc_long(j,i)+
695 & wcorr*gradcorr_long(j,i)+
696 & wcorr5*gradcorr5_long(j,i)+
697 & wcorr6*gradcorr6_long(j,i)+
698 & wturn6*gcorr6_turn_long(j,i))+
700 & wcorr*gradcorr(j,i)+
701 & wturn3*gcorr3_turn(j,i)+
702 & wturn4*gcorr4_turn(j,i)+
703 & wcorr5*gradcorr5(j,i)+
704 & wcorr6*gradcorr6(j,i)+
705 & wturn6*gcorr6_turn(j,i)+
706 & wsccor*gsccorc(j,i)
707 & +wscloc*gscloc(j,i)
709 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
710 & wel_loc*gel_loc(j,i)+
711 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
712 & welec*gelc_long(j,i)+
713 & wel_loc*gel_loc_long(j,i)+
714 & wcorr*gcorr_long(j,i)+
715 & wcorr5*gradcorr5_long(j,i)+
716 & wcorr6*gradcorr6_long(j,i)+
717 & wturn6*gcorr6_turn_long(j,i))+
719 & wcorr*gradcorr(j,i)+
720 & wturn3*gcorr3_turn(j,i)+
721 & wturn4*gcorr4_turn(j,i)+
722 & wcorr5*gradcorr5(j,i)+
723 & wcorr6*gradcorr6(j,i)+
724 & wturn6*gcorr6_turn(j,i)+
725 & wsccor*gsccorc(j,i)
726 & +wscloc*gscloc(j,i)
729 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
730 & wscp*gradx_scp(j,i)+
732 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
733 & wsccor*gsccorx(j,i)
734 & +wscloc*gsclocx(j,i)
736 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
738 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
739 & wsccor*gsccorx(j,i)
740 & +wscloc*gsclocx(j,i)
745 write (iout,*) "gloc before adding corr"
747 write (iout,*) i,gloc(i,icg)
751 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
752 & +wcorr5*g_corr5_loc(i)
753 & +wcorr6*g_corr6_loc(i)
754 & +wturn4*gel_loc_turn4(i)
755 & +wturn3*gel_loc_turn3(i)
756 & +wturn6*gel_loc_turn6(i)
757 & +wel_loc*gel_loc_loc(i)
758 & +wsccor*gsccor_loc(i)
761 write (iout,*) "gloc after adding corr"
763 write (iout,*) i,gloc(i,icg)
767 if (nfgtasks.gt.1) then
770 gradbufc(j,i)=gradc(j,i,icg)
771 gradbufx(j,i)=gradx(j,i,icg)
775 glocbuf(i)=gloc(i,icg)
778 call MPI_Barrier(FG_COMM,IERR)
779 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
781 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
782 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
783 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
784 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
785 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
786 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
787 time_reduce=time_reduce+MPI_Wtime()-time00
789 write (iout,*) "gloc after reduce"
791 write (iout,*) i,gloc(i,icg)
796 if (gnorm_check) then
798 c Compute the maximum elements of the gradient
808 gcorr3_turn_max=0.0d0
809 gcorr4_turn_max=0.0d0
812 gcorr6_turn_max=0.0d0
822 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
823 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
825 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
826 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
828 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
829 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
830 & gvdwc_scp_max=gvdwc_scp_norm
831 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
832 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
833 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
834 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
835 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
836 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
837 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
838 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
839 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
840 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
841 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
842 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
843 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
845 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
846 & gcorr3_turn_max=gcorr3_turn_norm
847 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
849 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
850 & gcorr4_turn_max=gcorr4_turn_norm
851 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
852 if (gradcorr5_norm.gt.gradcorr5_max)
853 & gradcorr5_max=gradcorr5_norm
854 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
855 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
856 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
858 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
859 & gcorr6_turn_max=gcorr6_turn_norm
860 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
861 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
862 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
863 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
864 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
865 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
867 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
868 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
870 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
871 if (gradx_scp_norm.gt.gradx_scp_max)
872 & gradx_scp_max=gradx_scp_norm
873 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
874 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
875 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
876 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
877 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
878 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
879 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
880 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
884 open(istat,file=statname,position="append")
886 open(istat,file=statname,access="append")
888 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
889 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
890 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
891 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
892 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
893 & gsccorx_max,gsclocx_max
895 if (gvdwc_max.gt.1.0d4) then
896 write (iout,*) "gvdwc gvdwx gradb gradbx"
898 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
899 & gradb(j,i),gradbx(j,i),j=1,3)
901 call pdbout(0.0d0,'cipiszcze',iout)
907 write (iout,*) "gradc gradx gloc"
909 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
910 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
915 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
917 time_sumgradient=time_sumgradient+tcpu()-time01
922 c-------------------------------------------------------------------------------
923 subroutine rescale_weights(t_bath)
924 implicit real*8 (a-h,o-z)
926 include 'COMMON.IOUNITS'
927 include 'COMMON.FFIELD'
928 include 'COMMON.SBRIDGE'
929 double precision kfac /2.4d0/
930 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
932 c facT=2*temp0/(t_bath+temp0)
933 if (rescale_mode.eq.0) then
939 else if (rescale_mode.eq.1) then
940 facT=kfac/(kfac-1.0d0+t_bath/temp0)
941 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
942 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
943 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
944 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
945 else if (rescale_mode.eq.2) then
951 facT=licznik/dlog(dexp(x)+dexp(-x))
952 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
953 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
954 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
955 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
957 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
958 write (*,*) "Wrong RESCALE_MODE",rescale_mode
960 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
964 welec=weights(3)*fact
965 wcorr=weights(4)*fact3
966 wcorr5=weights(5)*fact4
967 wcorr6=weights(6)*fact5
968 wel_loc=weights(7)*fact2
969 wturn3=weights(8)*fact2
970 wturn4=weights(9)*fact3
971 wturn6=weights(10)*fact5
972 wtor=weights(13)*fact
973 wtor_d=weights(14)*fact2
974 wsccor=weights(21)*fact
977 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
981 C------------------------------------------------------------------------
982 subroutine enerprint(energia)
983 implicit real*8 (a-h,o-z)
985 include 'COMMON.IOUNITS'
986 include 'COMMON.FFIELD'
987 include 'COMMON.SBRIDGE'
989 double precision energia(0:n_ene)
992 evdw=energia(22)+wsct*energia(23)
998 evdw2=energia(2)+energia(18)
1010 eello_turn3=energia(8)
1011 eello_turn4=energia(9)
1012 eello_turn6=energia(10)
1018 edihcnstr=energia(19)
1023 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1024 & estr,wbond,ebe,wang,
1025 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1027 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1028 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1029 & edihcnstr,ebr*nss,
1031 10 format (/'Virtual-chain energies:'//
1032 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1033 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1034 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1035 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1036 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1037 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1038 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1039 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1040 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1041 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1042 & ' (SS bridges & dist. cnstr.)'/
1043 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1044 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1045 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1046 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1047 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1048 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1049 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1050 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1051 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1052 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1053 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1054 & 'ETOT= ',1pE16.6,' (total)')
1056 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1057 & estr,wbond,ebe,wang,
1058 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1060 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1061 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1062 & ebr*nss,Uconst,etot
1063 10 format (/'Virtual-chain energies:'//
1064 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1065 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1066 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1067 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1068 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1069 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1070 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1071 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1072 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1073 & ' (SS bridges & dist. cnstr.)'/
1074 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1075 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1076 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1077 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1078 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1079 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1080 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1081 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1082 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1083 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1084 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1085 & 'ETOT= ',1pE16.6,' (total)')
1089 C-----------------------------------------------------------------------
1090 subroutine elj(evdw,evdw_p,evdw_m)
1092 C This subroutine calculates the interaction energy of nonbonded side chains
1093 C assuming the LJ potential of interaction.
1095 implicit real*8 (a-h,o-z)
1096 include 'DIMENSIONS'
1097 parameter (accur=1.0d-10)
1098 include 'COMMON.GEO'
1099 include 'COMMON.VAR'
1100 include 'COMMON.LOCAL'
1101 include 'COMMON.CHAIN'
1102 include 'COMMON.DERIV'
1103 include 'COMMON.INTERACT'
1104 include 'COMMON.TORSION'
1105 include 'COMMON.SBRIDGE'
1106 include 'COMMON.NAMES'
1107 include 'COMMON.IOUNITS'
1108 include 'COMMON.CONTACTS'
1110 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1112 do i=iatsc_s,iatsc_e
1121 C Calculate SC interaction energy.
1123 do iint=1,nint_gr(i)
1124 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1125 cd & 'iend=',iend(i,iint)
1126 do j=istart(i,iint),iend(i,iint)
1131 C Change 12/1/95 to calculate four-body interactions
1132 rij=xj*xj+yj*yj+zj*zj
1134 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1135 eps0ij=eps(itypi,itypj)
1137 e1=fac*fac*aa(itypi,itypj)
1138 e2=fac*bb(itypi,itypj)
1140 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1141 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1142 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1143 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1144 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1145 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1147 if (bb(itypi,itypj).gt.0) then
1148 evdw_p=evdw_p+evdwij
1150 evdw_m=evdw_m+evdwij
1156 C Calculate the components of the gradient in DC and X
1158 fac=-rrij*(e1+evdwij)
1163 if (bb(itypi,itypj).gt.0.0d0) then
1165 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1166 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1167 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1168 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1172 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1173 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1174 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1175 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1180 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1181 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1182 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1183 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1188 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1192 C 12/1/95, revised on 5/20/97
1194 C Calculate the contact function. The ith column of the array JCONT will
1195 C contain the numbers of atoms that make contacts with the atom I (of numbers
1196 C greater than I). The arrays FACONT and GACONT will contain the values of
1197 C the contact function and its derivative.
1199 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1200 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1201 C Uncomment next line, if the correlation interactions are contact function only
1202 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1204 sigij=sigma(itypi,itypj)
1205 r0ij=rs0(itypi,itypj)
1207 C Check whether the SC's are not too far to make a contact.
1210 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1211 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1213 if (fcont.gt.0.0D0) then
1214 C If the SC-SC distance if close to sigma, apply spline.
1215 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1216 cAdam & fcont1,fprimcont1)
1217 cAdam fcont1=1.0d0-fcont1
1218 cAdam if (fcont1.gt.0.0d0) then
1219 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1220 cAdam fcont=fcont*fcont1
1222 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1223 cga eps0ij=1.0d0/dsqrt(eps0ij)
1225 cga gg(k)=gg(k)*eps0ij
1227 cga eps0ij=-evdwij*eps0ij
1228 C Uncomment for AL's type of SC correlation interactions.
1229 cadam eps0ij=-evdwij
1230 num_conti=num_conti+1
1231 jcont(num_conti,i)=j
1232 facont(num_conti,i)=fcont*eps0ij
1233 fprimcont=eps0ij*fprimcont/rij
1235 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1236 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1237 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1238 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1239 gacont(1,num_conti,i)=-fprimcont*xj
1240 gacont(2,num_conti,i)=-fprimcont*yj
1241 gacont(3,num_conti,i)=-fprimcont*zj
1242 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1243 cd write (iout,'(2i3,3f10.5)')
1244 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1250 num_cont(i)=num_conti
1254 gvdwc(j,i)=expon*gvdwc(j,i)
1255 gvdwx(j,i)=expon*gvdwx(j,i)
1258 C******************************************************************************
1262 C To save time, the factor of EXPON has been extracted from ALL components
1263 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1266 C******************************************************************************
1269 C-----------------------------------------------------------------------------
1270 subroutine eljk(evdw,evdw_p,evdw_m)
1272 C This subroutine calculates the interaction energy of nonbonded side chains
1273 C assuming the LJK potential of interaction.
1275 implicit real*8 (a-h,o-z)
1276 include 'DIMENSIONS'
1277 include 'COMMON.GEO'
1278 include 'COMMON.VAR'
1279 include 'COMMON.LOCAL'
1280 include 'COMMON.CHAIN'
1281 include 'COMMON.DERIV'
1282 include 'COMMON.INTERACT'
1283 include 'COMMON.IOUNITS'
1284 include 'COMMON.NAMES'
1287 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1289 do i=iatsc_s,iatsc_e
1296 C Calculate SC interaction energy.
1298 do iint=1,nint_gr(i)
1299 do j=istart(i,iint),iend(i,iint)
1304 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1305 fac_augm=rrij**expon
1306 e_augm=augm(itypi,itypj)*fac_augm
1307 r_inv_ij=dsqrt(rrij)
1309 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1310 fac=r_shift_inv**expon
1311 e1=fac*fac*aa(itypi,itypj)
1312 e2=fac*bb(itypi,itypj)
1314 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1315 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1316 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1317 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1318 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1319 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1320 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1322 if (bb(itypi,itypj).gt.0) then
1323 evdw_p=evdw_p+evdwij
1325 evdw_m=evdw_m+evdwij
1331 C Calculate the components of the gradient in DC and X
1333 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1338 if (bb(itypi,itypj).gt.0.0d0) then
1340 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1341 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1342 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1343 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1347 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1348 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1349 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1350 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1355 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1356 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1357 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1358 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1363 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1371 gvdwc(j,i)=expon*gvdwc(j,i)
1372 gvdwx(j,i)=expon*gvdwx(j,i)
1377 C-----------------------------------------------------------------------------
1378 subroutine ebp(evdw,evdw_p,evdw_m)
1380 C This subroutine calculates the interaction energy of nonbonded side chains
1381 C assuming the Berne-Pechukas potential of interaction.
1383 implicit real*8 (a-h,o-z)
1384 include 'DIMENSIONS'
1385 include 'COMMON.GEO'
1386 include 'COMMON.VAR'
1387 include 'COMMON.LOCAL'
1388 include 'COMMON.CHAIN'
1389 include 'COMMON.DERIV'
1390 include 'COMMON.NAMES'
1391 include 'COMMON.INTERACT'
1392 include 'COMMON.IOUNITS'
1393 include 'COMMON.CALC'
1394 common /srutu/ icall
1395 c double precision rrsave(maxdim)
1398 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1400 c if (icall.eq.0) then
1406 do i=iatsc_s,iatsc_e
1412 dxi=dc_norm(1,nres+i)
1413 dyi=dc_norm(2,nres+i)
1414 dzi=dc_norm(3,nres+i)
1415 c dsci_inv=dsc_inv(itypi)
1416 dsci_inv=vbld_inv(i+nres)
1418 C Calculate SC interaction energy.
1420 do iint=1,nint_gr(i)
1421 do j=istart(i,iint),iend(i,iint)
1424 c dscj_inv=dsc_inv(itypj)
1425 dscj_inv=vbld_inv(j+nres)
1426 chi1=chi(itypi,itypj)
1427 chi2=chi(itypj,itypi)
1434 alf12=0.5D0*(alf1+alf2)
1435 C For diagnostics only!!!
1448 dxj=dc_norm(1,nres+j)
1449 dyj=dc_norm(2,nres+j)
1450 dzj=dc_norm(3,nres+j)
1451 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1452 cd if (icall.eq.0) then
1458 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1460 C Calculate whole angle-dependent part of epsilon and contributions
1461 C to its derivatives
1462 fac=(rrij*sigsq)**expon2
1463 e1=fac*fac*aa(itypi,itypj)
1464 e2=fac*bb(itypi,itypj)
1465 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1466 eps2der=evdwij*eps3rt
1467 eps3der=evdwij*eps2rt
1468 evdwij=evdwij*eps2rt*eps3rt
1470 if (bb(itypi,itypj).gt.0) then
1471 evdw_p=evdw_p+evdwij
1473 evdw_m=evdw_m+evdwij
1479 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1480 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1481 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1482 cd & restyp(itypi),i,restyp(itypj),j,
1483 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1484 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1485 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1488 C Calculate gradient components.
1489 e1=e1*eps1*eps2rt**2*eps3rt**2
1490 fac=-expon*(e1+evdwij)
1493 C Calculate radial part of the gradient
1497 C Calculate the angular part of the gradient and sum add the contributions
1498 C to the appropriate components of the Cartesian gradient.
1500 if (bb(itypi,itypj).gt.0) then
1514 C-----------------------------------------------------------------------------
1515 subroutine egb(evdw,evdw_p,evdw_m)
1517 C This subroutine calculates the interaction energy of nonbonded side chains
1518 C assuming the Gay-Berne potential of interaction.
1520 implicit real*8 (a-h,o-z)
1521 include 'DIMENSIONS'
1522 include 'COMMON.GEO'
1523 include 'COMMON.VAR'
1524 include 'COMMON.LOCAL'
1525 include 'COMMON.CHAIN'
1526 include 'COMMON.DERIV'
1527 include 'COMMON.NAMES'
1528 include 'COMMON.INTERACT'
1529 include 'COMMON.IOUNITS'
1530 include 'COMMON.CALC'
1531 include 'COMMON.CONTROL'
1534 ccccc energy_dec=.false.
1535 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1540 c if (icall.eq.0) lprn=.false.
1542 do i=iatsc_s,iatsc_e
1548 dxi=dc_norm(1,nres+i)
1549 dyi=dc_norm(2,nres+i)
1550 dzi=dc_norm(3,nres+i)
1551 c dsci_inv=dsc_inv(itypi)
1552 dsci_inv=vbld_inv(i+nres)
1553 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1554 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1556 C Calculate SC interaction energy.
1558 do iint=1,nint_gr(i)
1559 do j=istart(i,iint),iend(i,iint)
1562 c dscj_inv=dsc_inv(itypj)
1563 dscj_inv=vbld_inv(j+nres)
1564 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1565 c & 1.0d0/vbld(j+nres)
1566 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1567 sig0ij=sigma(itypi,itypj)
1568 chi1=chi(itypi,itypj)
1569 chi2=chi(itypj,itypi)
1576 alf12=0.5D0*(alf1+alf2)
1577 C For diagnostics only!!!
1590 dxj=dc_norm(1,nres+j)
1591 dyj=dc_norm(2,nres+j)
1592 dzj=dc_norm(3,nres+j)
1593 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1594 c write (iout,*) "j",j," dc_norm",
1595 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1596 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1598 C Calculate angle-dependent terms of energy and contributions to their
1602 sig=sig0ij*dsqrt(sigsq)
1603 rij_shift=1.0D0/rij-sig+sig0ij
1604 c for diagnostics; uncomment
1605 c rij_shift=1.2*sig0ij
1606 C I hate to put IF's in the loops, but here don't have another choice!!!!
1607 if (rij_shift.le.0.0D0) then
1609 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1610 cd & restyp(itypi),i,restyp(itypj),j,
1611 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1615 c---------------------------------------------------------------
1616 rij_shift=1.0D0/rij_shift
1617 fac=rij_shift**expon
1618 e1=fac*fac*aa(itypi,itypj)
1619 e2=fac*bb(itypi,itypj)
1620 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1621 eps2der=evdwij*eps3rt
1622 eps3der=evdwij*eps2rt
1623 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1624 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1625 evdwij=evdwij*eps2rt*eps3rt
1627 if (bb(itypi,itypj).gt.0) then
1628 evdw_p=evdw_p+evdwij
1630 evdw_m=evdw_m+evdwij
1636 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1637 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1638 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1639 & restyp(itypi),i,restyp(itypj),j,
1640 & epsi,sigm,chi1,chi2,chip1,chip2,
1641 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1642 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1646 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1649 C Calculate gradient components.
1650 e1=e1*eps1*eps2rt**2*eps3rt**2
1651 fac=-expon*(e1+evdwij)*rij_shift
1655 C Calculate the radial part of the gradient
1659 C Calculate angular part of the gradient.
1661 if (bb(itypi,itypj).gt.0) then
1672 c write (iout,*) "Number of loop steps in EGB:",ind
1673 cccc energy_dec=.false.
1676 C-----------------------------------------------------------------------------
1677 subroutine egbv(evdw,evdw_p,evdw_m)
1679 C This subroutine calculates the interaction energy of nonbonded side chains
1680 C assuming the Gay-Berne-Vorobjev potential of interaction.
1682 implicit real*8 (a-h,o-z)
1683 include 'DIMENSIONS'
1684 include 'COMMON.GEO'
1685 include 'COMMON.VAR'
1686 include 'COMMON.LOCAL'
1687 include 'COMMON.CHAIN'
1688 include 'COMMON.DERIV'
1689 include 'COMMON.NAMES'
1690 include 'COMMON.INTERACT'
1691 include 'COMMON.IOUNITS'
1692 include 'COMMON.CALC'
1693 common /srutu/ icall
1696 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1699 c if (icall.eq.0) lprn=.true.
1701 do i=iatsc_s,iatsc_e
1707 dxi=dc_norm(1,nres+i)
1708 dyi=dc_norm(2,nres+i)
1709 dzi=dc_norm(3,nres+i)
1710 c dsci_inv=dsc_inv(itypi)
1711 dsci_inv=vbld_inv(i+nres)
1713 C Calculate SC interaction energy.
1715 do iint=1,nint_gr(i)
1716 do j=istart(i,iint),iend(i,iint)
1719 c dscj_inv=dsc_inv(itypj)
1720 dscj_inv=vbld_inv(j+nres)
1721 sig0ij=sigma(itypi,itypj)
1722 r0ij=r0(itypi,itypj)
1723 chi1=chi(itypi,itypj)
1724 chi2=chi(itypj,itypi)
1731 alf12=0.5D0*(alf1+alf2)
1732 C For diagnostics only!!!
1745 dxj=dc_norm(1,nres+j)
1746 dyj=dc_norm(2,nres+j)
1747 dzj=dc_norm(3,nres+j)
1748 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1750 C Calculate angle-dependent terms of energy and contributions to their
1754 sig=sig0ij*dsqrt(sigsq)
1755 rij_shift=1.0D0/rij-sig+r0ij
1756 C I hate to put IF's in the loops, but here don't have another choice!!!!
1757 if (rij_shift.le.0.0D0) then
1762 c---------------------------------------------------------------
1763 rij_shift=1.0D0/rij_shift
1764 fac=rij_shift**expon
1765 e1=fac*fac*aa(itypi,itypj)
1766 e2=fac*bb(itypi,itypj)
1767 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1768 eps2der=evdwij*eps3rt
1769 eps3der=evdwij*eps2rt
1770 fac_augm=rrij**expon
1771 e_augm=augm(itypi,itypj)*fac_augm
1772 evdwij=evdwij*eps2rt*eps3rt
1774 if (bb(itypi,itypj).gt.0) then
1775 evdw_p=evdw_p+evdwij+e_augm
1777 evdw_m=evdw_m+evdwij+e_augm
1780 evdw=evdw+evdwij+e_augm
1783 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1784 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1785 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1786 & restyp(itypi),i,restyp(itypj),j,
1787 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1788 & chi1,chi2,chip1,chip2,
1789 & eps1,eps2rt**2,eps3rt**2,
1790 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1793 C Calculate gradient components.
1794 e1=e1*eps1*eps2rt**2*eps3rt**2
1795 fac=-expon*(e1+evdwij)*rij_shift
1797 fac=rij*fac-2*expon*rrij*e_augm
1798 C Calculate the radial part of the gradient
1802 C Calculate angular part of the gradient.
1804 if (bb(itypi,itypj).gt.0) then
1816 C-----------------------------------------------------------------------------
1817 subroutine sc_angular
1818 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1819 C om12. Called by ebp, egb, and egbv.
1821 include 'COMMON.CALC'
1822 include 'COMMON.IOUNITS'
1826 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1827 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1828 om12=dxi*dxj+dyi*dyj+dzi*dzj
1830 C Calculate eps1(om12) and its derivative in om12
1831 faceps1=1.0D0-om12*chiom12
1832 faceps1_inv=1.0D0/faceps1
1833 eps1=dsqrt(faceps1_inv)
1834 C Following variable is eps1*deps1/dom12
1835 eps1_om12=faceps1_inv*chiom12
1840 c write (iout,*) "om12",om12," eps1",eps1
1841 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1846 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1847 sigsq=1.0D0-facsig*faceps1_inv
1848 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1849 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1850 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1856 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1857 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1859 C Calculate eps2 and its derivatives in om1, om2, and om12.
1862 chipom12=chip12*om12
1863 facp=1.0D0-om12*chipom12
1865 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1866 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1867 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1868 C Following variable is the square root of eps2
1869 eps2rt=1.0D0-facp1*facp_inv
1870 C Following three variables are the derivatives of the square root of eps
1871 C in om1, om2, and om12.
1872 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1873 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1874 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1875 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1876 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1877 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1878 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1879 c & " eps2rt_om12",eps2rt_om12
1880 C Calculate whole angle-dependent part of epsilon and contributions
1881 C to its derivatives
1885 C----------------------------------------------------------------------------
1886 subroutine sc_grad_T
1887 implicit real*8 (a-h,o-z)
1888 include 'DIMENSIONS'
1889 include 'COMMON.CHAIN'
1890 include 'COMMON.DERIV'
1891 include 'COMMON.CALC'
1892 include 'COMMON.IOUNITS'
1893 double precision dcosom1(3),dcosom2(3)
1894 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1895 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1896 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1897 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1901 c eom12=evdwij*eps1_om12
1903 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1904 c & " sigder",sigder
1905 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1906 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1908 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1909 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1912 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1914 c write (iout,*) "gg",(gg(k),k=1,3)
1916 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1917 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1918 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1919 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1920 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1921 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1922 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1923 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1924 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1925 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1928 C Calculate the components of the gradient in DC and X
1932 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1936 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1937 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1942 C----------------------------------------------------------------------------
1944 implicit real*8 (a-h,o-z)
1945 include 'DIMENSIONS'
1946 include 'COMMON.CHAIN'
1947 include 'COMMON.DERIV'
1948 include 'COMMON.CALC'
1949 include 'COMMON.IOUNITS'
1950 double precision dcosom1(3),dcosom2(3)
1951 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1952 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1953 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1954 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1958 c eom12=evdwij*eps1_om12
1960 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1961 c & " sigder",sigder
1962 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1963 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1965 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1966 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1969 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1971 c write (iout,*) "gg",(gg(k),k=1,3)
1973 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1974 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1975 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1977 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1978 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1979 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1980 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1981 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1982 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1985 C Calculate the components of the gradient in DC and X
1989 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1993 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1994 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1998 C-----------------------------------------------------------------------
1999 subroutine e_softsphere(evdw)
2001 C This subroutine calculates the interaction energy of nonbonded side chains
2002 C assuming the LJ potential of interaction.
2004 implicit real*8 (a-h,o-z)
2005 include 'DIMENSIONS'
2006 parameter (accur=1.0d-10)
2007 include 'COMMON.GEO'
2008 include 'COMMON.VAR'
2009 include 'COMMON.LOCAL'
2010 include 'COMMON.CHAIN'
2011 include 'COMMON.DERIV'
2012 include 'COMMON.INTERACT'
2013 include 'COMMON.TORSION'
2014 include 'COMMON.SBRIDGE'
2015 include 'COMMON.NAMES'
2016 include 'COMMON.IOUNITS'
2017 include 'COMMON.CONTACTS'
2019 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2021 do i=iatsc_s,iatsc_e
2028 C Calculate SC interaction energy.
2030 do iint=1,nint_gr(i)
2031 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2032 cd & 'iend=',iend(i,iint)
2033 do j=istart(i,iint),iend(i,iint)
2038 rij=xj*xj+yj*yj+zj*zj
2039 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2040 r0ij=r0(itypi,itypj)
2042 c print *,i,j,r0ij,dsqrt(rij)
2043 if (rij.lt.r0ijsq) then
2044 evdwij=0.25d0*(rij-r0ijsq)**2
2052 C Calculate the components of the gradient in DC and X
2058 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2059 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2060 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2061 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2065 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2073 C--------------------------------------------------------------------------
2074 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2077 C Soft-sphere potential of p-p interaction
2079 implicit real*8 (a-h,o-z)
2080 include 'DIMENSIONS'
2081 include 'COMMON.CONTROL'
2082 include 'COMMON.IOUNITS'
2083 include 'COMMON.GEO'
2084 include 'COMMON.VAR'
2085 include 'COMMON.LOCAL'
2086 include 'COMMON.CHAIN'
2087 include 'COMMON.DERIV'
2088 include 'COMMON.INTERACT'
2089 include 'COMMON.CONTACTS'
2090 include 'COMMON.TORSION'
2091 include 'COMMON.VECTORS'
2092 include 'COMMON.FFIELD'
2094 cd write(iout,*) 'In EELEC_soft_sphere'
2101 do i=iatel_s,iatel_e
2105 xmedi=c(1,i)+0.5d0*dxi
2106 ymedi=c(2,i)+0.5d0*dyi
2107 zmedi=c(3,i)+0.5d0*dzi
2109 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2110 do j=ielstart(i),ielend(i)
2114 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2115 r0ij=rpp(iteli,itelj)
2120 xj=c(1,j)+0.5D0*dxj-xmedi
2121 yj=c(2,j)+0.5D0*dyj-ymedi
2122 zj=c(3,j)+0.5D0*dzj-zmedi
2123 rij=xj*xj+yj*yj+zj*zj
2124 if (rij.lt.r0ijsq) then
2125 evdw1ij=0.25d0*(rij-r0ijsq)**2
2133 C Calculate contributions to the Cartesian gradient.
2139 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2140 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2143 * Loop over residues i+1 thru j-1.
2147 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2152 cgrad do i=nnt,nct-1
2154 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2156 cgrad do j=i+1,nct-1
2158 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2164 c------------------------------------------------------------------------------
2165 subroutine vec_and_deriv
2166 implicit real*8 (a-h,o-z)
2167 include 'DIMENSIONS'
2171 include 'COMMON.IOUNITS'
2172 include 'COMMON.GEO'
2173 include 'COMMON.VAR'
2174 include 'COMMON.LOCAL'
2175 include 'COMMON.CHAIN'
2176 include 'COMMON.VECTORS'
2177 include 'COMMON.SETUP'
2178 include 'COMMON.TIME1'
2179 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2180 C Compute the local reference systems. For reference system (i), the
2181 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2182 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2184 do i=ivec_start,ivec_end
2188 if (i.eq.nres-1) then
2189 C Case of the last full residue
2190 C Compute the Z-axis
2191 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2192 costh=dcos(pi-theta(nres))
2193 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2197 C Compute the derivatives of uz
2199 uzder(2,1,1)=-dc_norm(3,i-1)
2200 uzder(3,1,1)= dc_norm(2,i-1)
2201 uzder(1,2,1)= dc_norm(3,i-1)
2203 uzder(3,2,1)=-dc_norm(1,i-1)
2204 uzder(1,3,1)=-dc_norm(2,i-1)
2205 uzder(2,3,1)= dc_norm(1,i-1)
2208 uzder(2,1,2)= dc_norm(3,i)
2209 uzder(3,1,2)=-dc_norm(2,i)
2210 uzder(1,2,2)=-dc_norm(3,i)
2212 uzder(3,2,2)= dc_norm(1,i)
2213 uzder(1,3,2)= dc_norm(2,i)
2214 uzder(2,3,2)=-dc_norm(1,i)
2216 C Compute the Y-axis
2219 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2221 C Compute the derivatives of uy
2224 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2225 & -dc_norm(k,i)*dc_norm(j,i-1)
2226 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2228 uyder(j,j,1)=uyder(j,j,1)-costh
2229 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2234 uygrad(l,k,j,i)=uyder(l,k,j)
2235 uzgrad(l,k,j,i)=uzder(l,k,j)
2239 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2240 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2241 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2242 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2245 C Compute the Z-axis
2246 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2247 costh=dcos(pi-theta(i+2))
2248 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2252 C Compute the derivatives of uz
2254 uzder(2,1,1)=-dc_norm(3,i+1)
2255 uzder(3,1,1)= dc_norm(2,i+1)
2256 uzder(1,2,1)= dc_norm(3,i+1)
2258 uzder(3,2,1)=-dc_norm(1,i+1)
2259 uzder(1,3,1)=-dc_norm(2,i+1)
2260 uzder(2,3,1)= dc_norm(1,i+1)
2263 uzder(2,1,2)= dc_norm(3,i)
2264 uzder(3,1,2)=-dc_norm(2,i)
2265 uzder(1,2,2)=-dc_norm(3,i)
2267 uzder(3,2,2)= dc_norm(1,i)
2268 uzder(1,3,2)= dc_norm(2,i)
2269 uzder(2,3,2)=-dc_norm(1,i)
2271 C Compute the Y-axis
2274 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2276 C Compute the derivatives of uy
2279 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2280 & -dc_norm(k,i)*dc_norm(j,i+1)
2281 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2283 uyder(j,j,1)=uyder(j,j,1)-costh
2284 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2289 uygrad(l,k,j,i)=uyder(l,k,j)
2290 uzgrad(l,k,j,i)=uzder(l,k,j)
2294 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2295 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2296 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2297 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2301 vbld_inv_temp(1)=vbld_inv(i+1)
2302 if (i.lt.nres-1) then
2303 vbld_inv_temp(2)=vbld_inv(i+2)
2305 vbld_inv_temp(2)=vbld_inv(i)
2310 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2311 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2316 #if defined(PARVEC) && defined(MPI)
2317 if (nfgtasks1.gt.1) then
2319 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2320 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2321 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2322 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2323 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2325 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2326 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2328 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2329 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2330 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2331 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2332 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2333 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2334 time_gather=time_gather+MPI_Wtime()-time00
2336 c if (fg_rank.eq.0) then
2337 c write (iout,*) "Arrays UY and UZ"
2339 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2346 C-----------------------------------------------------------------------------
2347 subroutine check_vecgrad
2348 implicit real*8 (a-h,o-z)
2349 include 'DIMENSIONS'
2350 include 'COMMON.IOUNITS'
2351 include 'COMMON.GEO'
2352 include 'COMMON.VAR'
2353 include 'COMMON.LOCAL'
2354 include 'COMMON.CHAIN'
2355 include 'COMMON.VECTORS'
2356 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2357 dimension uyt(3,maxres),uzt(3,maxres)
2358 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2359 double precision delta /1.0d-7/
2362 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2363 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2364 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2365 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2366 cd & (dc_norm(if90,i),if90=1,3)
2367 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2368 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2369 cd write(iout,'(a)')
2375 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2376 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2389 cd write (iout,*) 'i=',i
2391 erij(k)=dc_norm(k,i)
2395 dc_norm(k,i)=erij(k)
2397 dc_norm(j,i)=dc_norm(j,i)+delta
2398 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2400 c dc_norm(k,i)=dc_norm(k,i)/fac
2402 c write (iout,*) (dc_norm(k,i),k=1,3)
2403 c write (iout,*) (erij(k),k=1,3)
2406 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2407 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2408 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2409 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2411 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2412 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2413 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2416 dc_norm(k,i)=erij(k)
2419 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2420 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2421 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2422 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2423 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2424 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2425 cd write (iout,'(a)')
2430 C--------------------------------------------------------------------------
2431 subroutine set_matrices
2432 implicit real*8 (a-h,o-z)
2433 include 'DIMENSIONS'
2436 include "COMMON.SETUP"
2438 integer status(MPI_STATUS_SIZE)
2440 include 'COMMON.IOUNITS'
2441 include 'COMMON.GEO'
2442 include 'COMMON.VAR'
2443 include 'COMMON.LOCAL'
2444 include 'COMMON.CHAIN'
2445 include 'COMMON.DERIV'
2446 include 'COMMON.INTERACT'
2447 include 'COMMON.CONTACTS'
2448 include 'COMMON.TORSION'
2449 include 'COMMON.VECTORS'
2450 include 'COMMON.FFIELD'
2451 double precision auxvec(2),auxmat(2,2)
2453 C Compute the virtual-bond-torsional-angle dependent quantities needed
2454 C to calculate the el-loc multibody terms of various order.
2457 do i=ivec_start+2,ivec_end+2
2461 if (i .lt. nres+1) then
2498 if (i .gt. 3 .and. i .lt. nres+1) then
2499 obrot_der(1,i-2)=-sin1
2500 obrot_der(2,i-2)= cos1
2501 Ugder(1,1,i-2)= sin1
2502 Ugder(1,2,i-2)=-cos1
2503 Ugder(2,1,i-2)=-cos1
2504 Ugder(2,2,i-2)=-sin1
2507 obrot2_der(1,i-2)=-dwasin2
2508 obrot2_der(2,i-2)= dwacos2
2509 Ug2der(1,1,i-2)= dwasin2
2510 Ug2der(1,2,i-2)=-dwacos2
2511 Ug2der(2,1,i-2)=-dwacos2
2512 Ug2der(2,2,i-2)=-dwasin2
2514 obrot_der(1,i-2)=0.0d0
2515 obrot_der(2,i-2)=0.0d0
2516 Ugder(1,1,i-2)=0.0d0
2517 Ugder(1,2,i-2)=0.0d0
2518 Ugder(2,1,i-2)=0.0d0
2519 Ugder(2,2,i-2)=0.0d0
2520 obrot2_der(1,i-2)=0.0d0
2521 obrot2_der(2,i-2)=0.0d0
2522 Ug2der(1,1,i-2)=0.0d0
2523 Ug2der(1,2,i-2)=0.0d0
2524 Ug2der(2,1,i-2)=0.0d0
2525 Ug2der(2,2,i-2)=0.0d0
2527 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2528 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2529 iti = itortyp(itype(i-2))
2533 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2534 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2535 iti1 = itortyp(itype(i-1))
2539 cd write (iout,*) '*******i',i,' iti1',iti
2540 cd write (iout,*) 'b1',b1(:,iti)
2541 cd write (iout,*) 'b2',b2(:,iti)
2542 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2543 c if (i .gt. iatel_s+2) then
2544 if (i .gt. nnt+2) then
2545 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2546 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2547 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2549 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2550 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2551 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2552 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2553 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2564 DtUg2(l,k,i-2)=0.0d0
2568 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2569 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2571 muder(k,i-2)=Ub2der(k,i-2)
2573 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2574 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2575 iti1 = itortyp(itype(i-1))
2580 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2582 cd write (iout,*) 'mu ',mu(:,i-2)
2583 cd write (iout,*) 'mu1',mu1(:,i-2)
2584 cd write (iout,*) 'mu2',mu2(:,i-2)
2585 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2587 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2588 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2589 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2590 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2591 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2592 C Vectors and matrices dependent on a single virtual-bond dihedral.
2593 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2594 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2595 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2596 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2597 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2598 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2599 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2600 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2601 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2604 C Matrices dependent on two consecutive virtual-bond dihedrals.
2605 C The order of matrices is from left to right.
2606 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2608 c do i=max0(ivec_start,2),ivec_end
2610 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2611 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2612 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2613 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2614 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2615 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2616 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2617 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2620 #if defined(MPI) && defined(PARMAT)
2622 c if (fg_rank.eq.0) then
2623 write (iout,*) "Arrays UG and UGDER before GATHER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & ((ug(l,k,i),l=1,2),k=1,2),
2627 & ((ugder(l,k,i),l=1,2),k=1,2)
2629 write (iout,*) "Arrays UG2 and UG2DER"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & ((ug2(l,k,i),l=1,2),k=1,2),
2633 & ((ug2der(l,k,i),l=1,2),k=1,2)
2635 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2637 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2638 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2639 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2641 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2643 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2644 & costab(i),sintab(i),costab2(i),sintab2(i)
2646 write (iout,*) "Array MUDER"
2648 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2652 if (nfgtasks.gt.1) then
2654 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2655 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2656 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2658 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2661 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2664 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2665 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2667 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2668 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2670 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2671 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2673 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2674 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2676 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2677 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2678 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2679 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2680 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2681 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2682 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2683 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2684 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2685 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2686 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2687 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2688 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2690 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2694 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2696 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2697 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2699 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2700 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2702 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2703 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2705 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2706 & ivec_count(fg_rank1),
2707 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2709 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2712 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2715 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2719 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2721 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2722 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2724 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2725 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2727 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2728 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2730 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2731 & ivec_count(fg_rank1),
2732 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2737 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2738 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2740 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2741 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2743 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2744 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2746 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2747 & ivec_count(fg_rank1),
2748 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2750 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2751 & ivec_count(fg_rank1),
2752 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2754 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2755 & ivec_count(fg_rank1),
2756 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2757 & MPI_MAT2,FG_COMM1,IERR)
2758 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2759 & ivec_count(fg_rank1),
2760 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2761 & MPI_MAT2,FG_COMM1,IERR)
2764 c Passes matrix info through the ring
2767 if (irecv.lt.0) irecv=nfgtasks1-1
2770 if (inext.ge.nfgtasks1) inext=0
2772 c write (iout,*) "isend",isend," irecv",irecv
2774 lensend=lentyp(isend)
2775 lenrecv=lentyp(irecv)
2776 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2777 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2778 c & MPI_ROTAT1(lensend),inext,2200+isend,
2779 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2780 c & iprev,2200+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT1"
2783 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2784 c & MPI_ROTAT2(lensend),inext,3300+isend,
2785 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2786 c & iprev,3300+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather ROTAT2"
2789 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2790 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2791 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2792 & iprev,4400+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather ROTAT_OLD"
2795 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2796 & MPI_PRECOMP11(lensend),inext,5500+isend,
2797 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2798 & iprev,5500+irecv,FG_COMM,status,IERR)
2799 c write (iout,*) "Gather PRECOMP11"
2801 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2802 & MPI_PRECOMP12(lensend),inext,6600+isend,
2803 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2804 & iprev,6600+irecv,FG_COMM,status,IERR)
2805 c write (iout,*) "Gather PRECOMP12"
2807 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2809 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2810 & MPI_ROTAT2(lensend),inext,7700+isend,
2811 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2812 & iprev,7700+irecv,FG_COMM,status,IERR)
2813 c write (iout,*) "Gather PRECOMP21"
2815 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2816 & MPI_PRECOMP22(lensend),inext,8800+isend,
2817 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2818 & iprev,8800+irecv,FG_COMM,status,IERR)
2819 c write (iout,*) "Gather PRECOMP22"
2821 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2822 & MPI_PRECOMP23(lensend),inext,9900+isend,
2823 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2824 & MPI_PRECOMP23(lenrecv),
2825 & iprev,9900+irecv,FG_COMM,status,IERR)
2826 c write (iout,*) "Gather PRECOMP23"
2831 if (irecv.lt.0) irecv=nfgtasks1-1
2834 time_gather=time_gather+MPI_Wtime()-time00
2837 c if (fg_rank.eq.0) then
2838 write (iout,*) "Arrays UG and UGDER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & ((ug(l,k,i),l=1,2),k=1,2),
2842 & ((ugder(l,k,i),l=1,2),k=1,2)
2844 write (iout,*) "Arrays UG2 and UG2DER"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & ((ug2(l,k,i),l=1,2),k=1,2),
2848 & ((ug2der(l,k,i),l=1,2),k=1,2)
2850 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2852 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2853 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2854 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2856 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2858 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2859 & costab(i),sintab(i),costab2(i),sintab2(i)
2861 write (iout,*) "Array MUDER"
2863 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2869 cd iti = itortyp(itype(i))
2872 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2873 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2878 C--------------------------------------------------------------------------
2879 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2881 C This subroutine calculates the average interaction energy and its gradient
2882 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2883 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2884 C The potential depends both on the distance of peptide-group centers and on
2885 C the orientation of the CA-CA virtual bonds.
2887 implicit real*8 (a-h,o-z)
2891 include 'DIMENSIONS'
2892 include 'COMMON.CONTROL'
2893 include 'COMMON.SETUP'
2894 include 'COMMON.IOUNITS'
2895 include 'COMMON.GEO'
2896 include 'COMMON.VAR'
2897 include 'COMMON.LOCAL'
2898 include 'COMMON.CHAIN'
2899 include 'COMMON.DERIV'
2900 include 'COMMON.INTERACT'
2901 include 'COMMON.CONTACTS'
2902 include 'COMMON.TORSION'
2903 include 'COMMON.VECTORS'
2904 include 'COMMON.FFIELD'
2905 include 'COMMON.TIME1'
2906 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2907 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2908 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2909 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2910 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2911 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2913 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2915 double precision scal_el /1.0d0/
2917 double precision scal_el /0.5d0/
2920 C 13-go grudnia roku pamietnego...
2921 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2922 & 0.0d0,1.0d0,0.0d0,
2923 & 0.0d0,0.0d0,1.0d0/
2924 cd write(iout,*) 'In EELEC'
2926 cd write(iout,*) 'Type',i
2927 cd write(iout,*) 'B1',B1(:,i)
2928 cd write(iout,*) 'B2',B2(:,i)
2929 cd write(iout,*) 'CC',CC(:,:,i)
2930 cd write(iout,*) 'DD',DD(:,:,i)
2931 cd write(iout,*) 'EE',EE(:,:,i)
2933 cd call check_vecgrad
2935 if (icheckgrad.eq.1) then
2937 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2939 dc_norm(k,i)=dc(k,i)*fac
2941 c write (iout,*) 'i',i,' fac',fac
2944 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2945 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2946 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2947 c call vec_and_deriv
2953 time_mat=time_mat+MPI_Wtime()-time01
2957 cd write (iout,*) 'i=',i
2959 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2962 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2963 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2976 cd print '(a)','Enter EELEC'
2977 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2979 gel_loc_loc(i)=0.0d0
2984 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2986 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2988 do i=iturn3_start,iturn3_end
2992 dx_normi=dc_norm(1,i)
2993 dy_normi=dc_norm(2,i)
2994 dz_normi=dc_norm(3,i)
2995 xmedi=c(1,i)+0.5d0*dxi
2996 ymedi=c(2,i)+0.5d0*dyi
2997 zmedi=c(3,i)+0.5d0*dzi
2999 call eelecij(i,i+2,ees,evdw1,eel_loc)
3000 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3001 num_cont_hb(i)=num_conti
3003 do i=iturn4_start,iturn4_end
3007 dx_normi=dc_norm(1,i)
3008 dy_normi=dc_norm(2,i)
3009 dz_normi=dc_norm(3,i)
3010 xmedi=c(1,i)+0.5d0*dxi
3011 ymedi=c(2,i)+0.5d0*dyi
3012 zmedi=c(3,i)+0.5d0*dzi
3013 num_conti=num_cont_hb(i)
3014 call eelecij(i,i+3,ees,evdw1,eel_loc)
3015 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3016 num_cont_hb(i)=num_conti
3019 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3021 do i=iatel_s,iatel_e
3025 dx_normi=dc_norm(1,i)
3026 dy_normi=dc_norm(2,i)
3027 dz_normi=dc_norm(3,i)
3028 xmedi=c(1,i)+0.5d0*dxi
3029 ymedi=c(2,i)+0.5d0*dyi
3030 zmedi=c(3,i)+0.5d0*dzi
3031 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3032 num_conti=num_cont_hb(i)
3033 do j=ielstart(i),ielend(i)
3034 call eelecij(i,j,ees,evdw1,eel_loc)
3036 num_cont_hb(i)=num_conti
3038 c write (iout,*) "Number of loop steps in EELEC:",ind
3040 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3041 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3043 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3044 ccc eel_loc=eel_loc+eello_turn3
3045 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3048 C-------------------------------------------------------------------------------
3049 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3050 implicit real*8 (a-h,o-z)
3051 include 'DIMENSIONS'
3055 include 'COMMON.CONTROL'
3056 include 'COMMON.IOUNITS'
3057 include 'COMMON.GEO'
3058 include 'COMMON.VAR'
3059 include 'COMMON.LOCAL'
3060 include 'COMMON.CHAIN'
3061 include 'COMMON.DERIV'
3062 include 'COMMON.INTERACT'
3063 include 'COMMON.CONTACTS'
3064 include 'COMMON.TORSION'
3065 include 'COMMON.VECTORS'
3066 include 'COMMON.FFIELD'
3067 include 'COMMON.TIME1'
3068 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3069 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3070 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3071 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3072 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3073 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3075 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3077 double precision scal_el /1.0d0/
3079 double precision scal_el /0.5d0/
3082 C 13-go grudnia roku pamietnego...
3083 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3084 & 0.0d0,1.0d0,0.0d0,
3085 & 0.0d0,0.0d0,1.0d0/
3086 c time00=MPI_Wtime()
3087 cd write (iout,*) "eelecij",i,j
3091 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3092 aaa=app(iteli,itelj)
3093 bbb=bpp(iteli,itelj)
3094 ael6i=ael6(iteli,itelj)
3095 ael3i=ael3(iteli,itelj)
3099 dx_normj=dc_norm(1,j)
3100 dy_normj=dc_norm(2,j)
3101 dz_normj=dc_norm(3,j)
3102 xj=c(1,j)+0.5D0*dxj-xmedi
3103 yj=c(2,j)+0.5D0*dyj-ymedi
3104 zj=c(3,j)+0.5D0*dzj-zmedi
3105 rij=xj*xj+yj*yj+zj*zj
3111 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3112 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3113 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3114 fac=cosa-3.0D0*cosb*cosg
3116 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3117 if (j.eq.i+2) ev1=scal_el*ev1
3122 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3125 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3126 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3129 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3130 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3131 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3132 cd & xmedi,ymedi,zmedi,xj,yj,zj
3134 if (energy_dec) then
3135 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3136 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3140 C Calculate contributions to the Cartesian gradient.
3143 facvdw=-6*rrmij*(ev1+evdwij)
3144 facel=-3*rrmij*(el1+eesij)
3150 * Radial derivatives. First process both termini of the fragment (i,j)
3156 c ghalf=0.5D0*ggg(k)
3157 c gelc(k,i)=gelc(k,i)+ghalf
3158 c gelc(k,j)=gelc(k,j)+ghalf
3160 c 9/28/08 AL Gradient compotents will be summed only at the end
3162 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3163 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3166 * Loop over residues i+1 thru j-1.
3170 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3177 c ghalf=0.5D0*ggg(k)
3178 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3179 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3181 c 9/28/08 AL Gradient compotents will be summed only at the end
3183 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3184 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3187 * Loop over residues i+1 thru j-1.
3191 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3198 fac=-3*rrmij*(facvdw+facvdw+facel)
3203 * Radial derivatives. First process both termini of the fragment (i,j)
3209 c ghalf=0.5D0*ggg(k)
3210 c gelc(k,i)=gelc(k,i)+ghalf
3211 c gelc(k,j)=gelc(k,j)+ghalf
3213 c 9/28/08 AL Gradient compotents will be summed only at the end
3215 gelc_long(k,j)=gelc(k,j)+ggg(k)
3216 gelc_long(k,i)=gelc(k,i)-ggg(k)
3219 * Loop over residues i+1 thru j-1.
3223 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3226 c 9/28/08 AL Gradient compotents will be summed only at the end
3231 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3232 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3238 ecosa=2.0D0*fac3*fac1+fac4
3241 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3242 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3244 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3245 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3247 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3248 cd & (dcosg(k),k=1,3)
3250 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3253 c ghalf=0.5D0*ggg(k)
3254 c gelc(k,i)=gelc(k,i)+ghalf
3255 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3256 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3257 c gelc(k,j)=gelc(k,j)+ghalf
3258 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3259 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3263 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3268 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3269 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3271 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3272 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3273 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3274 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3276 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3277 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3278 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3280 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3281 C energy of a peptide unit is assumed in the form of a second-order
3282 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3283 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3284 C are computed for EVERY pair of non-contiguous peptide groups.
3286 if (j.lt.nres-1) then
3297 muij(kkk)=mu(k,i)*mu(l,j)
3300 cd write (iout,*) 'EELEC: i',i,' j',j
3301 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3302 cd write(iout,*) 'muij',muij
3303 ury=scalar(uy(1,i),erij)
3304 urz=scalar(uz(1,i),erij)
3305 vry=scalar(uy(1,j),erij)
3306 vrz=scalar(uz(1,j),erij)
3307 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3308 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3309 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3310 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3311 fac=dsqrt(-ael6i)*r3ij
3316 cd write (iout,'(4i5,4f10.5)')
3317 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3318 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3319 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3320 cd & uy(:,j),uz(:,j)
3321 cd write (iout,'(4f10.5)')
3322 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3323 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3324 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3325 cd write (iout,'(9f10.5/)')
3326 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3327 C Derivatives of the elements of A in virtual-bond vectors
3328 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3330 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3331 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3332 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3333 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3334 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3335 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3336 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3337 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3338 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3339 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3340 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3341 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3343 C Compute radial contributions to the gradient
3361 C Add the contributions coming from er
3364 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3365 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3366 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3367 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3370 C Derivatives in DC(i)
3371 cgrad ghalf1=0.5d0*agg(k,1)
3372 cgrad ghalf2=0.5d0*agg(k,2)
3373 cgrad ghalf3=0.5d0*agg(k,3)
3374 cgrad ghalf4=0.5d0*agg(k,4)
3375 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3376 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3377 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3378 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3379 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3380 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3381 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3382 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3383 C Derivatives in DC(i+1)
3384 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3385 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3386 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3387 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3388 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3389 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3390 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3391 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3392 C Derivatives in DC(j)
3393 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3394 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3395 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3396 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3397 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3398 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3399 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3400 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3401 C Derivatives in DC(j+1) or DC(nres-1)
3402 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3403 & -3.0d0*vryg(k,3)*ury)
3404 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3405 & -3.0d0*vrzg(k,3)*ury)
3406 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3407 & -3.0d0*vryg(k,3)*urz)
3408 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3409 & -3.0d0*vrzg(k,3)*urz)
3410 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3412 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3425 aggi(k,l)=-aggi(k,l)
3426 aggi1(k,l)=-aggi1(k,l)
3427 aggj(k,l)=-aggj(k,l)
3428 aggj1(k,l)=-aggj1(k,l)
3431 if (j.lt.nres-1) then
3437 aggi(k,l)=-aggi(k,l)
3438 aggi1(k,l)=-aggi1(k,l)
3439 aggj(k,l)=-aggj(k,l)
3440 aggj1(k,l)=-aggj1(k,l)
3451 aggi(k,l)=-aggi(k,l)
3452 aggi1(k,l)=-aggi1(k,l)
3453 aggj(k,l)=-aggj(k,l)
3454 aggj1(k,l)=-aggj1(k,l)
3459 IF (wel_loc.gt.0.0d0) THEN
3460 C Contribution to the local-electrostatic energy coming from the i-j pair
3461 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3463 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3465 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3466 & 'eelloc',i,j,eel_loc_ij
3468 eel_loc=eel_loc+eel_loc_ij
3469 C Partial derivatives in virtual-bond dihedral angles gamma
3471 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3472 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3473 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3474 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3475 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3476 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3477 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3479 ggg(l)=agg(l,1)*muij(1)+
3480 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3481 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3482 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3483 cgrad ghalf=0.5d0*ggg(l)
3484 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3485 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3489 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3492 C Remaining derivatives of eello
3494 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3495 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3496 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3497 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3498 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3499 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3500 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3501 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3504 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3505 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3506 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3507 & .and. num_conti.le.maxconts) then
3508 c write (iout,*) i,j," entered corr"
3510 C Calculate the contact function. The ith column of the array JCONT will
3511 C contain the numbers of atoms that make contacts with the atom I (of numbers
3512 C greater than I). The arrays FACONT and GACONT will contain the values of
3513 C the contact function and its derivative.
3514 c r0ij=1.02D0*rpp(iteli,itelj)
3515 c r0ij=1.11D0*rpp(iteli,itelj)
3516 r0ij=2.20D0*rpp(iteli,itelj)
3517 c r0ij=1.55D0*rpp(iteli,itelj)
3518 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3519 if (fcont.gt.0.0D0) then
3520 num_conti=num_conti+1
3521 if (num_conti.gt.maxconts) then
3522 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3523 & ' will skip next contacts for this conf.'
3525 jcont_hb(num_conti,i)=j
3526 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3527 cd & " jcont_hb",jcont_hb(num_conti,i)
3528 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3529 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3530 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3532 d_cont(num_conti,i)=rij
3533 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3534 C --- Electrostatic-interaction matrix ---
3535 a_chuj(1,1,num_conti,i)=a22
3536 a_chuj(1,2,num_conti,i)=a23
3537 a_chuj(2,1,num_conti,i)=a32
3538 a_chuj(2,2,num_conti,i)=a33
3539 C --- Gradient of rij
3541 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3548 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3549 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3550 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3551 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3552 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3557 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3558 C Calculate contact energies
3560 wij=cosa-3.0D0*cosb*cosg
3563 c fac3=dsqrt(-ael6i)/r0ij**3
3564 fac3=dsqrt(-ael6i)*r3ij
3565 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3566 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3567 if (ees0tmp.gt.0) then
3568 ees0pij=dsqrt(ees0tmp)
3572 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3573 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3574 if (ees0tmp.gt.0) then
3575 ees0mij=dsqrt(ees0tmp)
3580 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3581 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3582 C Diagnostics. Comment out or remove after debugging!
3583 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3584 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3585 c ees0m(num_conti,i)=0.0D0
3587 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3588 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3589 C Angular derivatives of the contact function
3590 ees0pij1=fac3/ees0pij
3591 ees0mij1=fac3/ees0mij
3592 fac3p=-3.0D0*fac3*rrmij
3593 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3594 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3596 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3597 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3598 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3599 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3600 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3601 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3602 ecosap=ecosa1+ecosa2
3603 ecosbp=ecosb1+ecosb2
3604 ecosgp=ecosg1+ecosg2
3605 ecosam=ecosa1-ecosa2
3606 ecosbm=ecosb1-ecosb2
3607 ecosgm=ecosg1-ecosg2
3616 facont_hb(num_conti,i)=fcont
3617 fprimcont=fprimcont/rij
3618 cd facont_hb(num_conti,i)=1.0D0
3619 C Following line is for diagnostics.
3622 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3623 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3626 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3627 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3629 gggp(1)=gggp(1)+ees0pijp*xj
3630 gggp(2)=gggp(2)+ees0pijp*yj
3631 gggp(3)=gggp(3)+ees0pijp*zj
3632 gggm(1)=gggm(1)+ees0mijp*xj
3633 gggm(2)=gggm(2)+ees0mijp*yj
3634 gggm(3)=gggm(3)+ees0mijp*zj
3635 C Derivatives due to the contact function
3636 gacont_hbr(1,num_conti,i)=fprimcont*xj
3637 gacont_hbr(2,num_conti,i)=fprimcont*yj
3638 gacont_hbr(3,num_conti,i)=fprimcont*zj
3641 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3642 c following the change of gradient-summation algorithm.
3644 cgrad ghalfp=0.5D0*gggp(k)
3645 cgrad ghalfm=0.5D0*gggm(k)
3646 gacontp_hb1(k,num_conti,i)=!ghalfp
3647 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3648 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3649 gacontp_hb2(k,num_conti,i)=!ghalfp
3650 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3651 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3652 gacontp_hb3(k,num_conti,i)=gggp(k)
3653 gacontm_hb1(k,num_conti,i)=!ghalfm
3654 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3655 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3656 gacontm_hb2(k,num_conti,i)=!ghalfm
3657 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3658 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3659 gacontm_hb3(k,num_conti,i)=gggm(k)
3661 C Diagnostics. Comment out or remove after debugging!
3663 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3664 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3665 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3666 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3667 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3668 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3671 endif ! num_conti.le.maxconts
3674 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3677 ghalf=0.5d0*agg(l,k)
3678 aggi(l,k)=aggi(l,k)+ghalf
3679 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3680 aggj(l,k)=aggj(l,k)+ghalf
3683 if (j.eq.nres-1 .and. i.lt.j-2) then
3686 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3691 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3694 C-----------------------------------------------------------------------------
3695 subroutine eturn3(i,eello_turn3)
3696 C Third- and fourth-order contributions from turns
3697 implicit real*8 (a-h,o-z)
3698 include 'DIMENSIONS'
3699 include 'COMMON.IOUNITS'
3700 include 'COMMON.GEO'
3701 include 'COMMON.VAR'
3702 include 'COMMON.LOCAL'
3703 include 'COMMON.CHAIN'
3704 include 'COMMON.DERIV'
3705 include 'COMMON.INTERACT'
3706 include 'COMMON.CONTACTS'
3707 include 'COMMON.TORSION'
3708 include 'COMMON.VECTORS'
3709 include 'COMMON.FFIELD'
3710 include 'COMMON.CONTROL'
3712 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3713 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3714 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3715 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3716 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3717 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3718 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3721 c write (iout,*) "eturn3",i,j,j1,j2
3726 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3728 C Third-order contributions
3735 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3736 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3737 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3738 call transpose2(auxmat(1,1),auxmat1(1,1))
3739 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3740 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3741 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3742 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3743 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3744 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3745 cd & ' eello_turn3_num',4*eello_turn3_num
3746 C Derivatives in gamma(i)
3747 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3748 call transpose2(auxmat2(1,1),auxmat3(1,1))
3749 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3750 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3751 C Derivatives in gamma(i+1)
3752 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3753 call transpose2(auxmat2(1,1),auxmat3(1,1))
3754 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3755 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3756 & +0.5d0*(pizda(1,1)+pizda(2,2))
3757 C Cartesian derivatives
3759 c ghalf1=0.5d0*agg(l,1)
3760 c ghalf2=0.5d0*agg(l,2)
3761 c ghalf3=0.5d0*agg(l,3)
3762 c ghalf4=0.5d0*agg(l,4)
3763 a_temp(1,1)=aggi(l,1)!+ghalf1
3764 a_temp(1,2)=aggi(l,2)!+ghalf2
3765 a_temp(2,1)=aggi(l,3)!+ghalf3
3766 a_temp(2,2)=aggi(l,4)!+ghalf4
3767 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3768 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3769 & +0.5d0*(pizda(1,1)+pizda(2,2))
3770 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3771 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3772 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3773 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3774 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3775 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3776 & +0.5d0*(pizda(1,1)+pizda(2,2))
3777 a_temp(1,1)=aggj(l,1)!+ghalf1
3778 a_temp(1,2)=aggj(l,2)!+ghalf2
3779 a_temp(2,1)=aggj(l,3)!+ghalf3
3780 a_temp(2,2)=aggj(l,4)!+ghalf4
3781 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3782 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3783 & +0.5d0*(pizda(1,1)+pizda(2,2))
3784 a_temp(1,1)=aggj1(l,1)
3785 a_temp(1,2)=aggj1(l,2)
3786 a_temp(2,1)=aggj1(l,3)
3787 a_temp(2,2)=aggj1(l,4)
3788 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3789 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3790 & +0.5d0*(pizda(1,1)+pizda(2,2))
3794 C-------------------------------------------------------------------------------
3795 subroutine eturn4(i,eello_turn4)
3796 C Third- and fourth-order contributions from turns
3797 implicit real*8 (a-h,o-z)
3798 include 'DIMENSIONS'
3799 include 'COMMON.IOUNITS'
3800 include 'COMMON.GEO'
3801 include 'COMMON.VAR'
3802 include 'COMMON.LOCAL'
3803 include 'COMMON.CHAIN'
3804 include 'COMMON.DERIV'
3805 include 'COMMON.INTERACT'
3806 include 'COMMON.CONTACTS'
3807 include 'COMMON.TORSION'
3808 include 'COMMON.VECTORS'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.CONTROL'
3812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3815 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3816 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3817 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3818 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3823 C Fourth-order contributions
3831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3832 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3833 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3838 iti1=itortyp(itype(i+1))
3839 iti2=itortyp(itype(i+2))
3840 iti3=itortyp(itype(i+3))
3841 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3842 call transpose2(EUg(1,1,i+1),e1t(1,1))
3843 call transpose2(Eug(1,1,i+2),e2t(1,1))
3844 call transpose2(Eug(1,1,i+3),e3t(1,1))
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 eello_turn4=eello_turn4-(s1+s2+s3)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,iti2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,iti1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4026 do i=iatscp_s,iatscp_e
4028 xi=0.5D0*(c(1,i)+c(1,i+1))
4029 yi=0.5D0*(c(2,i)+c(2,i+1))
4030 zi=0.5D0*(c(3,i)+c(3,i+1))
4032 do iint=1,nscp_gr(i)
4034 do j=iscpstart(i,iint),iscpend(i,iint)
4036 C Uncomment following three lines for SC-p interactions
4040 C Uncomment following three lines for Ca-p interactions
4044 rij=xj*xj+yj*yj+zj*zj
4047 if (rij.lt.r0ijsq) then
4048 evdwij=0.25d0*(rij-r0ijsq)**2
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4061 cgrad if (j.lt.i) then
4062 cd write (iout,*) 'j<i'
4063 C Uncomment following three lines for SC-p interactions
4065 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4068 cd write (iout,*) 'j>i'
4070 cgrad ggg(k)=-ggg(k)
4071 C Uncomment following line for SC-p interactions
4072 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4076 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4078 cgrad kstart=min0(i+1,j)
4079 cgrad kend=max0(i-1,j-1)
4080 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4081 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4082 cgrad do k=kstart,kend
4084 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4088 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4089 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4097 C-----------------------------------------------------------------------------
4098 subroutine escp(evdw2,evdw2_14)
4100 C This subroutine calculates the excluded-volume interaction energy between
4101 C peptide-group centers and side chains and its gradient in virtual-bond and
4102 C side-chain vectors.
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.GEO'
4107 include 'COMMON.VAR'
4108 include 'COMMON.LOCAL'
4109 include 'COMMON.CHAIN'
4110 include 'COMMON.DERIV'
4111 include 'COMMON.INTERACT'
4112 include 'COMMON.FFIELD'
4113 include 'COMMON.IOUNITS'
4114 include 'COMMON.CONTROL'
4118 cd print '(a)','Enter ESCP'
4119 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4120 do i=iatscp_s,iatscp_e
4122 xi=0.5D0*(c(1,i)+c(1,i+1))
4123 yi=0.5D0*(c(2,i)+c(2,i+1))
4124 zi=0.5D0*(c(3,i)+c(3,i+1))
4126 do iint=1,nscp_gr(i)
4128 do j=iscpstart(i,iint),iscpend(i,iint)
4130 C Uncomment following three lines for SC-p interactions
4134 C Uncomment following three lines for Ca-p interactions
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4140 e1=fac*fac*aad(itypj,iteli)
4141 e2=fac*bad(itypj,iteli)
4142 if (iabs(j-i) .le. 2) then
4145 evdw2_14=evdw2_14+e1+e2
4149 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4150 & 'evdw2',i,j,evdwij
4152 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4154 fac=-(evdwij+e1)*rrij
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4170 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4174 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4176 cgrad kstart=min0(i+1,j)
4177 cgrad kend=max0(i-1,j-1)
4178 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4179 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4180 cgrad do k=kstart,kend
4182 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4186 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4187 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4195 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4196 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4197 gradx_scp(j,i)=expon*gradx_scp(j,i)
4200 C******************************************************************************
4204 C To save time the factor EXPON has been extracted from ALL components
4205 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4208 C******************************************************************************
4211 C--------------------------------------------------------------------------
4212 subroutine edis(ehpb)
4214 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'COMMON.SBRIDGE'
4219 include 'COMMON.CHAIN'
4220 include 'COMMON.DERIV'
4221 include 'COMMON.VAR'
4222 include 'COMMON.INTERACT'
4223 include 'COMMON.IOUNITS'
4226 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4227 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4228 if (link_end.eq.0) return
4229 do i=link_start,link_end
4230 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4231 C CA-CA distance used in regularization of structure.
4234 C iii and jjj point to the residues for which the distance is assigned.
4235 if (ii.gt.nres) then
4242 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4244 C distance and angle dependent SS bond potential.
4245 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4246 call ssbond_ene(iii,jjj,eij)
4248 cd write (iout,*) "eij",eij
4250 C Calculate the distance between the two points and its difference from the
4254 C Get the force constant corresponding to this distance.
4256 C Calculate the contribution to energy.
4257 ehpb=ehpb+waga*rdis*rdis
4259 C Evaluate gradient.
4262 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4263 cd & ' waga=',waga,' fac=',fac
4265 ggg(j)=fac*(c(j,jj)-c(j,ii))
4267 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4268 C If this is a SC-SC distance, we need to calculate the contributions to the
4269 C Cartesian gradient in the SC vectors (ghpbx).
4272 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4273 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4276 cgrad do j=iii,jjj-1
4278 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4282 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4283 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4290 C--------------------------------------------------------------------------
4291 subroutine ssbond_ene(i,j,eij)
4293 C Calculate the distance and angle dependent SS-bond potential energy
4294 C using a free-energy function derived based on RHF/6-31G** ab initio
4295 C calculations of diethyl disulfide.
4297 C A. Liwo and U. Kozlowska, 11/24/03
4299 implicit real*8 (a-h,o-z)
4300 include 'DIMENSIONS'
4301 include 'COMMON.SBRIDGE'
4302 include 'COMMON.CHAIN'
4303 include 'COMMON.DERIV'
4304 include 'COMMON.LOCAL'
4305 include 'COMMON.INTERACT'
4306 include 'COMMON.VAR'
4307 include 'COMMON.IOUNITS'
4308 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4313 dxi=dc_norm(1,nres+i)
4314 dyi=dc_norm(2,nres+i)
4315 dzi=dc_norm(3,nres+i)
4316 c dsci_inv=dsc_inv(itypi)
4317 dsci_inv=vbld_inv(nres+i)
4319 c dscj_inv=dsc_inv(itypj)
4320 dscj_inv=vbld_inv(nres+j)
4324 dxj=dc_norm(1,nres+j)
4325 dyj=dc_norm(2,nres+j)
4326 dzj=dc_norm(3,nres+j)
4327 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4332 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4333 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4334 om12=dxi*dxj+dyi*dyj+dzi*dzj
4336 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4337 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4343 deltat12=om2-om1+2.0d0
4345 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4346 & +akct*deltad*deltat12
4347 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4348 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4349 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4350 c & " deltat12",deltat12," eij",eij
4351 ed=2*akcm*deltad+akct*deltat12
4353 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4354 eom1=-2*akth*deltat1-pom1-om2*pom2
4355 eom2= 2*akth*deltat2+pom1-om1*pom2
4358 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4359 ghpbx(k,i)=ghpbx(k,i)-ggk
4360 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4361 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4362 ghpbx(k,j)=ghpbx(k,j)+ggk
4363 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4364 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4365 ghpbc(k,i)=ghpbc(k,i)-ggk
4366 ghpbc(k,j)=ghpbc(k,j)+ggk
4369 C Calculate the components of the gradient in DC and X
4373 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4378 C--------------------------------------------------------------------------
4379 subroutine ebond(estr)
4381 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4383 implicit real*8 (a-h,o-z)
4384 include 'DIMENSIONS'
4385 include 'COMMON.LOCAL'
4386 include 'COMMON.GEO'
4387 include 'COMMON.INTERACT'
4388 include 'COMMON.DERIV'
4389 include 'COMMON.VAR'
4390 include 'COMMON.CHAIN'
4391 include 'COMMON.IOUNITS'
4392 include 'COMMON.NAMES'
4393 include 'COMMON.FFIELD'
4394 include 'COMMON.CONTROL'
4395 include 'COMMON.SETUP'
4396 double precision u(3),ud(3)
4398 do i=ibondp_start,ibondp_end
4399 diff = vbld(i)-vbldp0
4400 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4403 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4405 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4409 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4411 do i=ibond_start,ibond_end
4416 diff=vbld(i+nres)-vbldsc0(1,iti)
4417 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4418 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4419 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4421 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4425 diff=vbld(i+nres)-vbldsc0(j,iti)
4426 ud(j)=aksc(j,iti)*diff
4427 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4441 uprod2=uprod2*u(k)*u(k)
4445 usumsqder=usumsqder+ud(j)*uprod2
4447 estr=estr+uprod/usum
4449 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4457 C--------------------------------------------------------------------------
4458 subroutine ebend(etheta)
4460 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4461 C angles gamma and its derivatives in consecutive thetas and gammas.
4463 implicit real*8 (a-h,o-z)
4464 include 'DIMENSIONS'
4465 include 'COMMON.LOCAL'
4466 include 'COMMON.GEO'
4467 include 'COMMON.INTERACT'
4468 include 'COMMON.DERIV'
4469 include 'COMMON.VAR'
4470 include 'COMMON.CHAIN'
4471 include 'COMMON.IOUNITS'
4472 include 'COMMON.NAMES'
4473 include 'COMMON.FFIELD'
4474 include 'COMMON.CONTROL'
4475 common /calcthet/ term1,term2,termm,diffak,ratak,
4476 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4477 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4478 double precision y(2),z(2)
4480 c time11=dexp(-2*time)
4483 c write (*,'(a,i2)') 'EBEND ICG=',icg
4484 do i=ithet_start,ithet_end
4485 C Zero the energy function and its derivative at 0 or pi.
4486 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4491 if (phii.ne.phii) phii=150.0
4504 if (phii1.ne.phii1) phii1=150.0
4516 C Calculate the "mean" value of theta from the part of the distribution
4517 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4518 C In following comments this theta will be referred to as t_c.
4519 thet_pred_mean=0.0d0
4523 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4525 dthett=thet_pred_mean*ssd
4526 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4527 C Derivatives of the "mean" values in gamma1 and gamma2.
4528 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4529 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4530 if (theta(i).gt.pi-delta) then
4531 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4533 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4534 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4535 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4537 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4539 else if (theta(i).lt.delta) then
4540 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4541 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4542 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4544 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4545 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4548 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4551 etheta=etheta+ethetai
4552 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4554 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4555 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4556 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4558 C Ufff.... We've done all this!!!
4561 C---------------------------------------------------------------------------
4562 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4564 implicit real*8 (a-h,o-z)
4565 include 'DIMENSIONS'
4566 include 'COMMON.LOCAL'
4567 include 'COMMON.IOUNITS'
4568 common /calcthet/ term1,term2,termm,diffak,ratak,
4569 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4570 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4571 C Calculate the contributions to both Gaussian lobes.
4572 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4573 C The "polynomial part" of the "standard deviation" of this part of
4577 sig=sig*thet_pred_mean+polthet(j,it)
4579 C Derivative of the "interior part" of the "standard deviation of the"
4580 C gamma-dependent Gaussian lobe in t_c.
4581 sigtc=3*polthet(3,it)
4583 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4586 C Set the parameters of both Gaussian lobes of the distribution.
4587 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4588 fac=sig*sig+sigc0(it)
4591 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4592 sigsqtc=-4.0D0*sigcsq*sigtc
4593 c print *,i,sig,sigtc,sigsqtc
4594 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4595 sigtc=-sigtc/(fac*fac)
4596 C Following variable is sigma(t_c)**(-2)
4597 sigcsq=sigcsq*sigcsq
4599 sig0inv=1.0D0/sig0i**2
4600 delthec=thetai-thet_pred_mean
4601 delthe0=thetai-theta0i
4602 term1=-0.5D0*sigcsq*delthec*delthec
4603 term2=-0.5D0*sig0inv*delthe0*delthe0
4604 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4605 C NaNs in taking the logarithm. We extract the largest exponent which is added
4606 C to the energy (this being the log of the distribution) at the end of energy
4607 C term evaluation for this virtual-bond angle.
4608 if (term1.gt.term2) then
4610 term2=dexp(term2-termm)
4614 term1=dexp(term1-termm)
4617 C The ratio between the gamma-independent and gamma-dependent lobes of
4618 C the distribution is a Gaussian function of thet_pred_mean too.
4619 diffak=gthet(2,it)-thet_pred_mean
4620 ratak=diffak/gthet(3,it)**2
4621 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4622 C Let's differentiate it in thet_pred_mean NOW.
4624 C Now put together the distribution terms to make complete distribution.
4625 termexp=term1+ak*term2
4626 termpre=sigc+ak*sig0i
4627 C Contribution of the bending energy from this theta is just the -log of
4628 C the sum of the contributions from the two lobes and the pre-exponential
4629 C factor. Simple enough, isn't it?
4630 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4631 C NOW the derivatives!!!
4632 C 6/6/97 Take into account the deformation.
4633 E_theta=(delthec*sigcsq*term1
4634 & +ak*delthe0*sig0inv*term2)/termexp
4635 E_tc=((sigtc+aktc*sig0i)/termpre
4636 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4637 & aktc*term2)/termexp)
4640 c-----------------------------------------------------------------------------
4641 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4642 implicit real*8 (a-h,o-z)
4643 include 'DIMENSIONS'
4644 include 'COMMON.LOCAL'
4645 include 'COMMON.IOUNITS'
4646 common /calcthet/ term1,term2,termm,diffak,ratak,
4647 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4648 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4649 delthec=thetai-thet_pred_mean
4650 delthe0=thetai-theta0i
4651 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4652 t3 = thetai-thet_pred_mean
4656 t14 = t12+t6*sigsqtc
4658 t21 = thetai-theta0i
4664 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4665 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4666 & *(-t12*t9-ak*sig0inv*t27)
4670 C--------------------------------------------------------------------------
4671 subroutine ebend(etheta)
4673 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4674 C angles gamma and its derivatives in consecutive thetas and gammas.
4675 C ab initio-derived potentials from
4676 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4678 implicit real*8 (a-h,o-z)
4679 include 'DIMENSIONS'
4680 include 'COMMON.LOCAL'
4681 include 'COMMON.GEO'
4682 include 'COMMON.INTERACT'
4683 include 'COMMON.DERIV'
4684 include 'COMMON.VAR'
4685 include 'COMMON.CHAIN'
4686 include 'COMMON.IOUNITS'
4687 include 'COMMON.NAMES'
4688 include 'COMMON.FFIELD'
4689 include 'COMMON.CONTROL'
4690 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4691 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4692 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4693 & sinph1ph2(maxdouble,maxdouble)
4694 logical lprn /.false./, lprn1 /.false./
4696 do i=ithet_start,ithet_end
4700 theti2=0.5d0*theta(i)
4701 ityp2=ithetyp(itype(i-1))
4703 coskt(k)=dcos(k*theti2)
4704 sinkt(k)=dsin(k*theti2)
4709 if (phii.ne.phii) phii=150.0
4713 ityp1=ithetyp(itype(i-2))
4715 cosph1(k)=dcos(k*phii)
4716 sinph1(k)=dsin(k*phii)
4729 if (phii1.ne.phii1) phii1=150.0
4734 ityp3=ithetyp(itype(i))
4736 cosph2(k)=dcos(k*phii1)
4737 sinph2(k)=dsin(k*phii1)
4747 ethetai=aa0thet(ityp1,ityp2,ityp3)
4750 ccl=cosph1(l)*cosph2(k-l)
4751 ssl=sinph1(l)*sinph2(k-l)
4752 scl=sinph1(l)*cosph2(k-l)
4753 csl=cosph1(l)*sinph2(k-l)
4754 cosph1ph2(l,k)=ccl-ssl
4755 cosph1ph2(k,l)=ccl+ssl
4756 sinph1ph2(l,k)=scl+csl
4757 sinph1ph2(k,l)=scl-csl
4761 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4762 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4763 write (iout,*) "coskt and sinkt"
4765 write (iout,*) k,coskt(k),sinkt(k)
4769 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4770 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4773 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4774 & " ethetai",ethetai
4777 write (iout,*) "cosph and sinph"
4779 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4781 write (iout,*) "cosph1ph2 and sinph2ph2"
4784 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4785 & sinph1ph2(l,k),sinph1ph2(k,l)
4788 write(iout,*) "ethetai",ethetai
4792 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4793 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4794 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4795 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4796 ethetai=ethetai+sinkt(m)*aux
4797 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4798 dephii=dephii+k*sinkt(m)*(
4799 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4800 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4801 dephii1=dephii1+k*sinkt(m)*(
4802 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4803 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4805 & write (iout,*) "m",m," k",k," bbthet",
4806 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4807 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4808 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4809 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4813 & write(iout,*) "ethetai",ethetai
4817 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4818 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4819 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4820 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4821 ethetai=ethetai+sinkt(m)*aux
4822 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4823 dephii=dephii+l*sinkt(m)*(
4824 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4825 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4826 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4827 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4828 dephii1=dephii1+(k-l)*sinkt(m)*(
4829 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4830 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4831 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4832 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4834 write (iout,*) "m",m," k",k," l",l," ffthet",
4835 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4836 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4837 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4838 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4839 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4840 & cosph1ph2(k,l)*sinkt(m),
4841 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4847 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4848 & i,theta(i)*rad2deg,phii*rad2deg,
4849 & phii1*rad2deg,ethetai
4850 etheta=etheta+ethetai
4851 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4852 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4853 gloc(nphi+i-2,icg)=wang*dethetai
4859 c-----------------------------------------------------------------------------
4860 subroutine esc(escloc)
4861 C Calculate the local energy of a side chain and its derivatives in the
4862 C corresponding virtual-bond valence angles THETA and the spherical angles
4864 implicit real*8 (a-h,o-z)
4865 include 'DIMENSIONS'
4866 include 'COMMON.GEO'
4867 include 'COMMON.LOCAL'
4868 include 'COMMON.VAR'
4869 include 'COMMON.INTERACT'
4870 include 'COMMON.DERIV'
4871 include 'COMMON.CHAIN'
4872 include 'COMMON.IOUNITS'
4873 include 'COMMON.NAMES'
4874 include 'COMMON.FFIELD'
4875 include 'COMMON.CONTROL'
4876 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4877 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4878 common /sccalc/ time11,time12,time112,theti,it,nlobit
4881 c write (iout,'(a)') 'ESC'
4882 do i=loc_start,loc_end
4884 if (it.eq.10) goto 1
4886 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4887 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4888 theti=theta(i+1)-pipol
4893 if (x(2).gt.pi-delta) then
4897 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4899 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4900 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4902 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4903 & ddersc0(1),dersc(1))
4904 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4905 & ddersc0(3),dersc(3))
4907 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4909 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4910 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4911 & dersc0(2),esclocbi,dersc02)
4912 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4914 call splinthet(x(2),0.5d0*delta,ss,ssd)
4919 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4921 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4922 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4924 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4926 c write (iout,*) escloci
4927 else if (x(2).lt.delta) then
4931 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4933 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4934 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4936 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4937 & ddersc0(1),dersc(1))
4938 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4939 & ddersc0(3),dersc(3))
4941 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4943 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4944 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4945 & dersc0(2),esclocbi,dersc02)
4946 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4951 call splinthet(x(2),0.5d0*delta,ss,ssd)
4953 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4955 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4956 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4958 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4959 c write (iout,*) escloci
4961 call enesc(x,escloci,dersc,ddummy,.false.)
4964 escloc=escloc+escloci
4965 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4966 & 'escloc',i,escloci
4967 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4969 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4971 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4972 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4977 C---------------------------------------------------------------------------
4978 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4979 implicit real*8 (a-h,o-z)
4980 include 'DIMENSIONS'
4981 include 'COMMON.GEO'
4982 include 'COMMON.LOCAL'
4983 include 'COMMON.IOUNITS'
4984 common /sccalc/ time11,time12,time112,theti,it,nlobit
4985 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4986 double precision contr(maxlob,-1:1)
4988 c write (iout,*) 'it=',it,' nlobit=',nlobit
4992 if (mixed) ddersc(j)=0.0d0
4996 C Because of periodicity of the dependence of the SC energy in omega we have
4997 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4998 C To avoid underflows, first compute & store the exponents.
5006 z(k)=x(k)-censc(k,j,it)
5011 Axk=Axk+gaussc(l,k,j,it)*z(l)
5017 expfac=expfac+Ax(k,j,iii)*z(k)
5025 C As in the case of ebend, we want to avoid underflows in exponentiation and
5026 C subsequent NaNs and INFs in energy calculation.
5027 C Find the largest exponent
5031 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5035 cd print *,'it=',it,' emin=',emin
5037 C Compute the contribution to SC energy and derivatives
5042 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5043 if(adexp.ne.adexp) adexp=1.0
5046 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5048 cd print *,'j=',j,' expfac=',expfac
5049 escloc_i=escloc_i+expfac
5051 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5055 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5056 & +gaussc(k,2,j,it))*expfac
5063 dersc(1)=dersc(1)/cos(theti)**2
5064 ddersc(1)=ddersc(1)/cos(theti)**2
5067 escloci=-(dlog(escloc_i)-emin)
5069 dersc(j)=dersc(j)/escloc_i
5073 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5078 C------------------------------------------------------------------------------
5079 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5080 implicit real*8 (a-h,o-z)
5081 include 'DIMENSIONS'
5082 include 'COMMON.GEO'
5083 include 'COMMON.LOCAL'
5084 include 'COMMON.IOUNITS'
5085 common /sccalc/ time11,time12,time112,theti,it,nlobit
5086 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5087 double precision contr(maxlob)
5098 z(k)=x(k)-censc(k,j,it)
5104 Axk=Axk+gaussc(l,k,j,it)*z(l)
5110 expfac=expfac+Ax(k,j)*z(k)
5115 C As in the case of ebend, we want to avoid underflows in exponentiation and
5116 C subsequent NaNs and INFs in energy calculation.
5117 C Find the largest exponent
5120 if (emin.gt.contr(j)) emin=contr(j)
5124 C Compute the contribution to SC energy and derivatives
5128 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5129 escloc_i=escloc_i+expfac
5131 dersc(k)=dersc(k)+Ax(k,j)*expfac
5133 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5134 & +gaussc(1,2,j,it))*expfac
5138 dersc(1)=dersc(1)/cos(theti)**2
5139 dersc12=dersc12/cos(theti)**2
5140 escloci=-(dlog(escloc_i)-emin)
5142 dersc(j)=dersc(j)/escloc_i
5144 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5148 c----------------------------------------------------------------------------------
5149 subroutine esc(escloc)
5150 C Calculate the local energy of a side chain and its derivatives in the
5151 C corresponding virtual-bond valence angles THETA and the spherical angles
5152 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5153 C added by Urszula Kozlowska. 07/11/2007
5155 implicit real*8 (a-h,o-z)
5156 include 'DIMENSIONS'
5157 include 'COMMON.GEO'
5158 include 'COMMON.LOCAL'
5159 include 'COMMON.VAR'
5160 include 'COMMON.SCROT'
5161 include 'COMMON.INTERACT'
5162 include 'COMMON.DERIV'
5163 include 'COMMON.CHAIN'
5164 include 'COMMON.IOUNITS'
5165 include 'COMMON.NAMES'
5166 include 'COMMON.FFIELD'
5167 include 'COMMON.CONTROL'
5168 include 'COMMON.VECTORS'
5169 double precision x_prime(3),y_prime(3),z_prime(3)
5170 & , sumene,dsc_i,dp2_i,x(65),
5171 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5172 & de_dxx,de_dyy,de_dzz,de_dt
5173 double precision s1_t,s1_6_t,s2_t,s2_6_t
5175 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5176 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5177 & dt_dCi(3),dt_dCi1(3)
5178 common /sccalc/ time11,time12,time112,theti,it,nlobit
5181 do i=loc_start,loc_end
5182 costtab(i+1) =dcos(theta(i+1))
5183 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5184 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5185 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5186 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5187 cosfac=dsqrt(cosfac2)
5188 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5189 sinfac=dsqrt(sinfac2)
5191 if (it.eq.10) goto 1
5193 C Compute the axes of tghe local cartesian coordinates system; store in
5194 c x_prime, y_prime and z_prime
5201 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5202 C & dc_norm(3,i+nres)
5204 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5205 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5208 z_prime(j) = -uz(j,i-1)
5211 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5212 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5213 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5214 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5215 c & " xy",scalar(x_prime(1),y_prime(1)),
5216 c & " xz",scalar(x_prime(1),z_prime(1)),
5217 c & " yy",scalar(y_prime(1),y_prime(1)),
5218 c & " yz",scalar(y_prime(1),z_prime(1)),
5219 c & " zz",scalar(z_prime(1),z_prime(1))
5221 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5222 C to local coordinate system. Store in xx, yy, zz.
5228 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5229 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5230 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5237 C Compute the energy of the ith side cbain
5239 c write (2,*) "xx",xx," yy",yy," zz",zz
5242 x(j) = sc_parmin(j,it)
5245 Cc diagnostics - remove later
5247 yy1 = dsin(alph(2))*dcos(omeg(2))
5248 zz1 = -dsin(alph(2))*dsin(omeg(2))
5249 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5250 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5252 C," --- ", xx_w,yy_w,zz_w
5255 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5256 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5258 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5259 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5261 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5262 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5263 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5264 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5265 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5267 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5268 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5269 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5270 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5271 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5273 dsc_i = 0.743d0+x(61)
5275 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5276 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5277 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5278 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5279 s1=(1+x(63))/(0.1d0 + dscp1)
5280 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5281 s2=(1+x(65))/(0.1d0 + dscp2)
5282 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5283 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5284 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5285 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5287 c & dscp1,dscp2,sumene
5288 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5289 escloc = escloc + sumene
5290 c write (2,*) "i",i," escloc",sumene,escloc
5293 C This section to check the numerical derivatives of the energy of ith side
5294 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5295 C #define DEBUG in the code to turn it on.
5297 write (2,*) "sumene =",sumene
5301 write (2,*) xx,yy,zz
5302 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5303 de_dxx_num=(sumenep-sumene)/aincr
5305 write (2,*) "xx+ sumene from enesc=",sumenep
5308 write (2,*) xx,yy,zz
5309 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5310 de_dyy_num=(sumenep-sumene)/aincr
5312 write (2,*) "yy+ sumene from enesc=",sumenep
5315 write (2,*) xx,yy,zz
5316 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5317 de_dzz_num=(sumenep-sumene)/aincr
5319 write (2,*) "zz+ sumene from enesc=",sumenep
5320 costsave=cost2tab(i+1)
5321 sintsave=sint2tab(i+1)
5322 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5323 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5324 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5325 de_dt_num=(sumenep-sumene)/aincr
5326 write (2,*) " t+ sumene from enesc=",sumenep
5327 cost2tab(i+1)=costsave
5328 sint2tab(i+1)=sintsave
5329 C End of diagnostics section.
5332 C Compute the gradient of esc
5334 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5335 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5336 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5337 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5338 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5339 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5340 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5341 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5342 pom1=(sumene3*sint2tab(i+1)+sumene1)
5343 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5344 pom2=(sumene4*cost2tab(i+1)+sumene2)
5345 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5346 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5347 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5348 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5350 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5351 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5352 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5354 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5355 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5356 & +(pom1+pom2)*pom_dx
5358 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5361 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5362 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5363 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5365 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5366 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5367 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5368 & +x(59)*zz**2 +x(60)*xx*zz
5369 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5370 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5371 & +(pom1-pom2)*pom_dy
5373 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5376 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5377 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5378 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5379 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5380 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5381 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5382 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5383 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5385 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5388 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5389 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5390 & +pom1*pom_dt1+pom2*pom_dt2
5392 write(2,*), "de_dt = ", de_dt,de_dt_num
5396 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5397 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5398 cosfac2xx=cosfac2*xx
5399 sinfac2yy=sinfac2*yy
5401 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5403 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5405 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5406 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5407 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5408 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5409 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5410 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5411 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5412 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5413 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5414 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5418 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5419 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5422 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5423 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5424 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5426 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5427 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5431 dXX_Ctab(k,i)=dXX_Ci(k)
5432 dXX_C1tab(k,i)=dXX_Ci1(k)
5433 dYY_Ctab(k,i)=dYY_Ci(k)
5434 dYY_C1tab(k,i)=dYY_Ci1(k)
5435 dZZ_Ctab(k,i)=dZZ_Ci(k)
5436 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5437 dXX_XYZtab(k,i)=dXX_XYZ(k)
5438 dYY_XYZtab(k,i)=dYY_XYZ(k)
5439 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5443 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5444 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5445 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5446 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5447 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5449 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5450 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5451 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5452 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5453 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5454 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5455 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5456 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5458 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5459 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5461 C to check gradient call subroutine check_grad
5467 c------------------------------------------------------------------------------
5468 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5470 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5471 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5472 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5473 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5475 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5476 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5478 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5479 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5480 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5481 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5482 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5484 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5485 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5486 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5487 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5488 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5490 dsc_i = 0.743d0+x(61)
5492 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5493 & *(xx*cost2+yy*sint2))
5494 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5495 & *(xx*cost2-yy*sint2))
5496 s1=(1+x(63))/(0.1d0 + dscp1)
5497 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5498 s2=(1+x(65))/(0.1d0 + dscp2)
5499 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5500 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5501 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5506 c------------------------------------------------------------------------------
5507 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5509 C This procedure calculates two-body contact function g(rij) and its derivative:
5512 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5515 C where x=(rij-r0ij)/delta
5517 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5520 double precision rij,r0ij,eps0ij,fcont,fprimcont
5521 double precision x,x2,x4,delta
5525 if (x.lt.-1.0D0) then
5528 else if (x.le.1.0D0) then
5531 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5532 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5539 c------------------------------------------------------------------------------
5540 subroutine splinthet(theti,delta,ss,ssder)
5541 implicit real*8 (a-h,o-z)
5542 include 'DIMENSIONS'
5543 include 'COMMON.VAR'
5544 include 'COMMON.GEO'
5547 if (theti.gt.pipol) then
5548 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5550 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5555 c------------------------------------------------------------------------------
5556 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5558 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5559 double precision ksi,ksi2,ksi3,a1,a2,a3
5560 a1=fprim0*delta/(f1-f0)
5566 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5567 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5570 c------------------------------------------------------------------------------
5571 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5573 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5574 double precision ksi,ksi2,ksi3,a1,a2,a3
5579 a2=3*(f1x-f0x)-2*fprim0x*delta
5580 a3=fprim0x*delta-2*(f1x-f0x)
5581 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5584 C-----------------------------------------------------------------------------
5586 C-----------------------------------------------------------------------------
5587 subroutine etor(etors,edihcnstr)
5588 implicit real*8 (a-h,o-z)
5589 include 'DIMENSIONS'
5590 include 'COMMON.VAR'
5591 include 'COMMON.GEO'
5592 include 'COMMON.LOCAL'
5593 include 'COMMON.TORSION'
5594 include 'COMMON.INTERACT'
5595 include 'COMMON.DERIV'
5596 include 'COMMON.CHAIN'
5597 include 'COMMON.NAMES'
5598 include 'COMMON.IOUNITS'
5599 include 'COMMON.FFIELD'
5600 include 'COMMON.TORCNSTR'
5601 include 'COMMON.CONTROL'
5603 C Set lprn=.true. for debugging
5607 do i=iphi_start,iphi_end
5609 itori=itortyp(itype(i-2))
5610 itori1=itortyp(itype(i-1))
5613 C Proline-Proline pair is a special case...
5614 if (itori.eq.3 .and. itori1.eq.3) then
5615 if (phii.gt.-dwapi3) then
5617 fac=1.0D0/(1.0D0-cosphi)
5618 etorsi=v1(1,3,3)*fac
5619 etorsi=etorsi+etorsi
5620 etors=etors+etorsi-v1(1,3,3)
5621 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5622 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5625 v1ij=v1(j+1,itori,itori1)
5626 v2ij=v2(j+1,itori,itori1)
5629 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5630 if (energy_dec) etors_ii=etors_ii+
5631 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5632 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5636 v1ij=v1(j,itori,itori1)
5637 v2ij=v2(j,itori,itori1)
5640 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5641 if (energy_dec) etors_ii=etors_ii+
5642 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5643 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5646 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5649 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5650 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5651 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5652 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5653 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5655 ! 6/20/98 - dihedral angle constraints
5658 itori=idih_constr(i)
5661 if (difi.gt.drange(i)) then
5663 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5664 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5665 else if (difi.lt.-drange(i)) then
5667 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5668 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5670 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5671 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5673 ! write (iout,*) 'edihcnstr',edihcnstr
5676 c------------------------------------------------------------------------------
5677 subroutine etor_d(etors_d)
5681 c----------------------------------------------------------------------------
5683 subroutine etor(etors,edihcnstr)
5684 implicit real*8 (a-h,o-z)
5685 include 'DIMENSIONS'
5686 include 'COMMON.VAR'
5687 include 'COMMON.GEO'
5688 include 'COMMON.LOCAL'
5689 include 'COMMON.TORSION'
5690 include 'COMMON.INTERACT'
5691 include 'COMMON.DERIV'
5692 include 'COMMON.CHAIN'
5693 include 'COMMON.NAMES'
5694 include 'COMMON.IOUNITS'
5695 include 'COMMON.FFIELD'
5696 include 'COMMON.TORCNSTR'
5697 include 'COMMON.CONTROL'
5699 C Set lprn=.true. for debugging
5703 do i=iphi_start,iphi_end
5705 itori=itortyp(itype(i-2))
5706 itori1=itortyp(itype(i-1))
5709 C Regular cosine and sine terms
5710 do j=1,nterm(itori,itori1)
5711 v1ij=v1(j,itori,itori1)
5712 v2ij=v2(j,itori,itori1)
5715 etors=etors+v1ij*cosphi+v2ij*sinphi
5716 if (energy_dec) etors_ii=etors_ii+
5717 & v1ij*cosphi+v2ij*sinphi
5718 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5722 C E = SUM ----------------------------------- - v1
5723 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5725 cosphi=dcos(0.5d0*phii)
5726 sinphi=dsin(0.5d0*phii)
5727 do j=1,nlor(itori,itori1)
5728 vl1ij=vlor1(j,itori,itori1)
5729 vl2ij=vlor2(j,itori,itori1)
5730 vl3ij=vlor3(j,itori,itori1)
5731 pom=vl2ij*cosphi+vl3ij*sinphi
5732 pom1=1.0d0/(pom*pom+1.0d0)
5733 etors=etors+vl1ij*pom1
5734 if (energy_dec) etors_ii=etors_ii+
5737 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5739 C Subtract the constant term
5740 etors=etors-v0(itori,itori1)
5741 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5742 & 'etor',i,etors_ii-v0(itori,itori1)
5744 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5745 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5746 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5747 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5748 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5750 ! 6/20/98 - dihedral angle constraints
5752 c do i=1,ndih_constr
5753 do i=idihconstr_start,idihconstr_end
5754 itori=idih_constr(i)
5756 difi=pinorm(phii-phi0(i))
5757 if (difi.gt.drange(i)) then
5759 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5760 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5761 else if (difi.lt.-drange(i)) then
5763 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5764 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5768 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5769 cd & rad2deg*phi0(i), rad2deg*drange(i),
5770 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5772 cd write (iout,*) 'edihcnstr',edihcnstr
5775 c----------------------------------------------------------------------------
5776 subroutine etor_d(etors_d)
5777 C 6/23/01 Compute double torsional energy
5778 implicit real*8 (a-h,o-z)
5779 include 'DIMENSIONS'
5780 include 'COMMON.VAR'
5781 include 'COMMON.GEO'
5782 include 'COMMON.LOCAL'
5783 include 'COMMON.TORSION'
5784 include 'COMMON.INTERACT'
5785 include 'COMMON.DERIV'
5786 include 'COMMON.CHAIN'
5787 include 'COMMON.NAMES'
5788 include 'COMMON.IOUNITS'
5789 include 'COMMON.FFIELD'
5790 include 'COMMON.TORCNSTR'
5792 C Set lprn=.true. for debugging
5796 do i=iphid_start,iphid_end
5797 itori=itortyp(itype(i-2))
5798 itori1=itortyp(itype(i-1))
5799 itori2=itortyp(itype(i))
5804 C Regular cosine and sine terms
5805 do j=1,ntermd_1(itori,itori1,itori2)
5806 v1cij=v1c(1,j,itori,itori1,itori2)
5807 v1sij=v1s(1,j,itori,itori1,itori2)
5808 v2cij=v1c(2,j,itori,itori1,itori2)
5809 v2sij=v1s(2,j,itori,itori1,itori2)
5810 cosphi1=dcos(j*phii)
5811 sinphi1=dsin(j*phii)
5812 cosphi2=dcos(j*phii1)
5813 sinphi2=dsin(j*phii1)
5814 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5815 & v2cij*cosphi2+v2sij*sinphi2
5816 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5817 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5819 do k=2,ntermd_2(itori,itori1,itori2)
5821 v1cdij = v2c(k,l,itori,itori1,itori2)
5822 v2cdij = v2c(l,k,itori,itori1,itori2)
5823 v1sdij = v2s(k,l,itori,itori1,itori2)
5824 v2sdij = v2s(l,k,itori,itori1,itori2)
5825 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5826 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5827 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5828 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5829 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5830 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5831 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5832 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5833 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5834 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5837 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5838 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5843 c------------------------------------------------------------------------------
5844 subroutine eback_sc_corr(esccor)
5845 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5846 c conformational states; temporarily implemented as differences
5847 c between UNRES torsional potentials (dependent on three types of
5848 c residues) and the torsional potentials dependent on all 20 types
5849 c of residues computed from AM1 energy surfaces of terminally-blocked
5850 c amino-acid residues.
5851 implicit real*8 (a-h,o-z)
5852 include 'DIMENSIONS'
5853 include 'COMMON.VAR'
5854 include 'COMMON.GEO'
5855 include 'COMMON.LOCAL'
5856 include 'COMMON.TORSION'
5857 include 'COMMON.SCCOR'
5858 include 'COMMON.INTERACT'
5859 include 'COMMON.DERIV'
5860 include 'COMMON.CHAIN'
5861 include 'COMMON.NAMES'
5862 include 'COMMON.IOUNITS'
5863 include 'COMMON.FFIELD'
5864 include 'COMMON.CONTROL'
5866 C Set lprn=.true. for debugging
5869 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5871 do i=iphi_start,iphi_end
5878 v1ij=v1sccor(j,itori,itori1)
5879 v2ij=v2sccor(j,itori,itori1)
5882 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5883 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5886 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5887 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5888 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5889 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5893 c----------------------------------------------------------------------------
5894 subroutine multibody(ecorr)
5895 C This subroutine calculates multi-body contributions to energy following
5896 C the idea of Skolnick et al. If side chains I and J make a contact and
5897 C at the same time side chains I+1 and J+1 make a contact, an extra
5898 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5899 implicit real*8 (a-h,o-z)
5900 include 'DIMENSIONS'
5901 include 'COMMON.IOUNITS'
5902 include 'COMMON.DERIV'
5903 include 'COMMON.INTERACT'
5904 include 'COMMON.CONTACTS'
5905 double precision gx(3),gx1(3)
5908 C Set lprn=.true. for debugging
5912 write (iout,'(a)') 'Contact function values:'
5914 write (iout,'(i2,20(1x,i2,f10.5))')
5915 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5930 num_conti=num_cont(i)
5931 num_conti1=num_cont(i1)
5936 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5937 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5938 cd & ' ishift=',ishift
5939 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5940 C The system gains extra energy.
5941 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5942 endif ! j1==j+-ishift
5951 c------------------------------------------------------------------------------
5952 double precision function esccorr(i,j,k,l,jj,kk)
5953 implicit real*8 (a-h,o-z)
5954 include 'DIMENSIONS'
5955 include 'COMMON.IOUNITS'
5956 include 'COMMON.DERIV'
5957 include 'COMMON.INTERACT'
5958 include 'COMMON.CONTACTS'
5959 double precision gx(3),gx1(3)
5964 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5965 C Calculate the multi-body contribution to energy.
5966 C Calculate multi-body contributions to the gradient.
5967 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5968 cd & k,l,(gacont(m,kk,k),m=1,3)
5970 gx(m) =ekl*gacont(m,jj,i)
5971 gx1(m)=eij*gacont(m,kk,k)
5972 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5973 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5974 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5975 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5979 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5984 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5990 c------------------------------------------------------------------------------
5991 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5992 C This subroutine calculates multi-body contributions to hydrogen-bonding
5993 implicit real*8 (a-h,o-z)
5994 include 'DIMENSIONS'
5995 include 'COMMON.IOUNITS'
5998 parameter (max_cont=maxconts)
5999 parameter (max_dim=26)
6000 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6001 double precision zapas(max_dim,maxconts,max_fg_procs),
6002 & zapas_recv(max_dim,maxconts,max_fg_procs)
6003 common /przechowalnia/ zapas
6004 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6005 & status_array(MPI_STATUS_SIZE,maxconts*2)
6007 include 'COMMON.SETUP'
6008 include 'COMMON.FFIELD'
6009 include 'COMMON.DERIV'
6010 include 'COMMON.INTERACT'
6011 include 'COMMON.CONTACTS'
6012 include 'COMMON.CONTROL'
6013 include 'COMMON.LOCAL'
6014 double precision gx(3),gx1(3),time00
6017 C Set lprn=.true. for debugging
6022 if (nfgtasks.le.1) goto 30
6024 write (iout,'(a)') 'Contact function values before RECEIVE:'
6026 write (iout,'(2i3,50(1x,i2,f5.2))')
6027 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6028 & j=1,num_cont_hb(i))
6032 do i=1,ntask_cont_from
6035 do i=1,ntask_cont_to
6038 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6040 C Make the list of contacts to send to send to other procesors
6041 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6043 do i=iturn3_start,iturn3_end
6044 c write (iout,*) "make contact list turn3",i," num_cont",
6046 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6048 do i=iturn4_start,iturn4_end
6049 c write (iout,*) "make contact list turn4",i," num_cont",
6051 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6055 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6057 do j=1,num_cont_hb(i)
6060 iproc=iint_sent_local(k,jjc,ii)
6061 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6062 if (iproc.gt.0) then
6063 ncont_sent(iproc)=ncont_sent(iproc)+1
6064 nn=ncont_sent(iproc)
6066 zapas(2,nn,iproc)=jjc
6067 zapas(3,nn,iproc)=facont_hb(j,i)
6068 zapas(4,nn,iproc)=ees0p(j,i)
6069 zapas(5,nn,iproc)=ees0m(j,i)
6070 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6071 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6072 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6073 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6074 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6075 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6076 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6077 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6078 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6079 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6080 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6081 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6082 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6083 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6084 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6085 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6086 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6087 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6088 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6089 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6090 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6097 & "Numbers of contacts to be sent to other processors",
6098 & (ncont_sent(i),i=1,ntask_cont_to)
6099 write (iout,*) "Contacts sent"
6100 do ii=1,ntask_cont_to
6102 iproc=itask_cont_to(ii)
6103 write (iout,*) nn," contacts to processor",iproc,
6104 & " of CONT_TO_COMM group"
6106 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6114 CorrelID1=nfgtasks+fg_rank+1
6116 C Receive the numbers of needed contacts from other processors
6117 do ii=1,ntask_cont_from
6118 iproc=itask_cont_from(ii)
6120 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6121 & FG_COMM,req(ireq),IERR)
6123 c write (iout,*) "IRECV ended"
6125 C Send the number of contacts needed by other processors
6126 do ii=1,ntask_cont_to
6127 iproc=itask_cont_to(ii)
6129 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6130 & FG_COMM,req(ireq),IERR)
6132 c write (iout,*) "ISEND ended"
6133 c write (iout,*) "number of requests (nn)",ireq
6136 & call MPI_Waitall(ireq,req,status_array,ierr)
6138 c & "Numbers of contacts to be received from other processors",
6139 c & (ncont_recv(i),i=1,ntask_cont_from)
6143 do ii=1,ntask_cont_from
6144 iproc=itask_cont_from(ii)
6146 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6147 c & " of CONT_TO_COMM group"
6151 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6152 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6153 c write (iout,*) "ireq,req",ireq,req(ireq)
6156 C Send the contacts to processors that need them
6157 do ii=1,ntask_cont_to
6158 iproc=itask_cont_to(ii)
6160 c write (iout,*) nn," contacts to processor",iproc,
6161 c & " of CONT_TO_COMM group"
6164 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6165 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6166 c write (iout,*) "ireq,req",ireq,req(ireq)
6168 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6172 c write (iout,*) "number of requests (contacts)",ireq
6173 c write (iout,*) "req",(req(i),i=1,4)
6176 & call MPI_Waitall(ireq,req,status_array,ierr)
6177 do iii=1,ntask_cont_from
6178 iproc=itask_cont_from(iii)
6181 write (iout,*) "Received",nn," contacts from processor",iproc,
6182 & " of CONT_FROM_COMM group"
6185 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6190 ii=zapas_recv(1,i,iii)
6191 c Flag the received contacts to prevent double-counting
6192 jj=-zapas_recv(2,i,iii)
6193 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6195 nnn=num_cont_hb(ii)+1
6198 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6199 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6200 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6201 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6202 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6203 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6204 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6205 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6206 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6207 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6208 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6209 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6210 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6211 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6212 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6213 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6214 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6215 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6216 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6217 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6218 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6219 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6220 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6221 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6226 write (iout,'(a)') 'Contact function values after receive:'
6228 write (iout,'(2i3,50(1x,i3,f5.2))')
6229 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6230 & j=1,num_cont_hb(i))
6237 write (iout,'(a)') 'Contact function values:'
6239 write (iout,'(2i3,50(1x,i3,f5.2))')
6240 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6241 & j=1,num_cont_hb(i))
6245 C Remove the loop below after debugging !!!
6252 C Calculate the local-electrostatic correlation terms
6253 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6255 num_conti=num_cont_hb(i)
6256 num_conti1=num_cont_hb(i+1)
6263 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6264 c & ' jj=',jj,' kk=',kk
6265 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6266 & .or. j.lt.0 .and. j1.gt.0) .and.
6267 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6268 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6269 C The system gains extra energy.
6270 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6271 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6272 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6274 else if (j1.eq.j) then
6275 C Contacts I-J and I-(J+1) occur simultaneously.
6276 C The system loses extra energy.
6277 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6282 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6283 c & ' jj=',jj,' kk=',kk
6285 C Contacts I-J and (I+1)-J occur simultaneously.
6286 C The system loses extra energy.
6287 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6294 c------------------------------------------------------------------------------
6295 subroutine add_hb_contact(ii,jj,itask)
6296 implicit real*8 (a-h,o-z)
6297 include "DIMENSIONS"
6298 include "COMMON.IOUNITS"
6301 parameter (max_cont=maxconts)
6302 parameter (max_dim=26)
6303 include "COMMON.CONTACTS"
6304 double precision zapas(max_dim,maxconts,max_fg_procs),
6305 & zapas_recv(max_dim,maxconts,max_fg_procs)
6306 common /przechowalnia/ zapas
6307 integer i,j,ii,jj,iproc,itask(4),nn
6308 c write (iout,*) "itask",itask
6311 if (iproc.gt.0) then
6312 do j=1,num_cont_hb(ii)
6314 c write (iout,*) "i",ii," j",jj," jjc",jjc
6316 ncont_sent(iproc)=ncont_sent(iproc)+1
6317 nn=ncont_sent(iproc)
6318 zapas(1,nn,iproc)=ii
6319 zapas(2,nn,iproc)=jjc
6320 zapas(3,nn,iproc)=facont_hb(j,ii)
6321 zapas(4,nn,iproc)=ees0p(j,ii)
6322 zapas(5,nn,iproc)=ees0m(j,ii)
6323 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6324 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6325 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6326 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6327 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6328 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6329 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6330 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6331 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6332 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6333 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6334 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6335 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6336 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6337 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6338 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6339 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6340 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6341 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6342 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6343 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6351 c------------------------------------------------------------------------------
6352 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6354 C This subroutine calculates multi-body contributions to hydrogen-bonding
6355 implicit real*8 (a-h,o-z)
6356 include 'DIMENSIONS'
6357 include 'COMMON.IOUNITS'
6360 parameter (max_cont=maxconts)
6361 parameter (max_dim=70)
6362 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6363 double precision zapas(max_dim,maxconts,max_fg_procs),
6364 & zapas_recv(max_dim,maxconts,max_fg_procs)
6365 common /przechowalnia/ zapas
6366 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6367 & status_array(MPI_STATUS_SIZE,maxconts*2)
6369 include 'COMMON.SETUP'
6370 include 'COMMON.FFIELD'
6371 include 'COMMON.DERIV'
6372 include 'COMMON.LOCAL'
6373 include 'COMMON.INTERACT'
6374 include 'COMMON.CONTACTS'
6375 include 'COMMON.CHAIN'
6376 include 'COMMON.CONTROL'
6377 double precision gx(3),gx1(3)
6378 integer num_cont_hb_old(maxres)
6380 double precision eello4,eello5,eelo6,eello_turn6
6381 external eello4,eello5,eello6,eello_turn6
6382 C Set lprn=.true. for debugging
6387 num_cont_hb_old(i)=num_cont_hb(i)
6391 if (nfgtasks.le.1) goto 30
6393 write (iout,'(a)') 'Contact function values before RECEIVE:'
6395 write (iout,'(2i3,50(1x,i2,f5.2))')
6396 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6397 & j=1,num_cont_hb(i))
6401 do i=1,ntask_cont_from
6404 do i=1,ntask_cont_to
6407 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6409 C Make the list of contacts to send to send to other procesors
6410 do i=iturn3_start,iturn3_end
6411 c write (iout,*) "make contact list turn3",i," num_cont",
6413 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6415 do i=iturn4_start,iturn4_end
6416 c write (iout,*) "make contact list turn4",i," num_cont",
6418 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6422 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6424 do j=1,num_cont_hb(i)
6427 iproc=iint_sent_local(k,jjc,ii)
6428 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6429 if (iproc.ne.0) then
6430 ncont_sent(iproc)=ncont_sent(iproc)+1
6431 nn=ncont_sent(iproc)
6433 zapas(2,nn,iproc)=jjc
6434 zapas(3,nn,iproc)=d_cont(j,i)
6438 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6443 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6451 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6462 & "Numbers of contacts to be sent to other processors",
6463 & (ncont_sent(i),i=1,ntask_cont_to)
6464 write (iout,*) "Contacts sent"
6465 do ii=1,ntask_cont_to
6467 iproc=itask_cont_to(ii)
6468 write (iout,*) nn," contacts to processor",iproc,
6469 & " of CONT_TO_COMM group"
6471 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6479 CorrelID1=nfgtasks+fg_rank+1
6481 C Receive the numbers of needed contacts from other processors
6482 do ii=1,ntask_cont_from
6483 iproc=itask_cont_from(ii)
6485 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6486 & FG_COMM,req(ireq),IERR)
6488 c write (iout,*) "IRECV ended"
6490 C Send the number of contacts needed by other processors
6491 do ii=1,ntask_cont_to
6492 iproc=itask_cont_to(ii)
6494 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6495 & FG_COMM,req(ireq),IERR)
6497 c write (iout,*) "ISEND ended"
6498 c write (iout,*) "number of requests (nn)",ireq
6501 & call MPI_Waitall(ireq,req,status_array,ierr)
6503 c & "Numbers of contacts to be received from other processors",
6504 c & (ncont_recv(i),i=1,ntask_cont_from)
6508 do ii=1,ntask_cont_from
6509 iproc=itask_cont_from(ii)
6511 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6512 c & " of CONT_TO_COMM group"
6516 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6517 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6518 c write (iout,*) "ireq,req",ireq,req(ireq)
6521 C Send the contacts to processors that need them
6522 do ii=1,ntask_cont_to
6523 iproc=itask_cont_to(ii)
6525 c write (iout,*) nn," contacts to processor",iproc,
6526 c & " of CONT_TO_COMM group"
6529 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6530 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6531 c write (iout,*) "ireq,req",ireq,req(ireq)
6533 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6537 c write (iout,*) "number of requests (contacts)",ireq
6538 c write (iout,*) "req",(req(i),i=1,4)
6541 & call MPI_Waitall(ireq,req,status_array,ierr)
6542 do iii=1,ntask_cont_from
6543 iproc=itask_cont_from(iii)
6546 write (iout,*) "Received",nn," contacts from processor",iproc,
6547 & " of CONT_FROM_COMM group"
6550 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6555 ii=zapas_recv(1,i,iii)
6556 c Flag the received contacts to prevent double-counting
6557 jj=-zapas_recv(2,i,iii)
6558 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6560 nnn=num_cont_hb(ii)+1
6563 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6567 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6572 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6580 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6589 write (iout,'(a)') 'Contact function values after receive:'
6591 write (iout,'(2i3,50(1x,i3,5f6.3))')
6592 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6593 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6600 write (iout,'(a)') 'Contact function values:'
6602 write (iout,'(2i3,50(1x,i2,5f6.3))')
6603 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6604 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6610 C Remove the loop below after debugging !!!
6617 C Calculate the dipole-dipole interaction energies
6618 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6619 do i=iatel_s,iatel_e+1
6620 num_conti=num_cont_hb(i)
6629 C Calculate the local-electrostatic correlation terms
6630 c write (iout,*) "gradcorr5 in eello5 before loop"
6632 c write (iout,'(i5,3f10.5)')
6633 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6635 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6636 c write (iout,*) "corr loop i",i
6638 num_conti=num_cont_hb(i)
6639 num_conti1=num_cont_hb(i+1)
6646 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6647 c & ' jj=',jj,' kk=',kk
6648 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6649 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6650 & .or. j.lt.0 .and. j1.gt.0) .and.
6651 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6652 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6653 C The system gains extra energy.
6655 sqd1=dsqrt(d_cont(jj,i))
6656 sqd2=dsqrt(d_cont(kk,i1))
6657 sred_geom = sqd1*sqd2
6658 IF (sred_geom.lt.cutoff_corr) THEN
6659 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6661 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6662 cd & ' jj=',jj,' kk=',kk
6663 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6664 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6666 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6667 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6670 cd write (iout,*) 'sred_geom=',sred_geom,
6671 cd & ' ekont=',ekont,' fprim=',fprimcont,
6672 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6673 cd write (iout,*) "g_contij",g_contij
6674 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6675 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6676 call calc_eello(i,jp,i+1,jp1,jj,kk)
6677 if (wcorr4.gt.0.0d0)
6678 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6679 if (energy_dec.and.wcorr4.gt.0.0d0)
6680 1 write (iout,'(a6,4i5,0pf7.3)')
6681 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6682 c write (iout,*) "gradcorr5 before eello5"
6684 c write (iout,'(i5,3f10.5)')
6685 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6687 if (wcorr5.gt.0.0d0)
6688 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6689 c write (iout,*) "gradcorr5 after eello5"
6691 c write (iout,'(i5,3f10.5)')
6692 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6694 if (energy_dec.and.wcorr5.gt.0.0d0)
6695 1 write (iout,'(a6,4i5,0pf7.3)')
6696 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6697 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6698 cd write(2,*)'ijkl',i,jp,i+1,jp1
6699 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6700 & .or. wturn6.eq.0.0d0))then
6701 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6702 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6703 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6704 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6705 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6706 cd & 'ecorr6=',ecorr6
6707 cd write (iout,'(4e15.5)') sred_geom,
6708 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6709 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6710 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6711 else if (wturn6.gt.0.0d0
6712 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6713 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6714 eturn6=eturn6+eello_turn6(i,jj,kk)
6715 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6716 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6717 cd write (2,*) 'multibody_eello:eturn6',eturn6
6726 num_cont_hb(i)=num_cont_hb_old(i)
6728 c write (iout,*) "gradcorr5 in eello5"
6730 c write (iout,'(i5,3f10.5)')
6731 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6735 c------------------------------------------------------------------------------
6736 subroutine add_hb_contact_eello(ii,jj,itask)
6737 implicit real*8 (a-h,o-z)
6738 include "DIMENSIONS"
6739 include "COMMON.IOUNITS"
6742 parameter (max_cont=maxconts)
6743 parameter (max_dim=70)
6744 include "COMMON.CONTACTS"
6745 double precision zapas(max_dim,maxconts,max_fg_procs),
6746 & zapas_recv(max_dim,maxconts,max_fg_procs)
6747 common /przechowalnia/ zapas
6748 integer i,j,ii,jj,iproc,itask(4),nn
6749 c write (iout,*) "itask",itask
6752 if (iproc.gt.0) then
6753 do j=1,num_cont_hb(ii)
6755 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6757 ncont_sent(iproc)=ncont_sent(iproc)+1
6758 nn=ncont_sent(iproc)
6759 zapas(1,nn,iproc)=ii
6760 zapas(2,nn,iproc)=jjc
6761 zapas(3,nn,iproc)=d_cont(j,ii)
6765 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6770 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6778 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6790 c------------------------------------------------------------------------------
6791 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6792 implicit real*8 (a-h,o-z)
6793 include 'DIMENSIONS'
6794 include 'COMMON.IOUNITS'
6795 include 'COMMON.DERIV'
6796 include 'COMMON.INTERACT'
6797 include 'COMMON.CONTACTS'
6798 double precision gx(3),gx1(3)
6808 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6809 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6810 C Following 4 lines for diagnostics.
6815 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6816 c & 'Contacts ',i,j,
6817 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6818 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6820 C Calculate the multi-body contribution to energy.
6821 c ecorr=ecorr+ekont*ees
6822 C Calculate multi-body contributions to the gradient.
6823 coeffpees0pij=coeffp*ees0pij
6824 coeffmees0mij=coeffm*ees0mij
6825 coeffpees0pkl=coeffp*ees0pkl
6826 coeffmees0mkl=coeffm*ees0mkl
6828 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6829 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6830 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6831 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6832 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6833 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6834 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6835 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6836 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6837 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6838 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6839 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6840 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6841 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6842 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6843 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6844 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6845 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6846 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6847 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6848 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6849 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6850 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6851 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6852 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6857 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6858 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6859 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6860 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6865 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6866 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6867 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6868 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6871 c write (iout,*) "ehbcorr",ekont*ees
6876 C---------------------------------------------------------------------------
6877 subroutine dipole(i,j,jj)
6878 implicit real*8 (a-h,o-z)
6879 include 'DIMENSIONS'
6880 include 'COMMON.IOUNITS'
6881 include 'COMMON.CHAIN'
6882 include 'COMMON.FFIELD'
6883 include 'COMMON.DERIV'
6884 include 'COMMON.INTERACT'
6885 include 'COMMON.CONTACTS'
6886 include 'COMMON.TORSION'
6887 include 'COMMON.VAR'
6888 include 'COMMON.GEO'
6889 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6891 iti1 = itortyp(itype(i+1))
6892 if (j.lt.nres-1) then
6893 itj1 = itortyp(itype(j+1))
6898 dipi(iii,1)=Ub2(iii,i)
6899 dipderi(iii)=Ub2der(iii,i)
6900 dipi(iii,2)=b1(iii,iti1)
6901 dipj(iii,1)=Ub2(iii,j)
6902 dipderj(iii)=Ub2der(iii,j)
6903 dipj(iii,2)=b1(iii,itj1)
6907 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6910 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6917 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6921 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6926 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6927 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6929 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6931 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6933 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6938 C---------------------------------------------------------------------------
6939 subroutine calc_eello(i,j,k,l,jj,kk)
6941 C This subroutine computes matrices and vectors needed to calculate
6942 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6944 implicit real*8 (a-h,o-z)
6945 include 'DIMENSIONS'
6946 include 'COMMON.IOUNITS'
6947 include 'COMMON.CHAIN'
6948 include 'COMMON.DERIV'
6949 include 'COMMON.INTERACT'
6950 include 'COMMON.CONTACTS'
6951 include 'COMMON.TORSION'
6952 include 'COMMON.VAR'
6953 include 'COMMON.GEO'
6954 include 'COMMON.FFIELD'
6955 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6956 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6959 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6960 cd & ' jj=',jj,' kk=',kk
6961 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6962 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6963 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6966 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6967 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6970 call transpose2(aa1(1,1),aa1t(1,1))
6971 call transpose2(aa2(1,1),aa2t(1,1))
6974 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6975 & aa1tder(1,1,lll,kkk))
6976 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6977 & aa2tder(1,1,lll,kkk))
6981 C parallel orientation of the two CA-CA-CA frames.
6983 iti=itortyp(itype(i))
6987 itk1=itortyp(itype(k+1))
6988 itj=itortyp(itype(j))
6989 if (l.lt.nres-1) then
6990 itl1=itortyp(itype(l+1))
6994 C A1 kernel(j+1) A2T
6996 cd write (iout,'(3f10.5,5x,3f10.5)')
6997 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6999 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7000 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7001 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7002 C Following matrices are needed only for 6-th order cumulants
7003 IF (wcorr6.gt.0.0d0) THEN
7004 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7005 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7006 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7007 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7008 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7009 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7010 & ADtEAderx(1,1,1,1,1,1))
7012 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7013 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7014 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7015 & ADtEA1derx(1,1,1,1,1,1))
7017 C End 6-th order cumulants
7020 cd write (2,*) 'In calc_eello6'
7022 cd write (2,*) 'iii=',iii
7024 cd write (2,*) 'kkk=',kkk
7026 cd write (2,'(3(2f10.5),5x)')
7027 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7032 call transpose2(EUgder(1,1,k),auxmat(1,1))
7033 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7034 call transpose2(EUg(1,1,k),auxmat(1,1))
7035 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7036 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7040 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7041 & EAEAderx(1,1,lll,kkk,iii,1))
7045 C A1T kernel(i+1) A2
7046 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7047 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7048 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7049 C Following matrices are needed only for 6-th order cumulants
7050 IF (wcorr6.gt.0.0d0) THEN
7051 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7052 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7053 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7054 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7055 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7056 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7057 & ADtEAderx(1,1,1,1,1,2))
7058 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7059 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7060 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7061 & ADtEA1derx(1,1,1,1,1,2))
7063 C End 6-th order cumulants
7064 call transpose2(EUgder(1,1,l),auxmat(1,1))
7065 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7066 call transpose2(EUg(1,1,l),auxmat(1,1))
7067 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7068 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7072 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7073 & EAEAderx(1,1,lll,kkk,iii,2))
7078 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7079 C They are needed only when the fifth- or the sixth-order cumulants are
7081 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7082 call transpose2(AEA(1,1,1),auxmat(1,1))
7083 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7084 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7085 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7086 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7087 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7088 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7089 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7090 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7091 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7092 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7093 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7094 call transpose2(AEA(1,1,2),auxmat(1,1))
7095 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7096 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7097 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7098 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7099 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7100 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7101 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7102 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7103 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7104 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7105 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7106 C Calculate the Cartesian derivatives of the vectors.
7110 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7111 call matvec2(auxmat(1,1),b1(1,iti),
7112 & AEAb1derx(1,lll,kkk,iii,1,1))
7113 call matvec2(auxmat(1,1),Ub2(1,i),
7114 & AEAb2derx(1,lll,kkk,iii,1,1))
7115 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7116 & AEAb1derx(1,lll,kkk,iii,2,1))
7117 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7118 & AEAb2derx(1,lll,kkk,iii,2,1))
7119 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7120 call matvec2(auxmat(1,1),b1(1,itj),
7121 & AEAb1derx(1,lll,kkk,iii,1,2))
7122 call matvec2(auxmat(1,1),Ub2(1,j),
7123 & AEAb2derx(1,lll,kkk,iii,1,2))
7124 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7125 & AEAb1derx(1,lll,kkk,iii,2,2))
7126 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7127 & AEAb2derx(1,lll,kkk,iii,2,2))
7134 C Antiparallel orientation of the two CA-CA-CA frames.
7136 iti=itortyp(itype(i))
7140 itk1=itortyp(itype(k+1))
7141 itl=itortyp(itype(l))
7142 itj=itortyp(itype(j))
7143 if (j.lt.nres-1) then
7144 itj1=itortyp(itype(j+1))
7148 C A2 kernel(j-1)T A1T
7149 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7150 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7151 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7152 C Following matrices are needed only for 6-th order cumulants
7153 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7154 & j.eq.i+4 .and. l.eq.i+3)) THEN
7155 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7156 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7157 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7158 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7159 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7160 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7161 & ADtEAderx(1,1,1,1,1,1))
7162 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7163 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7164 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7165 & ADtEA1derx(1,1,1,1,1,1))
7167 C End 6-th order cumulants
7168 call transpose2(EUgder(1,1,k),auxmat(1,1))
7169 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7170 call transpose2(EUg(1,1,k),auxmat(1,1))
7171 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7172 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7176 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7177 & EAEAderx(1,1,lll,kkk,iii,1))
7181 C A2T kernel(i+1)T A1
7182 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7183 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7184 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7185 C Following matrices are needed only for 6-th order cumulants
7186 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7187 & j.eq.i+4 .and. l.eq.i+3)) THEN
7188 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7189 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7190 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7191 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7192 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7193 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7194 & ADtEAderx(1,1,1,1,1,2))
7195 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7196 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7197 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7198 & ADtEA1derx(1,1,1,1,1,2))
7200 C End 6-th order cumulants
7201 call transpose2(EUgder(1,1,j),auxmat(1,1))
7202 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7203 call transpose2(EUg(1,1,j),auxmat(1,1))
7204 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7205 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7209 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7210 & EAEAderx(1,1,lll,kkk,iii,2))
7215 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7216 C They are needed only when the fifth- or the sixth-order cumulants are
7218 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7219 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7220 call transpose2(AEA(1,1,1),auxmat(1,1))
7221 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7222 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7223 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7224 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7225 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7226 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7227 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7228 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7229 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7230 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7231 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7232 call transpose2(AEA(1,1,2),auxmat(1,1))
7233 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7234 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7235 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7236 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7237 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7238 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7239 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7240 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7241 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7242 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7243 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7244 C Calculate the Cartesian derivatives of the vectors.
7248 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7249 call matvec2(auxmat(1,1),b1(1,iti),
7250 & AEAb1derx(1,lll,kkk,iii,1,1))
7251 call matvec2(auxmat(1,1),Ub2(1,i),
7252 & AEAb2derx(1,lll,kkk,iii,1,1))
7253 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7254 & AEAb1derx(1,lll,kkk,iii,2,1))
7255 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7256 & AEAb2derx(1,lll,kkk,iii,2,1))
7257 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7258 call matvec2(auxmat(1,1),b1(1,itl),
7259 & AEAb1derx(1,lll,kkk,iii,1,2))
7260 call matvec2(auxmat(1,1),Ub2(1,l),
7261 & AEAb2derx(1,lll,kkk,iii,1,2))
7262 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7263 & AEAb1derx(1,lll,kkk,iii,2,2))
7264 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7265 & AEAb2derx(1,lll,kkk,iii,2,2))
7274 C---------------------------------------------------------------------------
7275 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7276 & KK,KKderg,AKA,AKAderg,AKAderx)
7280 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7281 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7282 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7287 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7289 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7292 cd if (lprn) write (2,*) 'In kernel'
7294 cd if (lprn) write (2,*) 'kkk=',kkk
7296 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7297 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7299 cd write (2,*) 'lll=',lll
7300 cd write (2,*) 'iii=1'
7302 cd write (2,'(3(2f10.5),5x)')
7303 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7306 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7307 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7309 cd write (2,*) 'lll=',lll
7310 cd write (2,*) 'iii=2'
7312 cd write (2,'(3(2f10.5),5x)')
7313 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7320 C---------------------------------------------------------------------------
7321 double precision function eello4(i,j,k,l,jj,kk)
7322 implicit real*8 (a-h,o-z)
7323 include 'DIMENSIONS'
7324 include 'COMMON.IOUNITS'
7325 include 'COMMON.CHAIN'
7326 include 'COMMON.DERIV'
7327 include 'COMMON.INTERACT'
7328 include 'COMMON.CONTACTS'
7329 include 'COMMON.TORSION'
7330 include 'COMMON.VAR'
7331 include 'COMMON.GEO'
7332 double precision pizda(2,2),ggg1(3),ggg2(3)
7333 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7337 cd print *,'eello4:',i,j,k,l,jj,kk
7338 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7339 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7340 cold eij=facont_hb(jj,i)
7341 cold ekl=facont_hb(kk,k)
7343 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7344 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7345 gcorr_loc(k-1)=gcorr_loc(k-1)
7346 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7348 gcorr_loc(l-1)=gcorr_loc(l-1)
7349 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7351 gcorr_loc(j-1)=gcorr_loc(j-1)
7352 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7357 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7358 & -EAEAderx(2,2,lll,kkk,iii,1)
7359 cd derx(lll,kkk,iii)=0.0d0
7363 cd gcorr_loc(l-1)=0.0d0
7364 cd gcorr_loc(j-1)=0.0d0
7365 cd gcorr_loc(k-1)=0.0d0
7367 cd write (iout,*)'Contacts have occurred for peptide groups',
7368 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7369 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7370 if (j.lt.nres-1) then
7377 if (l.lt.nres-1) then
7385 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7386 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7387 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7388 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7389 cgrad ghalf=0.5d0*ggg1(ll)
7390 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7391 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7392 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7393 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7394 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7395 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7396 cgrad ghalf=0.5d0*ggg2(ll)
7397 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7398 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7399 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7400 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7401 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7402 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7406 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7411 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7416 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7421 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7425 cd write (2,*) iii,gcorr_loc(iii)
7428 cd write (2,*) 'ekont',ekont
7429 cd write (iout,*) 'eello4',ekont*eel4
7432 C---------------------------------------------------------------------------
7433 double precision function eello5(i,j,k,l,jj,kk)
7434 implicit real*8 (a-h,o-z)
7435 include 'DIMENSIONS'
7436 include 'COMMON.IOUNITS'
7437 include 'COMMON.CHAIN'
7438 include 'COMMON.DERIV'
7439 include 'COMMON.INTERACT'
7440 include 'COMMON.CONTACTS'
7441 include 'COMMON.TORSION'
7442 include 'COMMON.VAR'
7443 include 'COMMON.GEO'
7444 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7445 double precision ggg1(3),ggg2(3)
7446 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7451 C /l\ / \ \ / \ / \ / C
7452 C / \ / \ \ / \ / \ / C
7453 C j| o |l1 | o | o| o | | o |o C
7454 C \ |/k\| |/ \| / |/ \| |/ \| C
7455 C \i/ \ / \ / / \ / \ C
7457 C (I) (II) (III) (IV) C
7459 C eello5_1 eello5_2 eello5_3 eello5_4 C
7461 C Antiparallel chains C
7464 C /j\ / \ \ / \ / \ / C
7465 C / \ / \ \ / \ / \ / C
7466 C j1| o |l | o | o| o | | o |o C
7467 C \ |/k\| |/ \| / |/ \| |/ \| C
7468 C \i/ \ / \ / / \ / \ C
7470 C (I) (II) (III) (IV) C
7472 C eello5_1 eello5_2 eello5_3 eello5_4 C
7474 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7476 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7477 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7482 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7484 itk=itortyp(itype(k))
7485 itl=itortyp(itype(l))
7486 itj=itortyp(itype(j))
7491 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7492 cd & eel5_3_num,eel5_4_num)
7496 derx(lll,kkk,iii)=0.0d0
7500 cd eij=facont_hb(jj,i)
7501 cd ekl=facont_hb(kk,k)
7503 cd write (iout,*)'Contacts have occurred for peptide groups',
7504 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7506 C Contribution from the graph I.
7507 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7508 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7509 call transpose2(EUg(1,1,k),auxmat(1,1))
7510 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7511 vv(1)=pizda(1,1)-pizda(2,2)
7512 vv(2)=pizda(1,2)+pizda(2,1)
7513 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7514 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7515 C Explicit gradient in virtual-dihedral angles.
7516 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7517 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7518 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7519 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7520 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7521 vv(1)=pizda(1,1)-pizda(2,2)
7522 vv(2)=pizda(1,2)+pizda(2,1)
7523 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7524 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7525 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7526 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7527 vv(1)=pizda(1,1)-pizda(2,2)
7528 vv(2)=pizda(1,2)+pizda(2,1)
7530 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7531 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7534 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7535 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7536 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7538 C Cartesian gradient
7542 call matmat2(AEAderx(1,1,lll,kkk,iii,1),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,1),Ub2(1,k))
7548 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7554 C Contribution from graph II
7555 call transpose2(EE(1,1,itk),auxmat(1,1))
7556 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7557 vv(1)=pizda(1,1)+pizda(2,2)
7558 vv(2)=pizda(2,1)-pizda(1,2)
7559 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7560 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7561 C Explicit gradient in virtual-dihedral angles.
7562 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7563 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7564 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7565 vv(1)=pizda(1,1)+pizda(2,2)
7566 vv(2)=pizda(2,1)-pizda(1,2)
7568 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7569 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7570 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7572 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7573 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7574 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7576 C Cartesian gradient
7580 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7582 vv(1)=pizda(1,1)+pizda(2,2)
7583 vv(2)=pizda(2,1)-pizda(1,2)
7584 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7585 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7586 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7594 C Parallel orientation
7595 C Contribution from graph III
7596 call transpose2(EUg(1,1,l),auxmat(1,1))
7597 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7598 vv(1)=pizda(1,1)-pizda(2,2)
7599 vv(2)=pizda(1,2)+pizda(2,1)
7600 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7601 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7602 C Explicit gradient in virtual-dihedral angles.
7603 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7604 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7605 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7606 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7607 vv(1)=pizda(1,1)-pizda(2,2)
7608 vv(2)=pizda(1,2)+pizda(2,1)
7609 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7610 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7611 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7612 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7613 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7614 vv(1)=pizda(1,1)-pizda(2,2)
7615 vv(2)=pizda(1,2)+pizda(2,1)
7616 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7617 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7618 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7619 C Cartesian gradient
7623 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7625 vv(1)=pizda(1,1)-pizda(2,2)
7626 vv(2)=pizda(1,2)+pizda(2,1)
7627 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7628 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7629 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7634 C Contribution from graph IV
7636 call transpose2(EE(1,1,itl),auxmat(1,1))
7637 call matmat2(auxmat(1,1),AEA(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 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7641 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7642 C Explicit gradient in virtual-dihedral angles.
7643 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7644 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7645 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7646 vv(1)=pizda(1,1)+pizda(2,2)
7647 vv(2)=pizda(2,1)-pizda(1,2)
7648 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7649 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7650 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7651 C Cartesian gradient
7655 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7657 vv(1)=pizda(1,1)+pizda(2,2)
7658 vv(2)=pizda(2,1)-pizda(1,2)
7659 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7660 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7661 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7666 C Antiparallel orientation
7667 C Contribution from graph III
7669 call transpose2(EUg(1,1,j),auxmat(1,1))
7670 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7671 vv(1)=pizda(1,1)-pizda(2,2)
7672 vv(2)=pizda(1,2)+pizda(2,1)
7673 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7674 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7675 C Explicit gradient in virtual-dihedral angles.
7676 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7677 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7678 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7679 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7680 vv(1)=pizda(1,1)-pizda(2,2)
7681 vv(2)=pizda(1,2)+pizda(2,1)
7682 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7683 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7684 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7685 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7686 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7689 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7690 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7692 C Cartesian gradient
7696 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7698 vv(1)=pizda(1,1)-pizda(2,2)
7699 vv(2)=pizda(1,2)+pizda(2,1)
7700 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7701 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7702 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7707 C Contribution from graph IV
7709 call transpose2(EE(1,1,itj),auxmat(1,1))
7710 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7711 vv(1)=pizda(1,1)+pizda(2,2)
7712 vv(2)=pizda(2,1)-pizda(1,2)
7713 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7714 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7715 C Explicit gradient in virtual-dihedral angles.
7716 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7717 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7718 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7719 vv(1)=pizda(1,1)+pizda(2,2)
7720 vv(2)=pizda(2,1)-pizda(1,2)
7721 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7722 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7723 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7724 C Cartesian gradient
7728 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7730 vv(1)=pizda(1,1)+pizda(2,2)
7731 vv(2)=pizda(2,1)-pizda(1,2)
7732 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7733 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7734 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7740 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7741 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7742 cd write (2,*) 'ijkl',i,j,k,l
7743 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7744 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7746 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7747 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7748 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7749 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7750 if (j.lt.nres-1) then
7757 if (l.lt.nres-1) then
7767 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7768 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7769 C summed up outside the subrouine as for the other subroutines
7770 C handling long-range interactions. The old code is commented out
7771 C with "cgrad" to keep track of changes.
7773 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7774 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7775 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7776 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7777 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7778 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7779 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7780 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7781 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7782 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7784 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7785 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7786 cgrad ghalf=0.5d0*ggg1(ll)
7788 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7789 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7790 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7791 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7792 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7793 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7794 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7795 cgrad ghalf=0.5d0*ggg2(ll)
7797 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7798 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7799 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7800 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7801 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7802 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7807 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7808 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7813 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7814 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7820 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7825 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7829 cd write (2,*) iii,g_corr5_loc(iii)
7832 cd write (2,*) 'ekont',ekont
7833 cd write (iout,*) 'eello5',ekont*eel5
7836 c--------------------------------------------------------------------------
7837 double precision function eello6(i,j,k,l,jj,kk)
7838 implicit real*8 (a-h,o-z)
7839 include 'DIMENSIONS'
7840 include 'COMMON.IOUNITS'
7841 include 'COMMON.CHAIN'
7842 include 'COMMON.DERIV'
7843 include 'COMMON.INTERACT'
7844 include 'COMMON.CONTACTS'
7845 include 'COMMON.TORSION'
7846 include 'COMMON.VAR'
7847 include 'COMMON.GEO'
7848 include 'COMMON.FFIELD'
7849 double precision ggg1(3),ggg2(3)
7850 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7855 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7863 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7864 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7868 derx(lll,kkk,iii)=0.0d0
7872 cd eij=facont_hb(jj,i)
7873 cd ekl=facont_hb(kk,k)
7879 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7880 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7881 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7882 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7883 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7884 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7886 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7887 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7888 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7889 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7890 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7891 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7895 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7897 C If turn contributions are considered, they will be handled separately.
7898 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7899 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7900 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7901 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7902 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7903 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7904 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7906 if (j.lt.nres-1) then
7913 if (l.lt.nres-1) then
7921 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7922 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7923 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7924 cgrad ghalf=0.5d0*ggg1(ll)
7926 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7927 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7928 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7929 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7930 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7931 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7932 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7933 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7934 cgrad ghalf=0.5d0*ggg2(ll)
7935 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7937 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7938 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7939 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7940 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7941 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7942 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7947 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7948 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7953 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7954 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7960 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7965 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7969 cd write (2,*) iii,g_corr6_loc(iii)
7972 cd write (2,*) 'ekont',ekont
7973 cd write (iout,*) 'eello6',ekont*eel6
7976 c--------------------------------------------------------------------------
7977 double precision function eello6_graph1(i,j,k,l,imat,swap)
7978 implicit real*8 (a-h,o-z)
7979 include 'DIMENSIONS'
7980 include 'COMMON.IOUNITS'
7981 include 'COMMON.CHAIN'
7982 include 'COMMON.DERIV'
7983 include 'COMMON.INTERACT'
7984 include 'COMMON.CONTACTS'
7985 include 'COMMON.TORSION'
7986 include 'COMMON.VAR'
7987 include 'COMMON.GEO'
7988 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7992 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7994 C Parallel Antiparallel
8000 C \ j|/k\| / \ |/k\|l /
8005 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8006 itk=itortyp(itype(k))
8007 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8008 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8009 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8010 call transpose2(EUgC(1,1,k),auxmat(1,1))
8011 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8012 vv1(1)=pizda1(1,1)-pizda1(2,2)
8013 vv1(2)=pizda1(1,2)+pizda1(2,1)
8014 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8015 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8016 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8017 s5=scalar2(vv(1),Dtobr2(1,i))
8018 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8019 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8020 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8021 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8022 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8023 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8024 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8025 & +scalar2(vv(1),Dtobr2der(1,i)))
8026 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8027 vv1(1)=pizda1(1,1)-pizda1(2,2)
8028 vv1(2)=pizda1(1,2)+pizda1(2,1)
8029 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8030 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8032 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8033 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8034 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8035 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8036 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8038 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8039 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8040 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8041 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8042 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8044 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8045 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8046 vv1(1)=pizda1(1,1)-pizda1(2,2)
8047 vv1(2)=pizda1(1,2)+pizda1(2,1)
8048 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8049 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8050 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8051 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8060 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8061 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8062 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8063 call transpose2(EUgC(1,1,k),auxmat(1,1))
8064 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8066 vv1(1)=pizda1(1,1)-pizda1(2,2)
8067 vv1(2)=pizda1(1,2)+pizda1(2,1)
8068 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8069 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8070 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8071 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8072 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8073 s5=scalar2(vv(1),Dtobr2(1,i))
8074 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8080 c----------------------------------------------------------------------------
8081 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8082 implicit real*8 (a-h,o-z)
8083 include 'DIMENSIONS'
8084 include 'COMMON.IOUNITS'
8085 include 'COMMON.CHAIN'
8086 include 'COMMON.DERIV'
8087 include 'COMMON.INTERACT'
8088 include 'COMMON.CONTACTS'
8089 include 'COMMON.TORSION'
8090 include 'COMMON.VAR'
8091 include 'COMMON.GEO'
8093 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8094 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8097 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8099 C Parallel Antiparallel
8110 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8111 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8112 C AL 7/4/01 s1 would occur in the sixth-order moment,
8113 C but not in a cluster cumulant
8115 s1=dip(1,jj,i)*dip(1,kk,k)
8117 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8118 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8119 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8120 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8121 call transpose2(EUg(1,1,k),auxmat(1,1))
8122 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8123 vv(1)=pizda(1,1)-pizda(2,2)
8124 vv(2)=pizda(1,2)+pizda(2,1)
8125 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8126 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8128 eello6_graph2=-(s1+s2+s3+s4)
8130 eello6_graph2=-(s2+s3+s4)
8133 C Derivatives in gamma(i-1)
8136 s1=dipderg(1,jj,i)*dip(1,kk,k)
8138 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8139 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8140 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8141 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8143 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8145 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8147 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8149 C Derivatives in gamma(k-1)
8151 s1=dip(1,jj,i)*dipderg(1,kk,k)
8153 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8154 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8155 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8156 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8157 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8158 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8159 vv(1)=pizda(1,1)-pizda(2,2)
8160 vv(2)=pizda(1,2)+pizda(2,1)
8161 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8163 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8165 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8167 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8168 C Derivatives in gamma(j-1) or gamma(l-1)
8171 s1=dipderg(3,jj,i)*dip(1,kk,k)
8173 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8174 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8175 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8176 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8177 vv(1)=pizda(1,1)-pizda(2,2)
8178 vv(2)=pizda(1,2)+pizda(2,1)
8179 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8182 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8184 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8187 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8188 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8190 C Derivatives in gamma(l-1) or gamma(j-1)
8193 s1=dip(1,jj,i)*dipderg(3,kk,k)
8195 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8196 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8197 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8198 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8199 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8200 vv(1)=pizda(1,1)-pizda(2,2)
8201 vv(2)=pizda(1,2)+pizda(2,1)
8202 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8205 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8207 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8210 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8211 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8213 C Cartesian derivatives.
8215 write (2,*) 'In eello6_graph2'
8217 write (2,*) 'iii=',iii
8219 write (2,*) 'kkk=',kkk
8221 write (2,'(3(2f10.5),5x)')
8222 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8232 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8234 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8237 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8239 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8240 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8242 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8243 call transpose2(EUg(1,1,k),auxmat(1,1))
8244 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8246 vv(1)=pizda(1,1)-pizda(2,2)
8247 vv(2)=pizda(1,2)+pizda(2,1)
8248 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8249 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8251 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8253 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8256 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8258 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8265 c----------------------------------------------------------------------------
8266 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8267 implicit real*8 (a-h,o-z)
8268 include 'DIMENSIONS'
8269 include 'COMMON.IOUNITS'
8270 include 'COMMON.CHAIN'
8271 include 'COMMON.DERIV'
8272 include 'COMMON.INTERACT'
8273 include 'COMMON.CONTACTS'
8274 include 'COMMON.TORSION'
8275 include 'COMMON.VAR'
8276 include 'COMMON.GEO'
8277 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8279 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8281 C Parallel Antiparallel
8292 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8294 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8295 C energy moment and not to the cluster cumulant.
8296 iti=itortyp(itype(i))
8297 if (j.lt.nres-1) then
8298 itj1=itortyp(itype(j+1))
8302 itk=itortyp(itype(k))
8303 itk1=itortyp(itype(k+1))
8304 if (l.lt.nres-1) then
8305 itl1=itortyp(itype(l+1))
8310 s1=dip(4,jj,i)*dip(4,kk,k)
8312 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8313 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8314 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8315 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8316 call transpose2(EE(1,1,itk),auxmat(1,1))
8317 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8318 vv(1)=pizda(1,1)+pizda(2,2)
8319 vv(2)=pizda(2,1)-pizda(1,2)
8320 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8321 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8322 cd & "sum",-(s2+s3+s4)
8324 eello6_graph3=-(s1+s2+s3+s4)
8326 eello6_graph3=-(s2+s3+s4)
8329 C Derivatives in gamma(k-1)
8330 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8331 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8332 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8333 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8334 C Derivatives in gamma(l-1)
8335 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8336 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8337 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8338 vv(1)=pizda(1,1)+pizda(2,2)
8339 vv(2)=pizda(2,1)-pizda(1,2)
8340 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8341 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8342 C Cartesian derivatives.
8348 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8350 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8353 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8355 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8356 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8358 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8359 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8361 vv(1)=pizda(1,1)+pizda(2,2)
8362 vv(2)=pizda(2,1)-pizda(1,2)
8363 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8367 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8370 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8374 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8380 c----------------------------------------------------------------------------
8381 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8382 implicit real*8 (a-h,o-z)
8383 include 'DIMENSIONS'
8384 include 'COMMON.IOUNITS'
8385 include 'COMMON.CHAIN'
8386 include 'COMMON.DERIV'
8387 include 'COMMON.INTERACT'
8388 include 'COMMON.CONTACTS'
8389 include 'COMMON.TORSION'
8390 include 'COMMON.VAR'
8391 include 'COMMON.GEO'
8392 include 'COMMON.FFIELD'
8393 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8394 & auxvec1(2),auxmat1(2,2)
8396 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8398 C Parallel Antiparallel
8409 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8411 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8412 C energy moment and not to the cluster cumulant.
8413 cd write (2,*) 'eello_graph4: wturn6',wturn6
8414 iti=itortyp(itype(i))
8415 itj=itortyp(itype(j))
8416 if (j.lt.nres-1) then
8417 itj1=itortyp(itype(j+1))
8421 itk=itortyp(itype(k))
8422 if (k.lt.nres-1) then
8423 itk1=itortyp(itype(k+1))
8427 itl=itortyp(itype(l))
8428 if (l.lt.nres-1) then
8429 itl1=itortyp(itype(l+1))
8433 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8434 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8435 cd & ' itl',itl,' itl1',itl1
8438 s1=dip(3,jj,i)*dip(3,kk,k)
8440 s1=dip(2,jj,j)*dip(2,kk,l)
8443 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8444 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8446 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8447 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8449 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8450 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8452 call transpose2(EUg(1,1,k),auxmat(1,1))
8453 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8454 vv(1)=pizda(1,1)-pizda(2,2)
8455 vv(2)=pizda(2,1)+pizda(1,2)
8456 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8457 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8459 eello6_graph4=-(s1+s2+s3+s4)
8461 eello6_graph4=-(s2+s3+s4)
8463 C Derivatives in gamma(i-1)
8467 s1=dipderg(2,jj,i)*dip(3,kk,k)
8469 s1=dipderg(4,jj,j)*dip(2,kk,l)
8472 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8474 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8475 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8477 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8478 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8480 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8481 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8482 cd write (2,*) 'turn6 derivatives'
8484 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8486 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8490 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8492 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8496 C Derivatives in gamma(k-1)
8499 s1=dip(3,jj,i)*dipderg(2,kk,k)
8501 s1=dip(2,jj,j)*dipderg(4,kk,l)
8504 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8505 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8507 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8508 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8510 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8511 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8513 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8514 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8515 vv(1)=pizda(1,1)-pizda(2,2)
8516 vv(2)=pizda(2,1)+pizda(1,2)
8517 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8518 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8520 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8522 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8526 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8528 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8531 C Derivatives in gamma(j-1) or gamma(l-1)
8532 if (l.eq.j+1 .and. l.gt.1) then
8533 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8534 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8535 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8536 vv(1)=pizda(1,1)-pizda(2,2)
8537 vv(2)=pizda(2,1)+pizda(1,2)
8538 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8539 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8540 else if (j.gt.1) then
8541 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8542 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8543 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8544 vv(1)=pizda(1,1)-pizda(2,2)
8545 vv(2)=pizda(2,1)+pizda(1,2)
8546 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8547 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8548 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8550 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8553 C Cartesian derivatives.
8560 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8562 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8566 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8568 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8572 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8574 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8576 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8577 & b1(1,itj1),auxvec(1))
8578 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8580 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8581 & b1(1,itl1),auxvec(1))
8582 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8584 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8586 vv(1)=pizda(1,1)-pizda(2,2)
8587 vv(2)=pizda(2,1)+pizda(1,2)
8588 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8590 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8592 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8595 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8598 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8601 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8603 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8605 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8609 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8611 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8616 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8624 c----------------------------------------------------------------------------
8625 double precision function eello_turn6(i,jj,kk)
8626 implicit real*8 (a-h,o-z)
8627 include 'DIMENSIONS'
8628 include 'COMMON.IOUNITS'
8629 include 'COMMON.CHAIN'
8630 include 'COMMON.DERIV'
8631 include 'COMMON.INTERACT'
8632 include 'COMMON.CONTACTS'
8633 include 'COMMON.TORSION'
8634 include 'COMMON.VAR'
8635 include 'COMMON.GEO'
8636 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8637 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8639 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8640 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8641 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8642 C the respective energy moment and not to the cluster cumulant.
8651 iti=itortyp(itype(i))
8652 itk=itortyp(itype(k))
8653 itk1=itortyp(itype(k+1))
8654 itl=itortyp(itype(l))
8655 itj=itortyp(itype(j))
8656 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8657 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8658 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8663 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8665 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8669 derx_turn(lll,kkk,iii)=0.0d0
8676 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8678 cd write (2,*) 'eello6_5',eello6_5
8680 call transpose2(AEA(1,1,1),auxmat(1,1))
8681 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8682 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8683 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8685 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8686 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8687 s2 = scalar2(b1(1,itk),vtemp1(1))
8689 call transpose2(AEA(1,1,2),atemp(1,1))
8690 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8691 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8692 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8694 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8695 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8696 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8698 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8699 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8700 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8701 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8702 ss13 = scalar2(b1(1,itk),vtemp4(1))
8703 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8705 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8711 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8712 C Derivatives in gamma(i+2)
8716 call transpose2(AEA(1,1,1),auxmatd(1,1))
8717 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8718 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8719 call transpose2(AEAderg(1,1,2),atempd(1,1))
8720 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8721 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8723 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8724 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8725 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8731 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8732 C Derivatives in gamma(i+3)
8734 call transpose2(AEA(1,1,1),auxmatd(1,1))
8735 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8736 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8737 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8739 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8740 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8741 s2d = scalar2(b1(1,itk),vtemp1d(1))
8743 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8744 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8746 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8748 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8749 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8750 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8758 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8759 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8761 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8762 & -0.5d0*ekont*(s2d+s12d)
8764 C Derivatives in gamma(i+4)
8765 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8766 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8767 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8769 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8770 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8771 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8779 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8781 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8783 C Derivatives in gamma(i+5)
8785 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8786 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8787 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8789 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8790 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8791 s2d = scalar2(b1(1,itk),vtemp1d(1))
8793 call transpose2(AEA(1,1,2),atempd(1,1))
8794 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8795 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8797 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8798 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8800 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8801 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8802 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8810 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8811 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8813 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8814 & -0.5d0*ekont*(s2d+s12d)
8816 C Cartesian derivatives
8821 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8822 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8823 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8825 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8826 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8828 s2d = scalar2(b1(1,itk),vtemp1d(1))
8830 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8831 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8832 s8d = -(atempd(1,1)+atempd(2,2))*
8833 & scalar2(cc(1,1,itl),vtemp2(1))
8835 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8837 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8838 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8845 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8848 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8852 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8853 & - 0.5d0*(s8d+s12d)
8855 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8864 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8866 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8867 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8868 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8869 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8870 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8872 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8873 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8874 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8878 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8879 cd & 16*eel_turn6_num
8881 if (j.lt.nres-1) then
8888 if (l.lt.nres-1) then
8896 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8897 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8898 cgrad ghalf=0.5d0*ggg1(ll)
8900 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8901 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8902 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8903 & +ekont*derx_turn(ll,2,1)
8904 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8905 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8906 & +ekont*derx_turn(ll,4,1)
8907 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8908 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8909 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8910 cgrad ghalf=0.5d0*ggg2(ll)
8912 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8913 & +ekont*derx_turn(ll,2,2)
8914 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8915 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8916 & +ekont*derx_turn(ll,4,2)
8917 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8918 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8919 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8924 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8929 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8935 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8940 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8944 cd write (2,*) iii,g_corr6_loc(iii)
8946 eello_turn6=ekont*eel_turn6
8947 cd write (2,*) 'ekont',ekont
8948 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8952 C-----------------------------------------------------------------------------
8953 double precision function scalar(u,v)
8954 !DIR$ INLINEALWAYS scalar
8956 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8959 double precision u(3),v(3)
8960 cd double precision sc
8968 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8971 crc-------------------------------------------------
8972 SUBROUTINE MATVEC2(A1,V1,V2)
8973 !DIR$ INLINEALWAYS MATVEC2
8975 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8977 implicit real*8 (a-h,o-z)
8978 include 'DIMENSIONS'
8979 DIMENSION A1(2,2),V1(2),V2(2)
8983 c 3 VI=VI+A1(I,K)*V1(K)
8987 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8988 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8993 C---------------------------------------
8994 SUBROUTINE MATMAT2(A1,A2,A3)
8996 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8998 implicit real*8 (a-h,o-z)
8999 include 'DIMENSIONS'
9000 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9001 c DIMENSION AI3(2,2)
9005 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9011 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9012 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9013 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9014 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9022 c-------------------------------------------------------------------------
9023 double precision function scalar2(u,v)
9024 !DIR$ INLINEALWAYS scalar2
9026 double precision u(2),v(2)
9029 scalar2=u(1)*v(1)+u(2)*v(2)
9033 C-----------------------------------------------------------------------------
9035 subroutine transpose2(a,at)
9036 !DIR$ INLINEALWAYS transpose2
9038 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9041 double precision a(2,2),at(2,2)
9048 c--------------------------------------------------------------------------
9049 subroutine transpose(n,a,at)
9052 double precision a(n,n),at(n,n)
9060 C---------------------------------------------------------------------------
9061 subroutine prodmat3(a1,a2,kk,transp,prod)
9062 !DIR$ INLINEALWAYS prodmat3
9064 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9068 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9070 crc double precision auxmat(2,2),prod_(2,2)
9073 crc call transpose2(kk(1,1),auxmat(1,1))
9074 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9075 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9077 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9078 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9079 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9080 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9081 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9082 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9083 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9084 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9087 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9088 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9090 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9091 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9092 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9093 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9094 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9095 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9096 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9097 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9100 c call transpose2(a2(1,1),a2t(1,1))
9103 crc print *,((prod_(i,j),i=1,2),j=1,2)
9104 crc print *,((prod(i,j),i=1,2),j=1,2)