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 do j=1,ntermd_1(itori,itori1,itori2)
5805 v1cij=v1c(1,j,itori,itori1,itori2)
5806 v1sij=v1s(1,j,itori,itori1,itori2)
5807 v2cij=v1c(2,j,itori,itori1,itori2)
5808 v2sij=v1s(2,j,itori,itori1,itori2)
5809 cosphi1=dcos(j*phii)
5810 sinphi1=dsin(j*phii)
5811 cosphi2=dcos(j*phii1)
5812 sinphi2=dsin(j*phii1)
5813 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5814 & v2cij*cosphi2+v2sij*sinphi2
5815 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5816 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5818 do k=2,ntermd_2(itori,itori1,itori2)
5820 v1cdij = v2c(k,l,itori,itori1,itori2)
5821 v2cdij = v2c(l,k,itori,itori1,itori2)
5822 v1sdij = v2s(k,l,itori,itori1,itori2)
5823 v2sdij = v2s(l,k,itori,itori1,itori2)
5824 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5825 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5826 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5827 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5828 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5829 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5830 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5831 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5832 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5833 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5836 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5837 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5842 c------------------------------------------------------------------------------
5843 subroutine eback_sc_corr(esccor)
5844 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5845 c conformational states; temporarily implemented as differences
5846 c between UNRES torsional potentials (dependent on three types of
5847 c residues) and the torsional potentials dependent on all 20 types
5848 c of residues computed from AM1 energy surfaces of terminally-blocked
5849 c amino-acid residues.
5850 implicit real*8 (a-h,o-z)
5851 include 'DIMENSIONS'
5852 include 'COMMON.VAR'
5853 include 'COMMON.GEO'
5854 include 'COMMON.LOCAL'
5855 include 'COMMON.TORSION'
5856 include 'COMMON.SCCOR'
5857 include 'COMMON.INTERACT'
5858 include 'COMMON.DERIV'
5859 include 'COMMON.CHAIN'
5860 include 'COMMON.NAMES'
5861 include 'COMMON.IOUNITS'
5862 include 'COMMON.FFIELD'
5863 include 'COMMON.CONTROL'
5865 C Set lprn=.true. for debugging
5868 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5870 do i=iphi_start-1,iphi_end+1
5872 isccori=isccortyp(itype(i-2))
5873 isccori1=isccortyp(itype(i-1))
5875 cccc Added 9 May 2012
5876 cc Tauangle is torsional engle depending on the value of first digit
5877 c(see comment below)
5878 cc Omicron is flat angle depending on the value of first digit
5879 c(see comment below)
5883 cc Added 09 May 2012 (Adasko)
5884 cc Intertyp means interaction type of backbone mainchain correlation:
5885 c 1 = SC...Ca...Ca...Ca
5886 c 2 = Ca...Ca...Ca...SC
5887 c 3 = SC...Ca...Ca...SC
5888 if (((intertyp.eq.3).and.(itype(i-2).eq.10).or.
5889 & (itype(i-1).eq.10))
5890 & .or. ((intertyp.eq.1).and.(itype(i-2).ne.10))
5891 & .or. ((intertyp.eq.2).and.(itype(i-1).ne.10))) cycle
5892 if ((intertyp.eq.2).and.(i.eq.iphi_start-1)) cycle
5893 if ((intertyp.eq.1).and.(i.eq.iphi_end+1)) cycle
5894 do j=1,nterm_sccor(isccori,isccori1)
5895 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5896 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5897 cosphi=dcos(j*tauangle(intertyp,i))
5898 sinphi=dsin(j*tauangle(intertyp,i))
5899 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5900 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5902 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wtor*gloci
5904 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5905 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5906 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5907 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5908 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5913 c----------------------------------------------------------------------------
5914 subroutine multibody(ecorr)
5915 C This subroutine calculates multi-body contributions to energy following
5916 C the idea of Skolnick et al. If side chains I and J make a contact and
5917 C at the same time side chains I+1 and J+1 make a contact, an extra
5918 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5919 implicit real*8 (a-h,o-z)
5920 include 'DIMENSIONS'
5921 include 'COMMON.IOUNITS'
5922 include 'COMMON.DERIV'
5923 include 'COMMON.INTERACT'
5924 include 'COMMON.CONTACTS'
5925 double precision gx(3),gx1(3)
5928 C Set lprn=.true. for debugging
5932 write (iout,'(a)') 'Contact function values:'
5934 write (iout,'(i2,20(1x,i2,f10.5))')
5935 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5950 num_conti=num_cont(i)
5951 num_conti1=num_cont(i1)
5956 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5957 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5958 cd & ' ishift=',ishift
5959 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5960 C The system gains extra energy.
5961 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5962 endif ! j1==j+-ishift
5971 c------------------------------------------------------------------------------
5972 double precision function esccorr(i,j,k,l,jj,kk)
5973 implicit real*8 (a-h,o-z)
5974 include 'DIMENSIONS'
5975 include 'COMMON.IOUNITS'
5976 include 'COMMON.DERIV'
5977 include 'COMMON.INTERACT'
5978 include 'COMMON.CONTACTS'
5979 double precision gx(3),gx1(3)
5984 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5985 C Calculate the multi-body contribution to energy.
5986 C Calculate multi-body contributions to the gradient.
5987 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5988 cd & k,l,(gacont(m,kk,k),m=1,3)
5990 gx(m) =ekl*gacont(m,jj,i)
5991 gx1(m)=eij*gacont(m,kk,k)
5992 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5993 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5994 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5995 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5999 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6004 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6010 c------------------------------------------------------------------------------
6011 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6012 C This subroutine calculates multi-body contributions to hydrogen-bonding
6013 implicit real*8 (a-h,o-z)
6014 include 'DIMENSIONS'
6015 include 'COMMON.IOUNITS'
6018 parameter (max_cont=maxconts)
6019 parameter (max_dim=26)
6020 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6021 double precision zapas(max_dim,maxconts,max_fg_procs),
6022 & zapas_recv(max_dim,maxconts,max_fg_procs)
6023 common /przechowalnia/ zapas
6024 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6025 & status_array(MPI_STATUS_SIZE,maxconts*2)
6027 include 'COMMON.SETUP'
6028 include 'COMMON.FFIELD'
6029 include 'COMMON.DERIV'
6030 include 'COMMON.INTERACT'
6031 include 'COMMON.CONTACTS'
6032 include 'COMMON.CONTROL'
6033 include 'COMMON.LOCAL'
6034 double precision gx(3),gx1(3),time00
6037 C Set lprn=.true. for debugging
6042 if (nfgtasks.le.1) goto 30
6044 write (iout,'(a)') 'Contact function values before RECEIVE:'
6046 write (iout,'(2i3,50(1x,i2,f5.2))')
6047 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6048 & j=1,num_cont_hb(i))
6052 do i=1,ntask_cont_from
6055 do i=1,ntask_cont_to
6058 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6060 C Make the list of contacts to send to send to other procesors
6061 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6063 do i=iturn3_start,iturn3_end
6064 c write (iout,*) "make contact list turn3",i," num_cont",
6066 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6068 do i=iturn4_start,iturn4_end
6069 c write (iout,*) "make contact list turn4",i," num_cont",
6071 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6075 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6077 do j=1,num_cont_hb(i)
6080 iproc=iint_sent_local(k,jjc,ii)
6081 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6082 if (iproc.gt.0) then
6083 ncont_sent(iproc)=ncont_sent(iproc)+1
6084 nn=ncont_sent(iproc)
6086 zapas(2,nn,iproc)=jjc
6087 zapas(3,nn,iproc)=facont_hb(j,i)
6088 zapas(4,nn,iproc)=ees0p(j,i)
6089 zapas(5,nn,iproc)=ees0m(j,i)
6090 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6091 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6092 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6093 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6094 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6095 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6096 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6097 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6098 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6099 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6100 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6101 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6102 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6103 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6104 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6105 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6106 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6107 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6108 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6109 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6110 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6117 & "Numbers of contacts to be sent to other processors",
6118 & (ncont_sent(i),i=1,ntask_cont_to)
6119 write (iout,*) "Contacts sent"
6120 do ii=1,ntask_cont_to
6122 iproc=itask_cont_to(ii)
6123 write (iout,*) nn," contacts to processor",iproc,
6124 & " of CONT_TO_COMM group"
6126 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6134 CorrelID1=nfgtasks+fg_rank+1
6136 C Receive the numbers of needed contacts from other processors
6137 do ii=1,ntask_cont_from
6138 iproc=itask_cont_from(ii)
6140 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6141 & FG_COMM,req(ireq),IERR)
6143 c write (iout,*) "IRECV ended"
6145 C Send the number of contacts needed by other processors
6146 do ii=1,ntask_cont_to
6147 iproc=itask_cont_to(ii)
6149 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6150 & FG_COMM,req(ireq),IERR)
6152 c write (iout,*) "ISEND ended"
6153 c write (iout,*) "number of requests (nn)",ireq
6156 & call MPI_Waitall(ireq,req,status_array,ierr)
6158 c & "Numbers of contacts to be received from other processors",
6159 c & (ncont_recv(i),i=1,ntask_cont_from)
6163 do ii=1,ntask_cont_from
6164 iproc=itask_cont_from(ii)
6166 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6167 c & " of CONT_TO_COMM group"
6171 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6172 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6173 c write (iout,*) "ireq,req",ireq,req(ireq)
6176 C Send the contacts to processors that need them
6177 do ii=1,ntask_cont_to
6178 iproc=itask_cont_to(ii)
6180 c write (iout,*) nn," contacts to processor",iproc,
6181 c & " of CONT_TO_COMM group"
6184 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6185 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6186 c write (iout,*) "ireq,req",ireq,req(ireq)
6188 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6192 c write (iout,*) "number of requests (contacts)",ireq
6193 c write (iout,*) "req",(req(i),i=1,4)
6196 & call MPI_Waitall(ireq,req,status_array,ierr)
6197 do iii=1,ntask_cont_from
6198 iproc=itask_cont_from(iii)
6201 write (iout,*) "Received",nn," contacts from processor",iproc,
6202 & " of CONT_FROM_COMM group"
6205 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6210 ii=zapas_recv(1,i,iii)
6211 c Flag the received contacts to prevent double-counting
6212 jj=-zapas_recv(2,i,iii)
6213 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6215 nnn=num_cont_hb(ii)+1
6218 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6219 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6220 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6221 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6222 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6223 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6224 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6225 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6226 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6227 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6228 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6229 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6230 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6231 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6232 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6233 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6234 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6235 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6236 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6237 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6238 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6239 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6240 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6241 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6246 write (iout,'(a)') 'Contact function values after receive:'
6248 write (iout,'(2i3,50(1x,i3,f5.2))')
6249 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6250 & j=1,num_cont_hb(i))
6257 write (iout,'(a)') 'Contact function values:'
6259 write (iout,'(2i3,50(1x,i3,f5.2))')
6260 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6261 & j=1,num_cont_hb(i))
6265 C Remove the loop below after debugging !!!
6272 C Calculate the local-electrostatic correlation terms
6273 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6275 num_conti=num_cont_hb(i)
6276 num_conti1=num_cont_hb(i+1)
6283 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6284 c & ' jj=',jj,' kk=',kk
6285 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6286 & .or. j.lt.0 .and. j1.gt.0) .and.
6287 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6288 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6289 C The system gains extra energy.
6290 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6291 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6292 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6294 else if (j1.eq.j) then
6295 C Contacts I-J and I-(J+1) occur simultaneously.
6296 C The system loses extra energy.
6297 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6302 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6303 c & ' jj=',jj,' kk=',kk
6305 C Contacts I-J and (I+1)-J occur simultaneously.
6306 C The system loses extra energy.
6307 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6314 c------------------------------------------------------------------------------
6315 subroutine add_hb_contact(ii,jj,itask)
6316 implicit real*8 (a-h,o-z)
6317 include "DIMENSIONS"
6318 include "COMMON.IOUNITS"
6321 parameter (max_cont=maxconts)
6322 parameter (max_dim=26)
6323 include "COMMON.CONTACTS"
6324 double precision zapas(max_dim,maxconts,max_fg_procs),
6325 & zapas_recv(max_dim,maxconts,max_fg_procs)
6326 common /przechowalnia/ zapas
6327 integer i,j,ii,jj,iproc,itask(4),nn
6328 c write (iout,*) "itask",itask
6331 if (iproc.gt.0) then
6332 do j=1,num_cont_hb(ii)
6334 c write (iout,*) "i",ii," j",jj," jjc",jjc
6336 ncont_sent(iproc)=ncont_sent(iproc)+1
6337 nn=ncont_sent(iproc)
6338 zapas(1,nn,iproc)=ii
6339 zapas(2,nn,iproc)=jjc
6340 zapas(3,nn,iproc)=facont_hb(j,ii)
6341 zapas(4,nn,iproc)=ees0p(j,ii)
6342 zapas(5,nn,iproc)=ees0m(j,ii)
6343 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6344 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6345 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6346 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6347 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6348 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6349 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6350 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6351 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6352 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6353 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6354 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6355 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6356 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6357 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6358 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6359 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6360 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6361 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6362 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6363 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6371 c------------------------------------------------------------------------------
6372 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6374 C This subroutine calculates multi-body contributions to hydrogen-bonding
6375 implicit real*8 (a-h,o-z)
6376 include 'DIMENSIONS'
6377 include 'COMMON.IOUNITS'
6380 parameter (max_cont=maxconts)
6381 parameter (max_dim=70)
6382 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6383 double precision zapas(max_dim,maxconts,max_fg_procs),
6384 & zapas_recv(max_dim,maxconts,max_fg_procs)
6385 common /przechowalnia/ zapas
6386 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6387 & status_array(MPI_STATUS_SIZE,maxconts*2)
6389 include 'COMMON.SETUP'
6390 include 'COMMON.FFIELD'
6391 include 'COMMON.DERIV'
6392 include 'COMMON.LOCAL'
6393 include 'COMMON.INTERACT'
6394 include 'COMMON.CONTACTS'
6395 include 'COMMON.CHAIN'
6396 include 'COMMON.CONTROL'
6397 double precision gx(3),gx1(3)
6398 integer num_cont_hb_old(maxres)
6400 double precision eello4,eello5,eelo6,eello_turn6
6401 external eello4,eello5,eello6,eello_turn6
6402 C Set lprn=.true. for debugging
6407 num_cont_hb_old(i)=num_cont_hb(i)
6411 if (nfgtasks.le.1) goto 30
6413 write (iout,'(a)') 'Contact function values before RECEIVE:'
6415 write (iout,'(2i3,50(1x,i2,f5.2))')
6416 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6417 & j=1,num_cont_hb(i))
6421 do i=1,ntask_cont_from
6424 do i=1,ntask_cont_to
6427 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6429 C Make the list of contacts to send to send to other procesors
6430 do i=iturn3_start,iturn3_end
6431 c write (iout,*) "make contact list turn3",i," num_cont",
6433 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6435 do i=iturn4_start,iturn4_end
6436 c write (iout,*) "make contact list turn4",i," num_cont",
6438 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6442 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6444 do j=1,num_cont_hb(i)
6447 iproc=iint_sent_local(k,jjc,ii)
6448 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6449 if (iproc.ne.0) then
6450 ncont_sent(iproc)=ncont_sent(iproc)+1
6451 nn=ncont_sent(iproc)
6453 zapas(2,nn,iproc)=jjc
6454 zapas(3,nn,iproc)=d_cont(j,i)
6458 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6463 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6471 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6482 & "Numbers of contacts to be sent to other processors",
6483 & (ncont_sent(i),i=1,ntask_cont_to)
6484 write (iout,*) "Contacts sent"
6485 do ii=1,ntask_cont_to
6487 iproc=itask_cont_to(ii)
6488 write (iout,*) nn," contacts to processor",iproc,
6489 & " of CONT_TO_COMM group"
6491 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6499 CorrelID1=nfgtasks+fg_rank+1
6501 C Receive the numbers of needed contacts from other processors
6502 do ii=1,ntask_cont_from
6503 iproc=itask_cont_from(ii)
6505 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6506 & FG_COMM,req(ireq),IERR)
6508 c write (iout,*) "IRECV ended"
6510 C Send the number of contacts needed by other processors
6511 do ii=1,ntask_cont_to
6512 iproc=itask_cont_to(ii)
6514 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6515 & FG_COMM,req(ireq),IERR)
6517 c write (iout,*) "ISEND ended"
6518 c write (iout,*) "number of requests (nn)",ireq
6521 & call MPI_Waitall(ireq,req,status_array,ierr)
6523 c & "Numbers of contacts to be received from other processors",
6524 c & (ncont_recv(i),i=1,ntask_cont_from)
6528 do ii=1,ntask_cont_from
6529 iproc=itask_cont_from(ii)
6531 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6532 c & " of CONT_TO_COMM group"
6536 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6537 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6538 c write (iout,*) "ireq,req",ireq,req(ireq)
6541 C Send the contacts to processors that need them
6542 do ii=1,ntask_cont_to
6543 iproc=itask_cont_to(ii)
6545 c write (iout,*) nn," contacts to processor",iproc,
6546 c & " of CONT_TO_COMM group"
6549 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6550 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6551 c write (iout,*) "ireq,req",ireq,req(ireq)
6553 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6557 c write (iout,*) "number of requests (contacts)",ireq
6558 c write (iout,*) "req",(req(i),i=1,4)
6561 & call MPI_Waitall(ireq,req,status_array,ierr)
6562 do iii=1,ntask_cont_from
6563 iproc=itask_cont_from(iii)
6566 write (iout,*) "Received",nn," contacts from processor",iproc,
6567 & " of CONT_FROM_COMM group"
6570 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6575 ii=zapas_recv(1,i,iii)
6576 c Flag the received contacts to prevent double-counting
6577 jj=-zapas_recv(2,i,iii)
6578 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6580 nnn=num_cont_hb(ii)+1
6583 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6587 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6592 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6600 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6609 write (iout,'(a)') 'Contact function values after receive:'
6611 write (iout,'(2i3,50(1x,i3,5f6.3))')
6612 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6613 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6620 write (iout,'(a)') 'Contact function values:'
6622 write (iout,'(2i3,50(1x,i2,5f6.3))')
6623 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6624 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6630 C Remove the loop below after debugging !!!
6637 C Calculate the dipole-dipole interaction energies
6638 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6639 do i=iatel_s,iatel_e+1
6640 num_conti=num_cont_hb(i)
6649 C Calculate the local-electrostatic correlation terms
6650 c write (iout,*) "gradcorr5 in eello5 before loop"
6652 c write (iout,'(i5,3f10.5)')
6653 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6655 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6656 c write (iout,*) "corr loop i",i
6658 num_conti=num_cont_hb(i)
6659 num_conti1=num_cont_hb(i+1)
6666 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6667 c & ' jj=',jj,' kk=',kk
6668 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6669 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6670 & .or. j.lt.0 .and. j1.gt.0) .and.
6671 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6672 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6673 C The system gains extra energy.
6675 sqd1=dsqrt(d_cont(jj,i))
6676 sqd2=dsqrt(d_cont(kk,i1))
6677 sred_geom = sqd1*sqd2
6678 IF (sred_geom.lt.cutoff_corr) THEN
6679 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6681 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6682 cd & ' jj=',jj,' kk=',kk
6683 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6684 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6686 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6687 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6690 cd write (iout,*) 'sred_geom=',sred_geom,
6691 cd & ' ekont=',ekont,' fprim=',fprimcont,
6692 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6693 cd write (iout,*) "g_contij",g_contij
6694 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6695 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6696 call calc_eello(i,jp,i+1,jp1,jj,kk)
6697 if (wcorr4.gt.0.0d0)
6698 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6699 if (energy_dec.and.wcorr4.gt.0.0d0)
6700 1 write (iout,'(a6,4i5,0pf7.3)')
6701 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6702 c write (iout,*) "gradcorr5 before eello5"
6704 c write (iout,'(i5,3f10.5)')
6705 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6707 if (wcorr5.gt.0.0d0)
6708 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6709 c write (iout,*) "gradcorr5 after eello5"
6711 c write (iout,'(i5,3f10.5)')
6712 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6714 if (energy_dec.and.wcorr5.gt.0.0d0)
6715 1 write (iout,'(a6,4i5,0pf7.3)')
6716 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6717 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6718 cd write(2,*)'ijkl',i,jp,i+1,jp1
6719 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6720 & .or. wturn6.eq.0.0d0))then
6721 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6722 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6723 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6724 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6725 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6726 cd & 'ecorr6=',ecorr6
6727 cd write (iout,'(4e15.5)') sred_geom,
6728 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6729 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6730 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6731 else if (wturn6.gt.0.0d0
6732 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6733 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6734 eturn6=eturn6+eello_turn6(i,jj,kk)
6735 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6736 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6737 cd write (2,*) 'multibody_eello:eturn6',eturn6
6746 num_cont_hb(i)=num_cont_hb_old(i)
6748 c write (iout,*) "gradcorr5 in eello5"
6750 c write (iout,'(i5,3f10.5)')
6751 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6755 c------------------------------------------------------------------------------
6756 subroutine add_hb_contact_eello(ii,jj,itask)
6757 implicit real*8 (a-h,o-z)
6758 include "DIMENSIONS"
6759 include "COMMON.IOUNITS"
6762 parameter (max_cont=maxconts)
6763 parameter (max_dim=70)
6764 include "COMMON.CONTACTS"
6765 double precision zapas(max_dim,maxconts,max_fg_procs),
6766 & zapas_recv(max_dim,maxconts,max_fg_procs)
6767 common /przechowalnia/ zapas
6768 integer i,j,ii,jj,iproc,itask(4),nn
6769 c write (iout,*) "itask",itask
6772 if (iproc.gt.0) then
6773 do j=1,num_cont_hb(ii)
6775 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6777 ncont_sent(iproc)=ncont_sent(iproc)+1
6778 nn=ncont_sent(iproc)
6779 zapas(1,nn,iproc)=ii
6780 zapas(2,nn,iproc)=jjc
6781 zapas(3,nn,iproc)=d_cont(j,ii)
6785 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6790 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6798 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6810 c------------------------------------------------------------------------------
6811 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6812 implicit real*8 (a-h,o-z)
6813 include 'DIMENSIONS'
6814 include 'COMMON.IOUNITS'
6815 include 'COMMON.DERIV'
6816 include 'COMMON.INTERACT'
6817 include 'COMMON.CONTACTS'
6818 double precision gx(3),gx1(3)
6828 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6829 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6830 C Following 4 lines for diagnostics.
6835 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6836 c & 'Contacts ',i,j,
6837 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6838 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6840 C Calculate the multi-body contribution to energy.
6841 c ecorr=ecorr+ekont*ees
6842 C Calculate multi-body contributions to the gradient.
6843 coeffpees0pij=coeffp*ees0pij
6844 coeffmees0mij=coeffm*ees0mij
6845 coeffpees0pkl=coeffp*ees0pkl
6846 coeffmees0mkl=coeffm*ees0mkl
6848 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6849 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6850 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6851 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6852 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6853 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6854 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6855 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6856 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6857 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6858 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6859 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6860 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6861 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6862 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6863 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6864 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6865 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6866 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6867 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6868 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6869 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6870 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6871 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6872 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6877 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6878 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6879 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6880 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6885 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6886 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6887 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6888 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6891 c write (iout,*) "ehbcorr",ekont*ees
6896 C---------------------------------------------------------------------------
6897 subroutine dipole(i,j,jj)
6898 implicit real*8 (a-h,o-z)
6899 include 'DIMENSIONS'
6900 include 'COMMON.IOUNITS'
6901 include 'COMMON.CHAIN'
6902 include 'COMMON.FFIELD'
6903 include 'COMMON.DERIV'
6904 include 'COMMON.INTERACT'
6905 include 'COMMON.CONTACTS'
6906 include 'COMMON.TORSION'
6907 include 'COMMON.VAR'
6908 include 'COMMON.GEO'
6909 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6911 iti1 = itortyp(itype(i+1))
6912 if (j.lt.nres-1) then
6913 itj1 = itortyp(itype(j+1))
6918 dipi(iii,1)=Ub2(iii,i)
6919 dipderi(iii)=Ub2der(iii,i)
6920 dipi(iii,2)=b1(iii,iti1)
6921 dipj(iii,1)=Ub2(iii,j)
6922 dipderj(iii)=Ub2der(iii,j)
6923 dipj(iii,2)=b1(iii,itj1)
6927 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6930 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6937 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6941 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6946 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6947 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6949 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6951 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6953 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6958 C---------------------------------------------------------------------------
6959 subroutine calc_eello(i,j,k,l,jj,kk)
6961 C This subroutine computes matrices and vectors needed to calculate
6962 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6964 implicit real*8 (a-h,o-z)
6965 include 'DIMENSIONS'
6966 include 'COMMON.IOUNITS'
6967 include 'COMMON.CHAIN'
6968 include 'COMMON.DERIV'
6969 include 'COMMON.INTERACT'
6970 include 'COMMON.CONTACTS'
6971 include 'COMMON.TORSION'
6972 include 'COMMON.VAR'
6973 include 'COMMON.GEO'
6974 include 'COMMON.FFIELD'
6975 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6976 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6979 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6980 cd & ' jj=',jj,' kk=',kk
6981 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6982 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6983 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6986 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6987 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6990 call transpose2(aa1(1,1),aa1t(1,1))
6991 call transpose2(aa2(1,1),aa2t(1,1))
6994 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6995 & aa1tder(1,1,lll,kkk))
6996 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6997 & aa2tder(1,1,lll,kkk))
7001 C parallel orientation of the two CA-CA-CA frames.
7003 iti=itortyp(itype(i))
7007 itk1=itortyp(itype(k+1))
7008 itj=itortyp(itype(j))
7009 if (l.lt.nres-1) then
7010 itl1=itortyp(itype(l+1))
7014 C A1 kernel(j+1) A2T
7016 cd write (iout,'(3f10.5,5x,3f10.5)')
7017 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7019 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7020 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7021 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7022 C Following matrices are needed only for 6-th order cumulants
7023 IF (wcorr6.gt.0.0d0) THEN
7024 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7025 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7026 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7027 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7028 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7029 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7030 & ADtEAderx(1,1,1,1,1,1))
7032 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7033 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7034 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7035 & ADtEA1derx(1,1,1,1,1,1))
7037 C End 6-th order cumulants
7040 cd write (2,*) 'In calc_eello6'
7042 cd write (2,*) 'iii=',iii
7044 cd write (2,*) 'kkk=',kkk
7046 cd write (2,'(3(2f10.5),5x)')
7047 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7052 call transpose2(EUgder(1,1,k),auxmat(1,1))
7053 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7054 call transpose2(EUg(1,1,k),auxmat(1,1))
7055 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7056 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7060 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7061 & EAEAderx(1,1,lll,kkk,iii,1))
7065 C A1T kernel(i+1) A2
7066 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7067 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7068 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7069 C Following matrices are needed only for 6-th order cumulants
7070 IF (wcorr6.gt.0.0d0) THEN
7071 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7072 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7073 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7074 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7075 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7076 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7077 & ADtEAderx(1,1,1,1,1,2))
7078 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7079 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7080 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7081 & ADtEA1derx(1,1,1,1,1,2))
7083 C End 6-th order cumulants
7084 call transpose2(EUgder(1,1,l),auxmat(1,1))
7085 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7086 call transpose2(EUg(1,1,l),auxmat(1,1))
7087 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7088 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7092 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7093 & EAEAderx(1,1,lll,kkk,iii,2))
7098 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7099 C They are needed only when the fifth- or the sixth-order cumulants are
7101 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7102 call transpose2(AEA(1,1,1),auxmat(1,1))
7103 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7104 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7105 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7106 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7107 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7108 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7109 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7110 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7111 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7112 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7113 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7114 call transpose2(AEA(1,1,2),auxmat(1,1))
7115 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7116 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7117 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7118 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7119 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7120 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7121 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7122 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7123 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7124 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7125 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7126 C Calculate the Cartesian derivatives of the vectors.
7130 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7131 call matvec2(auxmat(1,1),b1(1,iti),
7132 & AEAb1derx(1,lll,kkk,iii,1,1))
7133 call matvec2(auxmat(1,1),Ub2(1,i),
7134 & AEAb2derx(1,lll,kkk,iii,1,1))
7135 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7136 & AEAb1derx(1,lll,kkk,iii,2,1))
7137 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7138 & AEAb2derx(1,lll,kkk,iii,2,1))
7139 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7140 call matvec2(auxmat(1,1),b1(1,itj),
7141 & AEAb1derx(1,lll,kkk,iii,1,2))
7142 call matvec2(auxmat(1,1),Ub2(1,j),
7143 & AEAb2derx(1,lll,kkk,iii,1,2))
7144 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7145 & AEAb1derx(1,lll,kkk,iii,2,2))
7146 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7147 & AEAb2derx(1,lll,kkk,iii,2,2))
7154 C Antiparallel orientation of the two CA-CA-CA frames.
7156 iti=itortyp(itype(i))
7160 itk1=itortyp(itype(k+1))
7161 itl=itortyp(itype(l))
7162 itj=itortyp(itype(j))
7163 if (j.lt.nres-1) then
7164 itj1=itortyp(itype(j+1))
7168 C A2 kernel(j-1)T A1T
7169 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7170 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7171 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7172 C Following matrices are needed only for 6-th order cumulants
7173 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7174 & j.eq.i+4 .and. l.eq.i+3)) THEN
7175 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7176 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7177 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7178 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7179 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7180 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7181 & ADtEAderx(1,1,1,1,1,1))
7182 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7183 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7184 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7185 & ADtEA1derx(1,1,1,1,1,1))
7187 C End 6-th order cumulants
7188 call transpose2(EUgder(1,1,k),auxmat(1,1))
7189 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7190 call transpose2(EUg(1,1,k),auxmat(1,1))
7191 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7192 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7196 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7197 & EAEAderx(1,1,lll,kkk,iii,1))
7201 C A2T kernel(i+1)T A1
7202 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7203 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7204 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7205 C Following matrices are needed only for 6-th order cumulants
7206 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7207 & j.eq.i+4 .and. l.eq.i+3)) THEN
7208 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7209 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7210 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7211 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7212 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7213 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7214 & ADtEAderx(1,1,1,1,1,2))
7215 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7216 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7217 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7218 & ADtEA1derx(1,1,1,1,1,2))
7220 C End 6-th order cumulants
7221 call transpose2(EUgder(1,1,j),auxmat(1,1))
7222 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7223 call transpose2(EUg(1,1,j),auxmat(1,1))
7224 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7225 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7229 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7230 & EAEAderx(1,1,lll,kkk,iii,2))
7235 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7236 C They are needed only when the fifth- or the sixth-order cumulants are
7238 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7239 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7240 call transpose2(AEA(1,1,1),auxmat(1,1))
7241 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7242 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7243 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7244 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7245 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7246 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7247 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7248 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7249 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7250 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7251 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7252 call transpose2(AEA(1,1,2),auxmat(1,1))
7253 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7254 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7255 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7256 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7257 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7258 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7259 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7260 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7261 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7262 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7263 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7264 C Calculate the Cartesian derivatives of the vectors.
7268 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7269 call matvec2(auxmat(1,1),b1(1,iti),
7270 & AEAb1derx(1,lll,kkk,iii,1,1))
7271 call matvec2(auxmat(1,1),Ub2(1,i),
7272 & AEAb2derx(1,lll,kkk,iii,1,1))
7273 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7274 & AEAb1derx(1,lll,kkk,iii,2,1))
7275 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7276 & AEAb2derx(1,lll,kkk,iii,2,1))
7277 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7278 call matvec2(auxmat(1,1),b1(1,itl),
7279 & AEAb1derx(1,lll,kkk,iii,1,2))
7280 call matvec2(auxmat(1,1),Ub2(1,l),
7281 & AEAb2derx(1,lll,kkk,iii,1,2))
7282 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7283 & AEAb1derx(1,lll,kkk,iii,2,2))
7284 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7285 & AEAb2derx(1,lll,kkk,iii,2,2))
7294 C---------------------------------------------------------------------------
7295 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7296 & KK,KKderg,AKA,AKAderg,AKAderx)
7300 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7301 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7302 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7307 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7309 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7312 cd if (lprn) write (2,*) 'In kernel'
7314 cd if (lprn) write (2,*) 'kkk=',kkk
7316 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7317 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7319 cd write (2,*) 'lll=',lll
7320 cd write (2,*) 'iii=1'
7322 cd write (2,'(3(2f10.5),5x)')
7323 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7326 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7327 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7329 cd write (2,*) 'lll=',lll
7330 cd write (2,*) 'iii=2'
7332 cd write (2,'(3(2f10.5),5x)')
7333 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7340 C---------------------------------------------------------------------------
7341 double precision function eello4(i,j,k,l,jj,kk)
7342 implicit real*8 (a-h,o-z)
7343 include 'DIMENSIONS'
7344 include 'COMMON.IOUNITS'
7345 include 'COMMON.CHAIN'
7346 include 'COMMON.DERIV'
7347 include 'COMMON.INTERACT'
7348 include 'COMMON.CONTACTS'
7349 include 'COMMON.TORSION'
7350 include 'COMMON.VAR'
7351 include 'COMMON.GEO'
7352 double precision pizda(2,2),ggg1(3),ggg2(3)
7353 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7357 cd print *,'eello4:',i,j,k,l,jj,kk
7358 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7359 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7360 cold eij=facont_hb(jj,i)
7361 cold ekl=facont_hb(kk,k)
7363 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7364 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7365 gcorr_loc(k-1)=gcorr_loc(k-1)
7366 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7368 gcorr_loc(l-1)=gcorr_loc(l-1)
7369 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7371 gcorr_loc(j-1)=gcorr_loc(j-1)
7372 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7377 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7378 & -EAEAderx(2,2,lll,kkk,iii,1)
7379 cd derx(lll,kkk,iii)=0.0d0
7383 cd gcorr_loc(l-1)=0.0d0
7384 cd gcorr_loc(j-1)=0.0d0
7385 cd gcorr_loc(k-1)=0.0d0
7387 cd write (iout,*)'Contacts have occurred for peptide groups',
7388 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7389 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7390 if (j.lt.nres-1) then
7397 if (l.lt.nres-1) then
7405 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7406 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7407 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7408 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7409 cgrad ghalf=0.5d0*ggg1(ll)
7410 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7411 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7412 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7413 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7414 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7415 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7416 cgrad ghalf=0.5d0*ggg2(ll)
7417 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7418 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7419 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7420 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7421 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7422 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7426 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7431 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7436 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7441 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7445 cd write (2,*) iii,gcorr_loc(iii)
7448 cd write (2,*) 'ekont',ekont
7449 cd write (iout,*) 'eello4',ekont*eel4
7452 C---------------------------------------------------------------------------
7453 double precision function eello5(i,j,k,l,jj,kk)
7454 implicit real*8 (a-h,o-z)
7455 include 'DIMENSIONS'
7456 include 'COMMON.IOUNITS'
7457 include 'COMMON.CHAIN'
7458 include 'COMMON.DERIV'
7459 include 'COMMON.INTERACT'
7460 include 'COMMON.CONTACTS'
7461 include 'COMMON.TORSION'
7462 include 'COMMON.VAR'
7463 include 'COMMON.GEO'
7464 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7465 double precision ggg1(3),ggg2(3)
7466 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7471 C /l\ / \ \ / \ / \ / C
7472 C / \ / \ \ / \ / \ / C
7473 C j| o |l1 | o | o| o | | o |o C
7474 C \ |/k\| |/ \| / |/ \| |/ \| C
7475 C \i/ \ / \ / / \ / \ C
7477 C (I) (II) (III) (IV) C
7479 C eello5_1 eello5_2 eello5_3 eello5_4 C
7481 C Antiparallel chains C
7484 C /j\ / \ \ / \ / \ / C
7485 C / \ / \ \ / \ / \ / C
7486 C j1| o |l | o | o| o | | o |o C
7487 C \ |/k\| |/ \| / |/ \| |/ \| C
7488 C \i/ \ / \ / / \ / \ C
7490 C (I) (II) (III) (IV) C
7492 C eello5_1 eello5_2 eello5_3 eello5_4 C
7494 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7496 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7497 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7502 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7504 itk=itortyp(itype(k))
7505 itl=itortyp(itype(l))
7506 itj=itortyp(itype(j))
7511 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7512 cd & eel5_3_num,eel5_4_num)
7516 derx(lll,kkk,iii)=0.0d0
7520 cd eij=facont_hb(jj,i)
7521 cd ekl=facont_hb(kk,k)
7523 cd write (iout,*)'Contacts have occurred for peptide groups',
7524 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7526 C Contribution from the graph I.
7527 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7528 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7529 call transpose2(EUg(1,1,k),auxmat(1,1))
7530 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7531 vv(1)=pizda(1,1)-pizda(2,2)
7532 vv(2)=pizda(1,2)+pizda(2,1)
7533 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7534 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7535 C Explicit gradient in virtual-dihedral angles.
7536 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7537 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7538 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7539 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7540 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7541 vv(1)=pizda(1,1)-pizda(2,2)
7542 vv(2)=pizda(1,2)+pizda(2,1)
7543 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7544 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7545 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7546 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7547 vv(1)=pizda(1,1)-pizda(2,2)
7548 vv(2)=pizda(1,2)+pizda(2,1)
7550 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7551 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7552 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7554 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7555 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7556 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7558 C Cartesian gradient
7562 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7564 vv(1)=pizda(1,1)-pizda(2,2)
7565 vv(2)=pizda(1,2)+pizda(2,1)
7566 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7567 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7568 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7574 C Contribution from graph II
7575 call transpose2(EE(1,1,itk),auxmat(1,1))
7576 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7577 vv(1)=pizda(1,1)+pizda(2,2)
7578 vv(2)=pizda(2,1)-pizda(1,2)
7579 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7580 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7581 C Explicit gradient in virtual-dihedral angles.
7582 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7583 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7584 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7585 vv(1)=pizda(1,1)+pizda(2,2)
7586 vv(2)=pizda(2,1)-pizda(1,2)
7588 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7589 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7590 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7592 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7593 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7594 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7596 C Cartesian gradient
7600 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7602 vv(1)=pizda(1,1)+pizda(2,2)
7603 vv(2)=pizda(2,1)-pizda(1,2)
7604 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7605 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7606 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7614 C Parallel orientation
7615 C Contribution from graph III
7616 call transpose2(EUg(1,1,l),auxmat(1,1))
7617 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7618 vv(1)=pizda(1,1)-pizda(2,2)
7619 vv(2)=pizda(1,2)+pizda(2,1)
7620 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7621 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7622 C Explicit gradient in virtual-dihedral angles.
7623 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7624 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7625 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7626 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)-pizda(2,2)
7628 vv(2)=pizda(1,2)+pizda(2,1)
7629 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7630 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7631 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7632 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7633 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7634 vv(1)=pizda(1,1)-pizda(2,2)
7635 vv(2)=pizda(1,2)+pizda(2,1)
7636 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7637 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7638 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7639 C Cartesian gradient
7643 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7645 vv(1)=pizda(1,1)-pizda(2,2)
7646 vv(2)=pizda(1,2)+pizda(2,1)
7647 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7648 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7649 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7654 C Contribution from graph IV
7656 call transpose2(EE(1,1,itl),auxmat(1,1))
7657 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7658 vv(1)=pizda(1,1)+pizda(2,2)
7659 vv(2)=pizda(2,1)-pizda(1,2)
7660 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7661 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7662 C Explicit gradient in virtual-dihedral angles.
7663 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7664 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7665 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7666 vv(1)=pizda(1,1)+pizda(2,2)
7667 vv(2)=pizda(2,1)-pizda(1,2)
7668 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7669 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7670 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7671 C Cartesian gradient
7675 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7677 vv(1)=pizda(1,1)+pizda(2,2)
7678 vv(2)=pizda(2,1)-pizda(1,2)
7679 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7680 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7681 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7686 C Antiparallel orientation
7687 C Contribution from graph III
7689 call transpose2(EUg(1,1,j),auxmat(1,1))
7690 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7691 vv(1)=pizda(1,1)-pizda(2,2)
7692 vv(2)=pizda(1,2)+pizda(2,1)
7693 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7694 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7695 C Explicit gradient in virtual-dihedral angles.
7696 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7697 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7698 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7699 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7700 vv(1)=pizda(1,1)-pizda(2,2)
7701 vv(2)=pizda(1,2)+pizda(2,1)
7702 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7703 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7704 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7705 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7706 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7707 vv(1)=pizda(1,1)-pizda(2,2)
7708 vv(2)=pizda(1,2)+pizda(2,1)
7709 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7710 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7711 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7712 C Cartesian gradient
7716 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7718 vv(1)=pizda(1,1)-pizda(2,2)
7719 vv(2)=pizda(1,2)+pizda(2,1)
7720 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7721 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7722 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7727 C Contribution from graph IV
7729 call transpose2(EE(1,1,itj),auxmat(1,1))
7730 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7731 vv(1)=pizda(1,1)+pizda(2,2)
7732 vv(2)=pizda(2,1)-pizda(1,2)
7733 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7734 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7735 C Explicit gradient in virtual-dihedral angles.
7736 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7737 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7738 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7739 vv(1)=pizda(1,1)+pizda(2,2)
7740 vv(2)=pizda(2,1)-pizda(1,2)
7741 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7742 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7743 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7744 C Cartesian gradient
7748 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7750 vv(1)=pizda(1,1)+pizda(2,2)
7751 vv(2)=pizda(2,1)-pizda(1,2)
7752 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7753 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7754 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7760 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7761 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7762 cd write (2,*) 'ijkl',i,j,k,l
7763 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7764 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7766 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7767 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7768 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7769 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7770 if (j.lt.nres-1) then
7777 if (l.lt.nres-1) then
7787 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7788 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7789 C summed up outside the subrouine as for the other subroutines
7790 C handling long-range interactions. The old code is commented out
7791 C with "cgrad" to keep track of changes.
7793 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7794 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7795 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7796 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7797 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7798 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7799 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7800 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7801 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7802 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7804 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7805 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7806 cgrad ghalf=0.5d0*ggg1(ll)
7808 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7809 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7810 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7811 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7812 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7813 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7814 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7815 cgrad ghalf=0.5d0*ggg2(ll)
7817 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7818 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7819 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7820 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7821 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7822 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7827 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7828 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7833 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7834 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7840 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7845 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7849 cd write (2,*) iii,g_corr5_loc(iii)
7852 cd write (2,*) 'ekont',ekont
7853 cd write (iout,*) 'eello5',ekont*eel5
7856 c--------------------------------------------------------------------------
7857 double precision function eello6(i,j,k,l,jj,kk)
7858 implicit real*8 (a-h,o-z)
7859 include 'DIMENSIONS'
7860 include 'COMMON.IOUNITS'
7861 include 'COMMON.CHAIN'
7862 include 'COMMON.DERIV'
7863 include 'COMMON.INTERACT'
7864 include 'COMMON.CONTACTS'
7865 include 'COMMON.TORSION'
7866 include 'COMMON.VAR'
7867 include 'COMMON.GEO'
7868 include 'COMMON.FFIELD'
7869 double precision ggg1(3),ggg2(3)
7870 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7875 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7883 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7884 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7888 derx(lll,kkk,iii)=0.0d0
7892 cd eij=facont_hb(jj,i)
7893 cd ekl=facont_hb(kk,k)
7899 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7900 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7901 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7902 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7903 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7904 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7906 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7907 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7908 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7909 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7910 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7911 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7915 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7917 C If turn contributions are considered, they will be handled separately.
7918 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7919 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7920 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7921 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7922 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7923 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7924 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7926 if (j.lt.nres-1) then
7933 if (l.lt.nres-1) then
7941 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7942 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7943 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7944 cgrad ghalf=0.5d0*ggg1(ll)
7946 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7947 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7948 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7949 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7950 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7951 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7952 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7953 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7954 cgrad ghalf=0.5d0*ggg2(ll)
7955 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7957 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7958 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7959 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7960 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7961 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7962 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7967 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7968 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7973 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7974 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7980 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7985 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7989 cd write (2,*) iii,g_corr6_loc(iii)
7992 cd write (2,*) 'ekont',ekont
7993 cd write (iout,*) 'eello6',ekont*eel6
7996 c--------------------------------------------------------------------------
7997 double precision function eello6_graph1(i,j,k,l,imat,swap)
7998 implicit real*8 (a-h,o-z)
7999 include 'DIMENSIONS'
8000 include 'COMMON.IOUNITS'
8001 include 'COMMON.CHAIN'
8002 include 'COMMON.DERIV'
8003 include 'COMMON.INTERACT'
8004 include 'COMMON.CONTACTS'
8005 include 'COMMON.TORSION'
8006 include 'COMMON.VAR'
8007 include 'COMMON.GEO'
8008 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8012 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8014 C Parallel Antiparallel
8020 C \ j|/k\| / \ |/k\|l /
8025 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8026 itk=itortyp(itype(k))
8027 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8028 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8029 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8030 call transpose2(EUgC(1,1,k),auxmat(1,1))
8031 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8032 vv1(1)=pizda1(1,1)-pizda1(2,2)
8033 vv1(2)=pizda1(1,2)+pizda1(2,1)
8034 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8035 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8036 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8037 s5=scalar2(vv(1),Dtobr2(1,i))
8038 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8039 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8040 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8041 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8042 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8043 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8044 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8045 & +scalar2(vv(1),Dtobr2der(1,i)))
8046 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8047 vv1(1)=pizda1(1,1)-pizda1(2,2)
8048 vv1(2)=pizda1(1,2)+pizda1(2,1)
8049 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8050 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8052 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8053 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8054 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8055 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8056 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8058 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8059 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8060 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8061 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8062 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8064 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8065 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8066 vv1(1)=pizda1(1,1)-pizda1(2,2)
8067 vv1(2)=pizda1(1,2)+pizda1(2,1)
8068 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8069 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8070 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8071 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8080 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8081 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8082 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8083 call transpose2(EUgC(1,1,k),auxmat(1,1))
8084 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8086 vv1(1)=pizda1(1,1)-pizda1(2,2)
8087 vv1(2)=pizda1(1,2)+pizda1(2,1)
8088 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8089 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8090 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8091 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8092 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8093 s5=scalar2(vv(1),Dtobr2(1,i))
8094 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8100 c----------------------------------------------------------------------------
8101 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8102 implicit real*8 (a-h,o-z)
8103 include 'DIMENSIONS'
8104 include 'COMMON.IOUNITS'
8105 include 'COMMON.CHAIN'
8106 include 'COMMON.DERIV'
8107 include 'COMMON.INTERACT'
8108 include 'COMMON.CONTACTS'
8109 include 'COMMON.TORSION'
8110 include 'COMMON.VAR'
8111 include 'COMMON.GEO'
8113 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8114 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8117 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8119 C Parallel Antiparallel
8130 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8131 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8132 C AL 7/4/01 s1 would occur in the sixth-order moment,
8133 C but not in a cluster cumulant
8135 s1=dip(1,jj,i)*dip(1,kk,k)
8137 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8138 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8139 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8140 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8141 call transpose2(EUg(1,1,k),auxmat(1,1))
8142 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8143 vv(1)=pizda(1,1)-pizda(2,2)
8144 vv(2)=pizda(1,2)+pizda(2,1)
8145 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8146 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8148 eello6_graph2=-(s1+s2+s3+s4)
8150 eello6_graph2=-(s2+s3+s4)
8153 C Derivatives in gamma(i-1)
8156 s1=dipderg(1,jj,i)*dip(1,kk,k)
8158 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8159 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8160 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8161 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8163 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8165 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8167 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8169 C Derivatives in gamma(k-1)
8171 s1=dip(1,jj,i)*dipderg(1,kk,k)
8173 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8174 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8175 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8176 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8177 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8178 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8179 vv(1)=pizda(1,1)-pizda(2,2)
8180 vv(2)=pizda(1,2)+pizda(2,1)
8181 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8183 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8185 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8187 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8188 C Derivatives in gamma(j-1) or gamma(l-1)
8191 s1=dipderg(3,jj,i)*dip(1,kk,k)
8193 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8194 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8195 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8196 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8197 vv(1)=pizda(1,1)-pizda(2,2)
8198 vv(2)=pizda(1,2)+pizda(2,1)
8199 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8202 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8204 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8207 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8208 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8210 C Derivatives in gamma(l-1) or gamma(j-1)
8213 s1=dip(1,jj,i)*dipderg(3,kk,k)
8215 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8216 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8217 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8218 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8219 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8220 vv(1)=pizda(1,1)-pizda(2,2)
8221 vv(2)=pizda(1,2)+pizda(2,1)
8222 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8225 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8227 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8230 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8231 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8233 C Cartesian derivatives.
8235 write (2,*) 'In eello6_graph2'
8237 write (2,*) 'iii=',iii
8239 write (2,*) 'kkk=',kkk
8241 write (2,'(3(2f10.5),5x)')
8242 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8252 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8254 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8257 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8259 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8260 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8262 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8263 call transpose2(EUg(1,1,k),auxmat(1,1))
8264 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8266 vv(1)=pizda(1,1)-pizda(2,2)
8267 vv(2)=pizda(1,2)+pizda(2,1)
8268 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8269 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8271 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8273 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8276 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8278 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8285 c----------------------------------------------------------------------------
8286 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8287 implicit real*8 (a-h,o-z)
8288 include 'DIMENSIONS'
8289 include 'COMMON.IOUNITS'
8290 include 'COMMON.CHAIN'
8291 include 'COMMON.DERIV'
8292 include 'COMMON.INTERACT'
8293 include 'COMMON.CONTACTS'
8294 include 'COMMON.TORSION'
8295 include 'COMMON.VAR'
8296 include 'COMMON.GEO'
8297 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8299 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8301 C Parallel Antiparallel
8312 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8314 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8315 C energy moment and not to the cluster cumulant.
8316 iti=itortyp(itype(i))
8317 if (j.lt.nres-1) then
8318 itj1=itortyp(itype(j+1))
8322 itk=itortyp(itype(k))
8323 itk1=itortyp(itype(k+1))
8324 if (l.lt.nres-1) then
8325 itl1=itortyp(itype(l+1))
8330 s1=dip(4,jj,i)*dip(4,kk,k)
8332 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8333 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8334 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8335 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8336 call transpose2(EE(1,1,itk),auxmat(1,1))
8337 call matmat2(auxmat(1,1),AECA(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 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8342 cd & "sum",-(s2+s3+s4)
8344 eello6_graph3=-(s1+s2+s3+s4)
8346 eello6_graph3=-(s2+s3+s4)
8349 C Derivatives in gamma(k-1)
8350 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8351 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8352 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8353 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8354 C Derivatives in gamma(l-1)
8355 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8356 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8357 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8358 vv(1)=pizda(1,1)+pizda(2,2)
8359 vv(2)=pizda(2,1)-pizda(1,2)
8360 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8361 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8362 C Cartesian derivatives.
8368 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8370 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8373 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8375 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8376 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8378 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8379 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8381 vv(1)=pizda(1,1)+pizda(2,2)
8382 vv(2)=pizda(2,1)-pizda(1,2)
8383 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8385 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8387 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8390 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8392 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8394 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8400 c----------------------------------------------------------------------------
8401 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8402 implicit real*8 (a-h,o-z)
8403 include 'DIMENSIONS'
8404 include 'COMMON.IOUNITS'
8405 include 'COMMON.CHAIN'
8406 include 'COMMON.DERIV'
8407 include 'COMMON.INTERACT'
8408 include 'COMMON.CONTACTS'
8409 include 'COMMON.TORSION'
8410 include 'COMMON.VAR'
8411 include 'COMMON.GEO'
8412 include 'COMMON.FFIELD'
8413 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8414 & auxvec1(2),auxmat1(2,2)
8416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8418 C Parallel Antiparallel
8429 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8431 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8432 C energy moment and not to the cluster cumulant.
8433 cd write (2,*) 'eello_graph4: wturn6',wturn6
8434 iti=itortyp(itype(i))
8435 itj=itortyp(itype(j))
8436 if (j.lt.nres-1) then
8437 itj1=itortyp(itype(j+1))
8441 itk=itortyp(itype(k))
8442 if (k.lt.nres-1) then
8443 itk1=itortyp(itype(k+1))
8447 itl=itortyp(itype(l))
8448 if (l.lt.nres-1) then
8449 itl1=itortyp(itype(l+1))
8453 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8454 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8455 cd & ' itl',itl,' itl1',itl1
8458 s1=dip(3,jj,i)*dip(3,kk,k)
8460 s1=dip(2,jj,j)*dip(2,kk,l)
8463 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8464 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8466 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8467 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8469 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8470 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8472 call transpose2(EUg(1,1,k),auxmat(1,1))
8473 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8474 vv(1)=pizda(1,1)-pizda(2,2)
8475 vv(2)=pizda(2,1)+pizda(1,2)
8476 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8477 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8479 eello6_graph4=-(s1+s2+s3+s4)
8481 eello6_graph4=-(s2+s3+s4)
8483 C Derivatives in gamma(i-1)
8487 s1=dipderg(2,jj,i)*dip(3,kk,k)
8489 s1=dipderg(4,jj,j)*dip(2,kk,l)
8492 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8494 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8495 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8497 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8498 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8500 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8501 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8502 cd write (2,*) 'turn6 derivatives'
8504 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8506 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8510 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8512 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8516 C Derivatives in gamma(k-1)
8519 s1=dip(3,jj,i)*dipderg(2,kk,k)
8521 s1=dip(2,jj,j)*dipderg(4,kk,l)
8524 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8525 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8527 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8528 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8530 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8531 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8533 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8534 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8535 vv(1)=pizda(1,1)-pizda(2,2)
8536 vv(2)=pizda(2,1)+pizda(1,2)
8537 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8538 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8540 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8542 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8546 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8548 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8551 C Derivatives in gamma(j-1) or gamma(l-1)
8552 if (l.eq.j+1 .and. l.gt.1) then
8553 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8554 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8555 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8556 vv(1)=pizda(1,1)-pizda(2,2)
8557 vv(2)=pizda(2,1)+pizda(1,2)
8558 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8559 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8560 else if (j.gt.1) then
8561 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8562 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8563 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8564 vv(1)=pizda(1,1)-pizda(2,2)
8565 vv(2)=pizda(2,1)+pizda(1,2)
8566 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8567 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8568 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8570 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8573 C Cartesian derivatives.
8580 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8582 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8586 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8588 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8592 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8594 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8596 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8597 & b1(1,itj1),auxvec(1))
8598 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8600 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8601 & b1(1,itl1),auxvec(1))
8602 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8604 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8606 vv(1)=pizda(1,1)-pizda(2,2)
8607 vv(2)=pizda(2,1)+pizda(1,2)
8608 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8610 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8612 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8615 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8618 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8621 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8623 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8625 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8629 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8631 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8634 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8636 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8644 c----------------------------------------------------------------------------
8645 double precision function eello_turn6(i,jj,kk)
8646 implicit real*8 (a-h,o-z)
8647 include 'DIMENSIONS'
8648 include 'COMMON.IOUNITS'
8649 include 'COMMON.CHAIN'
8650 include 'COMMON.DERIV'
8651 include 'COMMON.INTERACT'
8652 include 'COMMON.CONTACTS'
8653 include 'COMMON.TORSION'
8654 include 'COMMON.VAR'
8655 include 'COMMON.GEO'
8656 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8657 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8659 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8660 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8661 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8662 C the respective energy moment and not to the cluster cumulant.
8671 iti=itortyp(itype(i))
8672 itk=itortyp(itype(k))
8673 itk1=itortyp(itype(k+1))
8674 itl=itortyp(itype(l))
8675 itj=itortyp(itype(j))
8676 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8677 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8678 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8683 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8685 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8689 derx_turn(lll,kkk,iii)=0.0d0
8696 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8698 cd write (2,*) 'eello6_5',eello6_5
8700 call transpose2(AEA(1,1,1),auxmat(1,1))
8701 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8702 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8703 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8705 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8706 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8707 s2 = scalar2(b1(1,itk),vtemp1(1))
8709 call transpose2(AEA(1,1,2),atemp(1,1))
8710 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8711 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8712 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8714 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8715 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8716 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8718 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8719 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8720 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8721 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8722 ss13 = scalar2(b1(1,itk),vtemp4(1))
8723 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8725 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8731 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8732 C Derivatives in gamma(i+2)
8736 call transpose2(AEA(1,1,1),auxmatd(1,1))
8737 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8738 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8739 call transpose2(AEAderg(1,1,2),atempd(1,1))
8740 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8741 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8743 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8744 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8745 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8751 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8752 C Derivatives in gamma(i+3)
8754 call transpose2(AEA(1,1,1),auxmatd(1,1))
8755 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8756 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8757 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8759 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8760 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8761 s2d = scalar2(b1(1,itk),vtemp1d(1))
8763 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8764 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8766 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8768 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8769 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8770 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8778 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8779 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8781 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8782 & -0.5d0*ekont*(s2d+s12d)
8784 C Derivatives in gamma(i+4)
8785 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8786 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8787 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8789 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8790 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8791 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8799 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8801 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8803 C Derivatives in gamma(i+5)
8805 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8806 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8807 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8809 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8810 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8811 s2d = scalar2(b1(1,itk),vtemp1d(1))
8813 call transpose2(AEA(1,1,2),atempd(1,1))
8814 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8815 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8817 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8818 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8820 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8821 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8822 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8830 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8831 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8833 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8834 & -0.5d0*ekont*(s2d+s12d)
8836 C Cartesian derivatives
8841 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8842 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8843 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8845 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8846 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8848 s2d = scalar2(b1(1,itk),vtemp1d(1))
8850 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8851 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8852 s8d = -(atempd(1,1)+atempd(2,2))*
8853 & scalar2(cc(1,1,itl),vtemp2(1))
8855 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8857 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8858 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8865 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8868 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8872 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8873 & - 0.5d0*(s8d+s12d)
8875 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8884 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8886 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8887 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8888 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8889 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8890 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8892 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8893 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8894 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8898 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8899 cd & 16*eel_turn6_num
8901 if (j.lt.nres-1) then
8908 if (l.lt.nres-1) then
8916 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8917 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8918 cgrad ghalf=0.5d0*ggg1(ll)
8920 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8921 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8922 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8923 & +ekont*derx_turn(ll,2,1)
8924 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8925 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8926 & +ekont*derx_turn(ll,4,1)
8927 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8928 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8929 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8930 cgrad ghalf=0.5d0*ggg2(ll)
8932 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8933 & +ekont*derx_turn(ll,2,2)
8934 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8935 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8936 & +ekont*derx_turn(ll,4,2)
8937 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8938 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8939 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8944 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8949 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8955 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8960 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8964 cd write (2,*) iii,g_corr6_loc(iii)
8966 eello_turn6=ekont*eel_turn6
8967 cd write (2,*) 'ekont',ekont
8968 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8972 C-----------------------------------------------------------------------------
8973 double precision function scalar(u,v)
8974 !DIR$ INLINEALWAYS scalar
8976 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8979 double precision u(3),v(3)
8980 cd double precision sc
8988 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8991 crc-------------------------------------------------
8992 SUBROUTINE MATVEC2(A1,V1,V2)
8993 !DIR$ INLINEALWAYS MATVEC2
8995 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8997 implicit real*8 (a-h,o-z)
8998 include 'DIMENSIONS'
8999 DIMENSION A1(2,2),V1(2),V2(2)
9003 c 3 VI=VI+A1(I,K)*V1(K)
9007 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9008 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9013 C---------------------------------------
9014 SUBROUTINE MATMAT2(A1,A2,A3)
9016 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9018 implicit real*8 (a-h,o-z)
9019 include 'DIMENSIONS'
9020 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9021 c DIMENSION AI3(2,2)
9025 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9031 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9032 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9033 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9034 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9042 c-------------------------------------------------------------------------
9043 double precision function scalar2(u,v)
9044 !DIR$ INLINEALWAYS scalar2
9046 double precision u(2),v(2)
9049 scalar2=u(1)*v(1)+u(2)*v(2)
9053 C-----------------------------------------------------------------------------
9055 subroutine transpose2(a,at)
9056 !DIR$ INLINEALWAYS transpose2
9058 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9061 double precision a(2,2),at(2,2)
9068 c--------------------------------------------------------------------------
9069 subroutine transpose(n,a,at)
9072 double precision a(n,n),at(n,n)
9080 C---------------------------------------------------------------------------
9081 subroutine prodmat3(a1,a2,kk,transp,prod)
9082 !DIR$ INLINEALWAYS prodmat3
9084 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9088 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9090 crc double precision auxmat(2,2),prod_(2,2)
9093 crc call transpose2(kk(1,1),auxmat(1,1))
9094 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9095 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9097 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9098 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9099 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9100 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9101 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9102 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9103 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9104 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9107 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9108 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9110 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9111 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9112 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9113 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9114 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9115 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9116 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9117 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9120 c call transpose2(a2(1,1),a2t(1,1))
9123 crc print *,((prod_(i,j),i=1,2),j=1,2)
9124 crc print *,((prod(i,j),i=1,2),j=1,2)