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,iphi_end
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 do j=1,nterm_sccor(isccori,isccori1)
5893 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5894 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5895 cosphi=dcos(j*tauangle(intertyp,i))
5896 sinphi=dsin(j*tauangle(intertyp,i))
5897 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5898 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5900 gloc_sc(intertyp,i-3,icg)=gloc_sc(i-3,icg)+wtor*gloci
5902 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5903 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5904 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5905 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5906 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5911 c----------------------------------------------------------------------------
5912 subroutine multibody(ecorr)
5913 C This subroutine calculates multi-body contributions to energy following
5914 C the idea of Skolnick et al. If side chains I and J make a contact and
5915 C at the same time side chains I+1 and J+1 make a contact, an extra
5916 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5917 implicit real*8 (a-h,o-z)
5918 include 'DIMENSIONS'
5919 include 'COMMON.IOUNITS'
5920 include 'COMMON.DERIV'
5921 include 'COMMON.INTERACT'
5922 include 'COMMON.CONTACTS'
5923 double precision gx(3),gx1(3)
5926 C Set lprn=.true. for debugging
5930 write (iout,'(a)') 'Contact function values:'
5932 write (iout,'(i2,20(1x,i2,f10.5))')
5933 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5948 num_conti=num_cont(i)
5949 num_conti1=num_cont(i1)
5954 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5955 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5956 cd & ' ishift=',ishift
5957 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5958 C The system gains extra energy.
5959 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5960 endif ! j1==j+-ishift
5969 c------------------------------------------------------------------------------
5970 double precision function esccorr(i,j,k,l,jj,kk)
5971 implicit real*8 (a-h,o-z)
5972 include 'DIMENSIONS'
5973 include 'COMMON.IOUNITS'
5974 include 'COMMON.DERIV'
5975 include 'COMMON.INTERACT'
5976 include 'COMMON.CONTACTS'
5977 double precision gx(3),gx1(3)
5982 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5983 C Calculate the multi-body contribution to energy.
5984 C Calculate multi-body contributions to the gradient.
5985 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5986 cd & k,l,(gacont(m,kk,k),m=1,3)
5988 gx(m) =ekl*gacont(m,jj,i)
5989 gx1(m)=eij*gacont(m,kk,k)
5990 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5991 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5992 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5993 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5997 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6002 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6008 c------------------------------------------------------------------------------
6009 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6010 C This subroutine calculates multi-body contributions to hydrogen-bonding
6011 implicit real*8 (a-h,o-z)
6012 include 'DIMENSIONS'
6013 include 'COMMON.IOUNITS'
6016 parameter (max_cont=maxconts)
6017 parameter (max_dim=26)
6018 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6019 double precision zapas(max_dim,maxconts,max_fg_procs),
6020 & zapas_recv(max_dim,maxconts,max_fg_procs)
6021 common /przechowalnia/ zapas
6022 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6023 & status_array(MPI_STATUS_SIZE,maxconts*2)
6025 include 'COMMON.SETUP'
6026 include 'COMMON.FFIELD'
6027 include 'COMMON.DERIV'
6028 include 'COMMON.INTERACT'
6029 include 'COMMON.CONTACTS'
6030 include 'COMMON.CONTROL'
6031 include 'COMMON.LOCAL'
6032 double precision gx(3),gx1(3),time00
6035 C Set lprn=.true. for debugging
6040 if (nfgtasks.le.1) goto 30
6042 write (iout,'(a)') 'Contact function values before RECEIVE:'
6044 write (iout,'(2i3,50(1x,i2,f5.2))')
6045 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6046 & j=1,num_cont_hb(i))
6050 do i=1,ntask_cont_from
6053 do i=1,ntask_cont_to
6056 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6058 C Make the list of contacts to send to send to other procesors
6059 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6061 do i=iturn3_start,iturn3_end
6062 c write (iout,*) "make contact list turn3",i," num_cont",
6064 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6066 do i=iturn4_start,iturn4_end
6067 c write (iout,*) "make contact list turn4",i," num_cont",
6069 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6073 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6075 do j=1,num_cont_hb(i)
6078 iproc=iint_sent_local(k,jjc,ii)
6079 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6080 if (iproc.gt.0) then
6081 ncont_sent(iproc)=ncont_sent(iproc)+1
6082 nn=ncont_sent(iproc)
6084 zapas(2,nn,iproc)=jjc
6085 zapas(3,nn,iproc)=facont_hb(j,i)
6086 zapas(4,nn,iproc)=ees0p(j,i)
6087 zapas(5,nn,iproc)=ees0m(j,i)
6088 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6089 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6090 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6091 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6092 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6093 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6094 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6095 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6096 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6097 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6098 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6099 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6100 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6101 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6102 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6103 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6104 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6105 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6106 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6107 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6108 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6115 & "Numbers of contacts to be sent to other processors",
6116 & (ncont_sent(i),i=1,ntask_cont_to)
6117 write (iout,*) "Contacts sent"
6118 do ii=1,ntask_cont_to
6120 iproc=itask_cont_to(ii)
6121 write (iout,*) nn," contacts to processor",iproc,
6122 & " of CONT_TO_COMM group"
6124 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6132 CorrelID1=nfgtasks+fg_rank+1
6134 C Receive the numbers of needed contacts from other processors
6135 do ii=1,ntask_cont_from
6136 iproc=itask_cont_from(ii)
6138 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6139 & FG_COMM,req(ireq),IERR)
6141 c write (iout,*) "IRECV ended"
6143 C Send the number of contacts needed by other processors
6144 do ii=1,ntask_cont_to
6145 iproc=itask_cont_to(ii)
6147 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6148 & FG_COMM,req(ireq),IERR)
6150 c write (iout,*) "ISEND ended"
6151 c write (iout,*) "number of requests (nn)",ireq
6154 & call MPI_Waitall(ireq,req,status_array,ierr)
6156 c & "Numbers of contacts to be received from other processors",
6157 c & (ncont_recv(i),i=1,ntask_cont_from)
6161 do ii=1,ntask_cont_from
6162 iproc=itask_cont_from(ii)
6164 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6165 c & " of CONT_TO_COMM group"
6169 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6170 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6171 c write (iout,*) "ireq,req",ireq,req(ireq)
6174 C Send the contacts to processors that need them
6175 do ii=1,ntask_cont_to
6176 iproc=itask_cont_to(ii)
6178 c write (iout,*) nn," contacts to processor",iproc,
6179 c & " of CONT_TO_COMM group"
6182 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6183 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6184 c write (iout,*) "ireq,req",ireq,req(ireq)
6186 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6190 c write (iout,*) "number of requests (contacts)",ireq
6191 c write (iout,*) "req",(req(i),i=1,4)
6194 & call MPI_Waitall(ireq,req,status_array,ierr)
6195 do iii=1,ntask_cont_from
6196 iproc=itask_cont_from(iii)
6199 write (iout,*) "Received",nn," contacts from processor",iproc,
6200 & " of CONT_FROM_COMM group"
6203 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6208 ii=zapas_recv(1,i,iii)
6209 c Flag the received contacts to prevent double-counting
6210 jj=-zapas_recv(2,i,iii)
6211 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6213 nnn=num_cont_hb(ii)+1
6216 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6217 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6218 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6219 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6220 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6221 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6222 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6223 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6224 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6225 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6226 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6227 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6228 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6229 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6230 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6231 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6232 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6233 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6234 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6235 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6236 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6237 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6238 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6239 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6244 write (iout,'(a)') 'Contact function values after receive:'
6246 write (iout,'(2i3,50(1x,i3,f5.2))')
6247 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6248 & j=1,num_cont_hb(i))
6255 write (iout,'(a)') 'Contact function values:'
6257 write (iout,'(2i3,50(1x,i3,f5.2))')
6258 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6259 & j=1,num_cont_hb(i))
6263 C Remove the loop below after debugging !!!
6270 C Calculate the local-electrostatic correlation terms
6271 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6273 num_conti=num_cont_hb(i)
6274 num_conti1=num_cont_hb(i+1)
6281 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6282 c & ' jj=',jj,' kk=',kk
6283 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6284 & .or. j.lt.0 .and. j1.gt.0) .and.
6285 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6286 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6287 C The system gains extra energy.
6288 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6289 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6290 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6292 else if (j1.eq.j) then
6293 C Contacts I-J and I-(J+1) occur simultaneously.
6294 C The system loses extra energy.
6295 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6300 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6301 c & ' jj=',jj,' kk=',kk
6303 C Contacts I-J and (I+1)-J occur simultaneously.
6304 C The system loses extra energy.
6305 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6312 c------------------------------------------------------------------------------
6313 subroutine add_hb_contact(ii,jj,itask)
6314 implicit real*8 (a-h,o-z)
6315 include "DIMENSIONS"
6316 include "COMMON.IOUNITS"
6319 parameter (max_cont=maxconts)
6320 parameter (max_dim=26)
6321 include "COMMON.CONTACTS"
6322 double precision zapas(max_dim,maxconts,max_fg_procs),
6323 & zapas_recv(max_dim,maxconts,max_fg_procs)
6324 common /przechowalnia/ zapas
6325 integer i,j,ii,jj,iproc,itask(4),nn
6326 c write (iout,*) "itask",itask
6329 if (iproc.gt.0) then
6330 do j=1,num_cont_hb(ii)
6332 c write (iout,*) "i",ii," j",jj," jjc",jjc
6334 ncont_sent(iproc)=ncont_sent(iproc)+1
6335 nn=ncont_sent(iproc)
6336 zapas(1,nn,iproc)=ii
6337 zapas(2,nn,iproc)=jjc
6338 zapas(3,nn,iproc)=facont_hb(j,ii)
6339 zapas(4,nn,iproc)=ees0p(j,ii)
6340 zapas(5,nn,iproc)=ees0m(j,ii)
6341 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6342 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6343 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6344 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6345 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6346 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6347 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6348 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6349 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6350 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6351 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6352 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6353 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6354 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6355 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6356 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6357 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6358 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6359 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6360 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6361 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6369 c------------------------------------------------------------------------------
6370 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6372 C This subroutine calculates multi-body contributions to hydrogen-bonding
6373 implicit real*8 (a-h,o-z)
6374 include 'DIMENSIONS'
6375 include 'COMMON.IOUNITS'
6378 parameter (max_cont=maxconts)
6379 parameter (max_dim=70)
6380 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6381 double precision zapas(max_dim,maxconts,max_fg_procs),
6382 & zapas_recv(max_dim,maxconts,max_fg_procs)
6383 common /przechowalnia/ zapas
6384 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6385 & status_array(MPI_STATUS_SIZE,maxconts*2)
6387 include 'COMMON.SETUP'
6388 include 'COMMON.FFIELD'
6389 include 'COMMON.DERIV'
6390 include 'COMMON.LOCAL'
6391 include 'COMMON.INTERACT'
6392 include 'COMMON.CONTACTS'
6393 include 'COMMON.CHAIN'
6394 include 'COMMON.CONTROL'
6395 double precision gx(3),gx1(3)
6396 integer num_cont_hb_old(maxres)
6398 double precision eello4,eello5,eelo6,eello_turn6
6399 external eello4,eello5,eello6,eello_turn6
6400 C Set lprn=.true. for debugging
6405 num_cont_hb_old(i)=num_cont_hb(i)
6409 if (nfgtasks.le.1) goto 30
6411 write (iout,'(a)') 'Contact function values before RECEIVE:'
6413 write (iout,'(2i3,50(1x,i2,f5.2))')
6414 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6415 & j=1,num_cont_hb(i))
6419 do i=1,ntask_cont_from
6422 do i=1,ntask_cont_to
6425 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6427 C Make the list of contacts to send to send to other procesors
6428 do i=iturn3_start,iturn3_end
6429 c write (iout,*) "make contact list turn3",i," num_cont",
6431 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6433 do i=iturn4_start,iturn4_end
6434 c write (iout,*) "make contact list turn4",i," num_cont",
6436 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6440 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6442 do j=1,num_cont_hb(i)
6445 iproc=iint_sent_local(k,jjc,ii)
6446 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6447 if (iproc.ne.0) then
6448 ncont_sent(iproc)=ncont_sent(iproc)+1
6449 nn=ncont_sent(iproc)
6451 zapas(2,nn,iproc)=jjc
6452 zapas(3,nn,iproc)=d_cont(j,i)
6456 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6461 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6469 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6480 & "Numbers of contacts to be sent to other processors",
6481 & (ncont_sent(i),i=1,ntask_cont_to)
6482 write (iout,*) "Contacts sent"
6483 do ii=1,ntask_cont_to
6485 iproc=itask_cont_to(ii)
6486 write (iout,*) nn," contacts to processor",iproc,
6487 & " of CONT_TO_COMM group"
6489 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6497 CorrelID1=nfgtasks+fg_rank+1
6499 C Receive the numbers of needed contacts from other processors
6500 do ii=1,ntask_cont_from
6501 iproc=itask_cont_from(ii)
6503 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6504 & FG_COMM,req(ireq),IERR)
6506 c write (iout,*) "IRECV ended"
6508 C Send the number of contacts needed by other processors
6509 do ii=1,ntask_cont_to
6510 iproc=itask_cont_to(ii)
6512 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6513 & FG_COMM,req(ireq),IERR)
6515 c write (iout,*) "ISEND ended"
6516 c write (iout,*) "number of requests (nn)",ireq
6519 & call MPI_Waitall(ireq,req,status_array,ierr)
6521 c & "Numbers of contacts to be received from other processors",
6522 c & (ncont_recv(i),i=1,ntask_cont_from)
6526 do ii=1,ntask_cont_from
6527 iproc=itask_cont_from(ii)
6529 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6530 c & " of CONT_TO_COMM group"
6534 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6535 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6536 c write (iout,*) "ireq,req",ireq,req(ireq)
6539 C Send the contacts to processors that need them
6540 do ii=1,ntask_cont_to
6541 iproc=itask_cont_to(ii)
6543 c write (iout,*) nn," contacts to processor",iproc,
6544 c & " of CONT_TO_COMM group"
6547 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6548 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6549 c write (iout,*) "ireq,req",ireq,req(ireq)
6551 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6555 c write (iout,*) "number of requests (contacts)",ireq
6556 c write (iout,*) "req",(req(i),i=1,4)
6559 & call MPI_Waitall(ireq,req,status_array,ierr)
6560 do iii=1,ntask_cont_from
6561 iproc=itask_cont_from(iii)
6564 write (iout,*) "Received",nn," contacts from processor",iproc,
6565 & " of CONT_FROM_COMM group"
6568 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6573 ii=zapas_recv(1,i,iii)
6574 c Flag the received contacts to prevent double-counting
6575 jj=-zapas_recv(2,i,iii)
6576 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6578 nnn=num_cont_hb(ii)+1
6581 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6585 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6590 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6598 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6607 write (iout,'(a)') 'Contact function values after receive:'
6609 write (iout,'(2i3,50(1x,i3,5f6.3))')
6610 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6611 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6618 write (iout,'(a)') 'Contact function values:'
6620 write (iout,'(2i3,50(1x,i2,5f6.3))')
6621 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6622 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6628 C Remove the loop below after debugging !!!
6635 C Calculate the dipole-dipole interaction energies
6636 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6637 do i=iatel_s,iatel_e+1
6638 num_conti=num_cont_hb(i)
6647 C Calculate the local-electrostatic correlation terms
6648 c write (iout,*) "gradcorr5 in eello5 before loop"
6650 c write (iout,'(i5,3f10.5)')
6651 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6653 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6654 c write (iout,*) "corr loop i",i
6656 num_conti=num_cont_hb(i)
6657 num_conti1=num_cont_hb(i+1)
6664 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6665 c & ' jj=',jj,' kk=',kk
6666 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6667 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6668 & .or. j.lt.0 .and. j1.gt.0) .and.
6669 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6670 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6671 C The system gains extra energy.
6673 sqd1=dsqrt(d_cont(jj,i))
6674 sqd2=dsqrt(d_cont(kk,i1))
6675 sred_geom = sqd1*sqd2
6676 IF (sred_geom.lt.cutoff_corr) THEN
6677 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6679 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6680 cd & ' jj=',jj,' kk=',kk
6681 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6682 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6684 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6685 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6688 cd write (iout,*) 'sred_geom=',sred_geom,
6689 cd & ' ekont=',ekont,' fprim=',fprimcont,
6690 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6691 cd write (iout,*) "g_contij",g_contij
6692 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6693 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6694 call calc_eello(i,jp,i+1,jp1,jj,kk)
6695 if (wcorr4.gt.0.0d0)
6696 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6697 if (energy_dec.and.wcorr4.gt.0.0d0)
6698 1 write (iout,'(a6,4i5,0pf7.3)')
6699 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6700 c write (iout,*) "gradcorr5 before eello5"
6702 c write (iout,'(i5,3f10.5)')
6703 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6705 if (wcorr5.gt.0.0d0)
6706 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6707 c write (iout,*) "gradcorr5 after eello5"
6709 c write (iout,'(i5,3f10.5)')
6710 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6712 if (energy_dec.and.wcorr5.gt.0.0d0)
6713 1 write (iout,'(a6,4i5,0pf7.3)')
6714 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6715 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6716 cd write(2,*)'ijkl',i,jp,i+1,jp1
6717 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6718 & .or. wturn6.eq.0.0d0))then
6719 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6720 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6721 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6722 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6723 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6724 cd & 'ecorr6=',ecorr6
6725 cd write (iout,'(4e15.5)') sred_geom,
6726 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6727 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6728 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6729 else if (wturn6.gt.0.0d0
6730 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6731 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6732 eturn6=eturn6+eello_turn6(i,jj,kk)
6733 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6734 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6735 cd write (2,*) 'multibody_eello:eturn6',eturn6
6744 num_cont_hb(i)=num_cont_hb_old(i)
6746 c write (iout,*) "gradcorr5 in eello5"
6748 c write (iout,'(i5,3f10.5)')
6749 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6753 c------------------------------------------------------------------------------
6754 subroutine add_hb_contact_eello(ii,jj,itask)
6755 implicit real*8 (a-h,o-z)
6756 include "DIMENSIONS"
6757 include "COMMON.IOUNITS"
6760 parameter (max_cont=maxconts)
6761 parameter (max_dim=70)
6762 include "COMMON.CONTACTS"
6763 double precision zapas(max_dim,maxconts,max_fg_procs),
6764 & zapas_recv(max_dim,maxconts,max_fg_procs)
6765 common /przechowalnia/ zapas
6766 integer i,j,ii,jj,iproc,itask(4),nn
6767 c write (iout,*) "itask",itask
6770 if (iproc.gt.0) then
6771 do j=1,num_cont_hb(ii)
6773 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6775 ncont_sent(iproc)=ncont_sent(iproc)+1
6776 nn=ncont_sent(iproc)
6777 zapas(1,nn,iproc)=ii
6778 zapas(2,nn,iproc)=jjc
6779 zapas(3,nn,iproc)=d_cont(j,ii)
6783 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6788 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6796 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6808 c------------------------------------------------------------------------------
6809 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6810 implicit real*8 (a-h,o-z)
6811 include 'DIMENSIONS'
6812 include 'COMMON.IOUNITS'
6813 include 'COMMON.DERIV'
6814 include 'COMMON.INTERACT'
6815 include 'COMMON.CONTACTS'
6816 double precision gx(3),gx1(3)
6826 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6827 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6828 C Following 4 lines for diagnostics.
6833 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6834 c & 'Contacts ',i,j,
6835 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6836 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6838 C Calculate the multi-body contribution to energy.
6839 c ecorr=ecorr+ekont*ees
6840 C Calculate multi-body contributions to the gradient.
6841 coeffpees0pij=coeffp*ees0pij
6842 coeffmees0mij=coeffm*ees0mij
6843 coeffpees0pkl=coeffp*ees0pkl
6844 coeffmees0mkl=coeffm*ees0mkl
6846 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6847 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6848 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6849 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6850 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6851 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6852 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6853 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6854 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6855 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6856 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6857 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6858 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6859 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6860 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6861 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6862 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6863 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6864 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6865 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6866 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6867 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6868 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6869 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6870 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6875 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6876 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6877 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6878 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6883 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6884 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6885 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6886 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6889 c write (iout,*) "ehbcorr",ekont*ees
6894 C---------------------------------------------------------------------------
6895 subroutine dipole(i,j,jj)
6896 implicit real*8 (a-h,o-z)
6897 include 'DIMENSIONS'
6898 include 'COMMON.IOUNITS'
6899 include 'COMMON.CHAIN'
6900 include 'COMMON.FFIELD'
6901 include 'COMMON.DERIV'
6902 include 'COMMON.INTERACT'
6903 include 'COMMON.CONTACTS'
6904 include 'COMMON.TORSION'
6905 include 'COMMON.VAR'
6906 include 'COMMON.GEO'
6907 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6909 iti1 = itortyp(itype(i+1))
6910 if (j.lt.nres-1) then
6911 itj1 = itortyp(itype(j+1))
6916 dipi(iii,1)=Ub2(iii,i)
6917 dipderi(iii)=Ub2der(iii,i)
6918 dipi(iii,2)=b1(iii,iti1)
6919 dipj(iii,1)=Ub2(iii,j)
6920 dipderj(iii)=Ub2der(iii,j)
6921 dipj(iii,2)=b1(iii,itj1)
6925 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6928 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6935 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6939 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6944 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6945 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6947 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6949 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6951 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6956 C---------------------------------------------------------------------------
6957 subroutine calc_eello(i,j,k,l,jj,kk)
6959 C This subroutine computes matrices and vectors needed to calculate
6960 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6962 implicit real*8 (a-h,o-z)
6963 include 'DIMENSIONS'
6964 include 'COMMON.IOUNITS'
6965 include 'COMMON.CHAIN'
6966 include 'COMMON.DERIV'
6967 include 'COMMON.INTERACT'
6968 include 'COMMON.CONTACTS'
6969 include 'COMMON.TORSION'
6970 include 'COMMON.VAR'
6971 include 'COMMON.GEO'
6972 include 'COMMON.FFIELD'
6973 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6974 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6977 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6978 cd & ' jj=',jj,' kk=',kk
6979 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6980 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6981 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6984 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6985 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6988 call transpose2(aa1(1,1),aa1t(1,1))
6989 call transpose2(aa2(1,1),aa2t(1,1))
6992 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6993 & aa1tder(1,1,lll,kkk))
6994 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6995 & aa2tder(1,1,lll,kkk))
6999 C parallel orientation of the two CA-CA-CA frames.
7001 iti=itortyp(itype(i))
7005 itk1=itortyp(itype(k+1))
7006 itj=itortyp(itype(j))
7007 if (l.lt.nres-1) then
7008 itl1=itortyp(itype(l+1))
7012 C A1 kernel(j+1) A2T
7014 cd write (iout,'(3f10.5,5x,3f10.5)')
7015 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7017 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7018 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7019 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7020 C Following matrices are needed only for 6-th order cumulants
7021 IF (wcorr6.gt.0.0d0) THEN
7022 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7023 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7024 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7025 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7026 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7027 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7028 & ADtEAderx(1,1,1,1,1,1))
7030 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7031 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7032 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7033 & ADtEA1derx(1,1,1,1,1,1))
7035 C End 6-th order cumulants
7038 cd write (2,*) 'In calc_eello6'
7040 cd write (2,*) 'iii=',iii
7042 cd write (2,*) 'kkk=',kkk
7044 cd write (2,'(3(2f10.5),5x)')
7045 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7050 call transpose2(EUgder(1,1,k),auxmat(1,1))
7051 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7052 call transpose2(EUg(1,1,k),auxmat(1,1))
7053 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7054 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7058 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7059 & EAEAderx(1,1,lll,kkk,iii,1))
7063 C A1T kernel(i+1) A2
7064 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7065 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7066 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7067 C Following matrices are needed only for 6-th order cumulants
7068 IF (wcorr6.gt.0.0d0) THEN
7069 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7070 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7071 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7072 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7073 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7074 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7075 & ADtEAderx(1,1,1,1,1,2))
7076 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7077 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7078 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7079 & ADtEA1derx(1,1,1,1,1,2))
7081 C End 6-th order cumulants
7082 call transpose2(EUgder(1,1,l),auxmat(1,1))
7083 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7084 call transpose2(EUg(1,1,l),auxmat(1,1))
7085 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7086 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7090 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7091 & EAEAderx(1,1,lll,kkk,iii,2))
7096 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7097 C They are needed only when the fifth- or the sixth-order cumulants are
7099 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7100 call transpose2(AEA(1,1,1),auxmat(1,1))
7101 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7102 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7103 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7104 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7105 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7106 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7107 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7108 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7109 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7110 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7111 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7112 call transpose2(AEA(1,1,2),auxmat(1,1))
7113 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7114 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7115 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7116 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7117 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7118 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7119 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7120 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7121 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7122 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7123 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7124 C Calculate the Cartesian derivatives of the vectors.
7128 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,iti),
7130 & AEAb1derx(1,lll,kkk,iii,1,1))
7131 call matvec2(auxmat(1,1),Ub2(1,i),
7132 & AEAb2derx(1,lll,kkk,iii,1,1))
7133 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7134 & AEAb1derx(1,lll,kkk,iii,2,1))
7135 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7136 & AEAb2derx(1,lll,kkk,iii,2,1))
7137 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7138 call matvec2(auxmat(1,1),b1(1,itj),
7139 & AEAb1derx(1,lll,kkk,iii,1,2))
7140 call matvec2(auxmat(1,1),Ub2(1,j),
7141 & AEAb2derx(1,lll,kkk,iii,1,2))
7142 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7143 & AEAb1derx(1,lll,kkk,iii,2,2))
7144 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7145 & AEAb2derx(1,lll,kkk,iii,2,2))
7152 C Antiparallel orientation of the two CA-CA-CA frames.
7154 iti=itortyp(itype(i))
7158 itk1=itortyp(itype(k+1))
7159 itl=itortyp(itype(l))
7160 itj=itortyp(itype(j))
7161 if (j.lt.nres-1) then
7162 itj1=itortyp(itype(j+1))
7166 C A2 kernel(j-1)T A1T
7167 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7168 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7169 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7170 C Following matrices are needed only for 6-th order cumulants
7171 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7172 & j.eq.i+4 .and. l.eq.i+3)) THEN
7173 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7174 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7175 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7176 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7177 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7178 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7179 & ADtEAderx(1,1,1,1,1,1))
7180 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7181 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7182 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7183 & ADtEA1derx(1,1,1,1,1,1))
7185 C End 6-th order cumulants
7186 call transpose2(EUgder(1,1,k),auxmat(1,1))
7187 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7188 call transpose2(EUg(1,1,k),auxmat(1,1))
7189 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7190 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7194 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7195 & EAEAderx(1,1,lll,kkk,iii,1))
7199 C A2T kernel(i+1)T A1
7200 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7201 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7202 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7203 C Following matrices are needed only for 6-th order cumulants
7204 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7205 & j.eq.i+4 .and. l.eq.i+3)) THEN
7206 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7207 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7208 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7209 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7210 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7211 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7212 & ADtEAderx(1,1,1,1,1,2))
7213 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7214 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7215 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7216 & ADtEA1derx(1,1,1,1,1,2))
7218 C End 6-th order cumulants
7219 call transpose2(EUgder(1,1,j),auxmat(1,1))
7220 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7221 call transpose2(EUg(1,1,j),auxmat(1,1))
7222 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7223 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7227 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7228 & EAEAderx(1,1,lll,kkk,iii,2))
7233 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7234 C They are needed only when the fifth- or the sixth-order cumulants are
7236 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7237 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7238 call transpose2(AEA(1,1,1),auxmat(1,1))
7239 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7240 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7241 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7242 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7243 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7244 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7245 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7246 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7247 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7248 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7249 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7250 call transpose2(AEA(1,1,2),auxmat(1,1))
7251 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7252 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7253 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7254 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7255 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7256 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7257 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7258 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7259 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7260 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7261 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7262 C Calculate the Cartesian derivatives of the vectors.
7266 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7267 call matvec2(auxmat(1,1),b1(1,iti),
7268 & AEAb1derx(1,lll,kkk,iii,1,1))
7269 call matvec2(auxmat(1,1),Ub2(1,i),
7270 & AEAb2derx(1,lll,kkk,iii,1,1))
7271 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7272 & AEAb1derx(1,lll,kkk,iii,2,1))
7273 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7274 & AEAb2derx(1,lll,kkk,iii,2,1))
7275 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7276 call matvec2(auxmat(1,1),b1(1,itl),
7277 & AEAb1derx(1,lll,kkk,iii,1,2))
7278 call matvec2(auxmat(1,1),Ub2(1,l),
7279 & AEAb2derx(1,lll,kkk,iii,1,2))
7280 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7281 & AEAb1derx(1,lll,kkk,iii,2,2))
7282 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7283 & AEAb2derx(1,lll,kkk,iii,2,2))
7292 C---------------------------------------------------------------------------
7293 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7294 & KK,KKderg,AKA,AKAderg,AKAderx)
7298 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7299 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7300 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7305 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7307 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7310 cd if (lprn) write (2,*) 'In kernel'
7312 cd if (lprn) write (2,*) 'kkk=',kkk
7314 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7315 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7317 cd write (2,*) 'lll=',lll
7318 cd write (2,*) 'iii=1'
7320 cd write (2,'(3(2f10.5),5x)')
7321 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7324 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7325 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7327 cd write (2,*) 'lll=',lll
7328 cd write (2,*) 'iii=2'
7330 cd write (2,'(3(2f10.5),5x)')
7331 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7338 C---------------------------------------------------------------------------
7339 double precision function eello4(i,j,k,l,jj,kk)
7340 implicit real*8 (a-h,o-z)
7341 include 'DIMENSIONS'
7342 include 'COMMON.IOUNITS'
7343 include 'COMMON.CHAIN'
7344 include 'COMMON.DERIV'
7345 include 'COMMON.INTERACT'
7346 include 'COMMON.CONTACTS'
7347 include 'COMMON.TORSION'
7348 include 'COMMON.VAR'
7349 include 'COMMON.GEO'
7350 double precision pizda(2,2),ggg1(3),ggg2(3)
7351 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7355 cd print *,'eello4:',i,j,k,l,jj,kk
7356 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7357 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7358 cold eij=facont_hb(jj,i)
7359 cold ekl=facont_hb(kk,k)
7361 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7362 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7363 gcorr_loc(k-1)=gcorr_loc(k-1)
7364 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7366 gcorr_loc(l-1)=gcorr_loc(l-1)
7367 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7369 gcorr_loc(j-1)=gcorr_loc(j-1)
7370 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7375 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7376 & -EAEAderx(2,2,lll,kkk,iii,1)
7377 cd derx(lll,kkk,iii)=0.0d0
7381 cd gcorr_loc(l-1)=0.0d0
7382 cd gcorr_loc(j-1)=0.0d0
7383 cd gcorr_loc(k-1)=0.0d0
7385 cd write (iout,*)'Contacts have occurred for peptide groups',
7386 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7387 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7388 if (j.lt.nres-1) then
7395 if (l.lt.nres-1) then
7403 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7404 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7405 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7406 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7407 cgrad ghalf=0.5d0*ggg1(ll)
7408 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7409 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7410 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7411 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7412 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7413 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7414 cgrad ghalf=0.5d0*ggg2(ll)
7415 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7416 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7417 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7418 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7419 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7420 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7424 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7429 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7434 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7439 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7443 cd write (2,*) iii,gcorr_loc(iii)
7446 cd write (2,*) 'ekont',ekont
7447 cd write (iout,*) 'eello4',ekont*eel4
7450 C---------------------------------------------------------------------------
7451 double precision function eello5(i,j,k,l,jj,kk)
7452 implicit real*8 (a-h,o-z)
7453 include 'DIMENSIONS'
7454 include 'COMMON.IOUNITS'
7455 include 'COMMON.CHAIN'
7456 include 'COMMON.DERIV'
7457 include 'COMMON.INTERACT'
7458 include 'COMMON.CONTACTS'
7459 include 'COMMON.TORSION'
7460 include 'COMMON.VAR'
7461 include 'COMMON.GEO'
7462 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7463 double precision ggg1(3),ggg2(3)
7464 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7469 C /l\ / \ \ / \ / \ / C
7470 C / \ / \ \ / \ / \ / C
7471 C j| o |l1 | o | o| o | | o |o C
7472 C \ |/k\| |/ \| / |/ \| |/ \| C
7473 C \i/ \ / \ / / \ / \ C
7475 C (I) (II) (III) (IV) C
7477 C eello5_1 eello5_2 eello5_3 eello5_4 C
7479 C Antiparallel chains C
7482 C /j\ / \ \ / \ / \ / C
7483 C / \ / \ \ / \ / \ / C
7484 C j1| o |l | o | o| o | | o |o C
7485 C \ |/k\| |/ \| / |/ \| |/ \| C
7486 C \i/ \ / \ / / \ / \ C
7488 C (I) (II) (III) (IV) C
7490 C eello5_1 eello5_2 eello5_3 eello5_4 C
7492 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7494 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7495 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7500 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7502 itk=itortyp(itype(k))
7503 itl=itortyp(itype(l))
7504 itj=itortyp(itype(j))
7509 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7510 cd & eel5_3_num,eel5_4_num)
7514 derx(lll,kkk,iii)=0.0d0
7518 cd eij=facont_hb(jj,i)
7519 cd ekl=facont_hb(kk,k)
7521 cd write (iout,*)'Contacts have occurred for peptide groups',
7522 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7524 C Contribution from the graph I.
7525 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7526 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7527 call transpose2(EUg(1,1,k),auxmat(1,1))
7528 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7529 vv(1)=pizda(1,1)-pizda(2,2)
7530 vv(2)=pizda(1,2)+pizda(2,1)
7531 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7533 C Explicit gradient in virtual-dihedral angles.
7534 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7535 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7536 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7537 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7538 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7539 vv(1)=pizda(1,1)-pizda(2,2)
7540 vv(2)=pizda(1,2)+pizda(2,1)
7541 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7542 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7543 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7544 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7545 vv(1)=pizda(1,1)-pizda(2,2)
7546 vv(2)=pizda(1,2)+pizda(2,1)
7548 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7549 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7550 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7552 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7553 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7554 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7556 C Cartesian gradient
7560 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7562 vv(1)=pizda(1,1)-pizda(2,2)
7563 vv(2)=pizda(1,2)+pizda(2,1)
7564 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7565 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7566 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7572 C Contribution from graph II
7573 call transpose2(EE(1,1,itk),auxmat(1,1))
7574 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7575 vv(1)=pizda(1,1)+pizda(2,2)
7576 vv(2)=pizda(2,1)-pizda(1,2)
7577 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7578 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7579 C Explicit gradient in virtual-dihedral angles.
7580 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7581 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7582 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7583 vv(1)=pizda(1,1)+pizda(2,2)
7584 vv(2)=pizda(2,1)-pizda(1,2)
7586 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7587 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7588 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7590 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7591 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7592 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7594 C Cartesian gradient
7598 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7600 vv(1)=pizda(1,1)+pizda(2,2)
7601 vv(2)=pizda(2,1)-pizda(1,2)
7602 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7603 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7604 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7612 C Parallel orientation
7613 C Contribution from graph III
7614 call transpose2(EUg(1,1,l),auxmat(1,1))
7615 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7616 vv(1)=pizda(1,1)-pizda(2,2)
7617 vv(2)=pizda(1,2)+pizda(2,1)
7618 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7619 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7620 C Explicit gradient in virtual-dihedral angles.
7621 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7622 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7623 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7624 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7625 vv(1)=pizda(1,1)-pizda(2,2)
7626 vv(2)=pizda(1,2)+pizda(2,1)
7627 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7628 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7629 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7630 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7631 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7635 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7636 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7637 C Cartesian gradient
7641 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7643 vv(1)=pizda(1,1)-pizda(2,2)
7644 vv(2)=pizda(1,2)+pizda(2,1)
7645 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7646 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7647 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7652 C Contribution from graph IV
7654 call transpose2(EE(1,1,itl),auxmat(1,1))
7655 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7656 vv(1)=pizda(1,1)+pizda(2,2)
7657 vv(2)=pizda(2,1)-pizda(1,2)
7658 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7659 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7660 C Explicit gradient in virtual-dihedral angles.
7661 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7662 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7663 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7664 vv(1)=pizda(1,1)+pizda(2,2)
7665 vv(2)=pizda(2,1)-pizda(1,2)
7666 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7667 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7668 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7669 C Cartesian gradient
7673 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7675 vv(1)=pizda(1,1)+pizda(2,2)
7676 vv(2)=pizda(2,1)-pizda(1,2)
7677 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7678 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7679 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7684 C Antiparallel orientation
7685 C Contribution from graph III
7687 call transpose2(EUg(1,1,j),auxmat(1,1))
7688 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7689 vv(1)=pizda(1,1)-pizda(2,2)
7690 vv(2)=pizda(1,2)+pizda(2,1)
7691 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7692 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7693 C Explicit gradient in virtual-dihedral angles.
7694 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7695 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7696 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7697 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7698 vv(1)=pizda(1,1)-pizda(2,2)
7699 vv(2)=pizda(1,2)+pizda(2,1)
7700 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7701 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7702 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7703 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7704 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7705 vv(1)=pizda(1,1)-pizda(2,2)
7706 vv(2)=pizda(1,2)+pizda(2,1)
7707 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7708 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7709 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7710 C Cartesian gradient
7714 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7716 vv(1)=pizda(1,1)-pizda(2,2)
7717 vv(2)=pizda(1,2)+pizda(2,1)
7718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7719 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7720 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7725 C Contribution from graph IV
7727 call transpose2(EE(1,1,itj),auxmat(1,1))
7728 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7729 vv(1)=pizda(1,1)+pizda(2,2)
7730 vv(2)=pizda(2,1)-pizda(1,2)
7731 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7732 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7733 C Explicit gradient in virtual-dihedral angles.
7734 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7735 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7736 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7737 vv(1)=pizda(1,1)+pizda(2,2)
7738 vv(2)=pizda(2,1)-pizda(1,2)
7739 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7740 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7741 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7742 C Cartesian gradient
7746 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7748 vv(1)=pizda(1,1)+pizda(2,2)
7749 vv(2)=pizda(2,1)-pizda(1,2)
7750 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7751 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7752 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7758 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7759 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7760 cd write (2,*) 'ijkl',i,j,k,l
7761 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7762 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7764 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7765 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7766 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7767 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7768 if (j.lt.nres-1) then
7775 if (l.lt.nres-1) then
7785 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7786 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7787 C summed up outside the subrouine as for the other subroutines
7788 C handling long-range interactions. The old code is commented out
7789 C with "cgrad" to keep track of changes.
7791 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7792 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7793 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7794 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7795 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7796 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7797 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7798 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7799 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7800 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7802 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7803 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7804 cgrad ghalf=0.5d0*ggg1(ll)
7806 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7807 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7808 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7809 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7810 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7811 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7812 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7813 cgrad ghalf=0.5d0*ggg2(ll)
7815 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7816 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7817 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7818 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7819 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7820 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7825 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7826 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7831 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7832 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7838 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7843 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7847 cd write (2,*) iii,g_corr5_loc(iii)
7850 cd write (2,*) 'ekont',ekont
7851 cd write (iout,*) 'eello5',ekont*eel5
7854 c--------------------------------------------------------------------------
7855 double precision function eello6(i,j,k,l,jj,kk)
7856 implicit real*8 (a-h,o-z)
7857 include 'DIMENSIONS'
7858 include 'COMMON.IOUNITS'
7859 include 'COMMON.CHAIN'
7860 include 'COMMON.DERIV'
7861 include 'COMMON.INTERACT'
7862 include 'COMMON.CONTACTS'
7863 include 'COMMON.TORSION'
7864 include 'COMMON.VAR'
7865 include 'COMMON.GEO'
7866 include 'COMMON.FFIELD'
7867 double precision ggg1(3),ggg2(3)
7868 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7873 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7881 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7882 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7886 derx(lll,kkk,iii)=0.0d0
7890 cd eij=facont_hb(jj,i)
7891 cd ekl=facont_hb(kk,k)
7897 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7898 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7899 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7900 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7901 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7902 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7904 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7905 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7906 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7907 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7908 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7909 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7913 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7915 C If turn contributions are considered, they will be handled separately.
7916 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7917 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7918 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7919 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7920 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7921 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7922 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7924 if (j.lt.nres-1) then
7931 if (l.lt.nres-1) then
7939 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7940 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7941 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7942 cgrad ghalf=0.5d0*ggg1(ll)
7944 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7945 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7946 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7947 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7948 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7949 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7950 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7951 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7952 cgrad ghalf=0.5d0*ggg2(ll)
7953 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7955 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7956 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7957 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7958 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7959 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7960 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7965 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7966 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7971 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7972 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7978 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7983 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7987 cd write (2,*) iii,g_corr6_loc(iii)
7990 cd write (2,*) 'ekont',ekont
7991 cd write (iout,*) 'eello6',ekont*eel6
7994 c--------------------------------------------------------------------------
7995 double precision function eello6_graph1(i,j,k,l,imat,swap)
7996 implicit real*8 (a-h,o-z)
7997 include 'DIMENSIONS'
7998 include 'COMMON.IOUNITS'
7999 include 'COMMON.CHAIN'
8000 include 'COMMON.DERIV'
8001 include 'COMMON.INTERACT'
8002 include 'COMMON.CONTACTS'
8003 include 'COMMON.TORSION'
8004 include 'COMMON.VAR'
8005 include 'COMMON.GEO'
8006 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8010 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8012 C Parallel Antiparallel
8018 C \ j|/k\| / \ |/k\|l /
8023 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8024 itk=itortyp(itype(k))
8025 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8026 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8027 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8028 call transpose2(EUgC(1,1,k),auxmat(1,1))
8029 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8030 vv1(1)=pizda1(1,1)-pizda1(2,2)
8031 vv1(2)=pizda1(1,2)+pizda1(2,1)
8032 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8033 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8034 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8035 s5=scalar2(vv(1),Dtobr2(1,i))
8036 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8037 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8038 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8039 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8040 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8041 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8042 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8043 & +scalar2(vv(1),Dtobr2der(1,i)))
8044 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8045 vv1(1)=pizda1(1,1)-pizda1(2,2)
8046 vv1(2)=pizda1(1,2)+pizda1(2,1)
8047 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8048 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8050 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8051 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8052 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8053 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8054 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8056 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8057 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8058 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8059 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8060 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8062 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8063 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8064 vv1(1)=pizda1(1,1)-pizda1(2,2)
8065 vv1(2)=pizda1(1,2)+pizda1(2,1)
8066 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8067 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8068 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8069 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8078 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8079 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8080 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8081 call transpose2(EUgC(1,1,k),auxmat(1,1))
8082 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8084 vv1(1)=pizda1(1,1)-pizda1(2,2)
8085 vv1(2)=pizda1(1,2)+pizda1(2,1)
8086 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8087 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8088 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8089 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8090 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8091 s5=scalar2(vv(1),Dtobr2(1,i))
8092 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8098 c----------------------------------------------------------------------------
8099 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8100 implicit real*8 (a-h,o-z)
8101 include 'DIMENSIONS'
8102 include 'COMMON.IOUNITS'
8103 include 'COMMON.CHAIN'
8104 include 'COMMON.DERIV'
8105 include 'COMMON.INTERACT'
8106 include 'COMMON.CONTACTS'
8107 include 'COMMON.TORSION'
8108 include 'COMMON.VAR'
8109 include 'COMMON.GEO'
8111 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8112 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8115 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8117 C Parallel Antiparallel
8128 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8129 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8130 C AL 7/4/01 s1 would occur in the sixth-order moment,
8131 C but not in a cluster cumulant
8133 s1=dip(1,jj,i)*dip(1,kk,k)
8135 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8136 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8137 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8138 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8139 call transpose2(EUg(1,1,k),auxmat(1,1))
8140 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8141 vv(1)=pizda(1,1)-pizda(2,2)
8142 vv(2)=pizda(1,2)+pizda(2,1)
8143 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8144 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8146 eello6_graph2=-(s1+s2+s3+s4)
8148 eello6_graph2=-(s2+s3+s4)
8151 C Derivatives in gamma(i-1)
8154 s1=dipderg(1,jj,i)*dip(1,kk,k)
8156 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8157 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8158 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8159 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8161 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8163 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8165 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8167 C Derivatives in gamma(k-1)
8169 s1=dip(1,jj,i)*dipderg(1,kk,k)
8171 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8172 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8173 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8174 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8175 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8176 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8177 vv(1)=pizda(1,1)-pizda(2,2)
8178 vv(2)=pizda(1,2)+pizda(2,1)
8179 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8181 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8183 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8185 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8186 C Derivatives in gamma(j-1) or gamma(l-1)
8189 s1=dipderg(3,jj,i)*dip(1,kk,k)
8191 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8192 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8193 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8194 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8195 vv(1)=pizda(1,1)-pizda(2,2)
8196 vv(2)=pizda(1,2)+pizda(2,1)
8197 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8200 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8202 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8205 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8206 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8208 C Derivatives in gamma(l-1) or gamma(j-1)
8211 s1=dip(1,jj,i)*dipderg(3,kk,k)
8213 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8214 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8215 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8216 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8217 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8218 vv(1)=pizda(1,1)-pizda(2,2)
8219 vv(2)=pizda(1,2)+pizda(2,1)
8220 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8223 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8225 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8228 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8229 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8231 C Cartesian derivatives.
8233 write (2,*) 'In eello6_graph2'
8235 write (2,*) 'iii=',iii
8237 write (2,*) 'kkk=',kkk
8239 write (2,'(3(2f10.5),5x)')
8240 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8250 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8252 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8255 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8257 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8258 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8260 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8261 call transpose2(EUg(1,1,k),auxmat(1,1))
8262 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8264 vv(1)=pizda(1,1)-pizda(2,2)
8265 vv(2)=pizda(1,2)+pizda(2,1)
8266 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8267 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8269 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8271 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8274 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8276 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8283 c----------------------------------------------------------------------------
8284 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8285 implicit real*8 (a-h,o-z)
8286 include 'DIMENSIONS'
8287 include 'COMMON.IOUNITS'
8288 include 'COMMON.CHAIN'
8289 include 'COMMON.DERIV'
8290 include 'COMMON.INTERACT'
8291 include 'COMMON.CONTACTS'
8292 include 'COMMON.TORSION'
8293 include 'COMMON.VAR'
8294 include 'COMMON.GEO'
8295 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8297 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8299 C Parallel Antiparallel
8310 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8312 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8313 C energy moment and not to the cluster cumulant.
8314 iti=itortyp(itype(i))
8315 if (j.lt.nres-1) then
8316 itj1=itortyp(itype(j+1))
8320 itk=itortyp(itype(k))
8321 itk1=itortyp(itype(k+1))
8322 if (l.lt.nres-1) then
8323 itl1=itortyp(itype(l+1))
8328 s1=dip(4,jj,i)*dip(4,kk,k)
8330 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8331 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8332 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8333 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8334 call transpose2(EE(1,1,itk),auxmat(1,1))
8335 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8336 vv(1)=pizda(1,1)+pizda(2,2)
8337 vv(2)=pizda(2,1)-pizda(1,2)
8338 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8339 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8340 cd & "sum",-(s2+s3+s4)
8342 eello6_graph3=-(s1+s2+s3+s4)
8344 eello6_graph3=-(s2+s3+s4)
8347 C Derivatives in gamma(k-1)
8348 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8349 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8350 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8351 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8352 C Derivatives in gamma(l-1)
8353 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8354 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8355 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8356 vv(1)=pizda(1,1)+pizda(2,2)
8357 vv(2)=pizda(2,1)-pizda(1,2)
8358 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8359 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8360 C Cartesian derivatives.
8366 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8368 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8371 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8373 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8374 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8376 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8377 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8379 vv(1)=pizda(1,1)+pizda(2,2)
8380 vv(2)=pizda(2,1)-pizda(1,2)
8381 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8383 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8385 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8388 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8390 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8392 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8398 c----------------------------------------------------------------------------
8399 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8400 implicit real*8 (a-h,o-z)
8401 include 'DIMENSIONS'
8402 include 'COMMON.IOUNITS'
8403 include 'COMMON.CHAIN'
8404 include 'COMMON.DERIV'
8405 include 'COMMON.INTERACT'
8406 include 'COMMON.CONTACTS'
8407 include 'COMMON.TORSION'
8408 include 'COMMON.VAR'
8409 include 'COMMON.GEO'
8410 include 'COMMON.FFIELD'
8411 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8412 & auxvec1(2),auxmat1(2,2)
8414 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8416 C Parallel Antiparallel
8427 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8429 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8430 C energy moment and not to the cluster cumulant.
8431 cd write (2,*) 'eello_graph4: wturn6',wturn6
8432 iti=itortyp(itype(i))
8433 itj=itortyp(itype(j))
8434 if (j.lt.nres-1) then
8435 itj1=itortyp(itype(j+1))
8439 itk=itortyp(itype(k))
8440 if (k.lt.nres-1) then
8441 itk1=itortyp(itype(k+1))
8445 itl=itortyp(itype(l))
8446 if (l.lt.nres-1) then
8447 itl1=itortyp(itype(l+1))
8451 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8452 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8453 cd & ' itl',itl,' itl1',itl1
8456 s1=dip(3,jj,i)*dip(3,kk,k)
8458 s1=dip(2,jj,j)*dip(2,kk,l)
8461 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8462 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8464 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8465 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8467 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8468 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8470 call transpose2(EUg(1,1,k),auxmat(1,1))
8471 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8472 vv(1)=pizda(1,1)-pizda(2,2)
8473 vv(2)=pizda(2,1)+pizda(1,2)
8474 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8475 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8477 eello6_graph4=-(s1+s2+s3+s4)
8479 eello6_graph4=-(s2+s3+s4)
8481 C Derivatives in gamma(i-1)
8485 s1=dipderg(2,jj,i)*dip(3,kk,k)
8487 s1=dipderg(4,jj,j)*dip(2,kk,l)
8490 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8492 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8493 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8495 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8496 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8498 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8499 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8500 cd write (2,*) 'turn6 derivatives'
8502 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8504 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8508 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8510 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8514 C Derivatives in gamma(k-1)
8517 s1=dip(3,jj,i)*dipderg(2,kk,k)
8519 s1=dip(2,jj,j)*dipderg(4,kk,l)
8522 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8523 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8525 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8526 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8528 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8529 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8531 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8532 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8533 vv(1)=pizda(1,1)-pizda(2,2)
8534 vv(2)=pizda(2,1)+pizda(1,2)
8535 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8536 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8538 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8540 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8544 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8546 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8549 C Derivatives in gamma(j-1) or gamma(l-1)
8550 if (l.eq.j+1 .and. l.gt.1) then
8551 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8552 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8553 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8554 vv(1)=pizda(1,1)-pizda(2,2)
8555 vv(2)=pizda(2,1)+pizda(1,2)
8556 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8557 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8558 else if (j.gt.1) then
8559 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8560 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8561 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8562 vv(1)=pizda(1,1)-pizda(2,2)
8563 vv(2)=pizda(2,1)+pizda(1,2)
8564 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8565 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8566 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8568 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8571 C Cartesian derivatives.
8578 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8580 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8584 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8586 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8590 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8592 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8594 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8595 & b1(1,itj1),auxvec(1))
8596 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8598 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8599 & b1(1,itl1),auxvec(1))
8600 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8602 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8604 vv(1)=pizda(1,1)-pizda(2,2)
8605 vv(2)=pizda(2,1)+pizda(1,2)
8606 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8608 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8610 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8613 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8616 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8619 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8621 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8623 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8627 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8629 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8632 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8634 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8642 c----------------------------------------------------------------------------
8643 double precision function eello_turn6(i,jj,kk)
8644 implicit real*8 (a-h,o-z)
8645 include 'DIMENSIONS'
8646 include 'COMMON.IOUNITS'
8647 include 'COMMON.CHAIN'
8648 include 'COMMON.DERIV'
8649 include 'COMMON.INTERACT'
8650 include 'COMMON.CONTACTS'
8651 include 'COMMON.TORSION'
8652 include 'COMMON.VAR'
8653 include 'COMMON.GEO'
8654 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8655 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8657 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8658 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8659 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8660 C the respective energy moment and not to the cluster cumulant.
8669 iti=itortyp(itype(i))
8670 itk=itortyp(itype(k))
8671 itk1=itortyp(itype(k+1))
8672 itl=itortyp(itype(l))
8673 itj=itortyp(itype(j))
8674 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8675 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8676 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8681 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8683 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8687 derx_turn(lll,kkk,iii)=0.0d0
8694 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8696 cd write (2,*) 'eello6_5',eello6_5
8698 call transpose2(AEA(1,1,1),auxmat(1,1))
8699 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8700 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8701 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8703 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8704 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8705 s2 = scalar2(b1(1,itk),vtemp1(1))
8707 call transpose2(AEA(1,1,2),atemp(1,1))
8708 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8709 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8710 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8712 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8713 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8714 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8716 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8717 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8718 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8719 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8720 ss13 = scalar2(b1(1,itk),vtemp4(1))
8721 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8723 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8729 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8730 C Derivatives in gamma(i+2)
8734 call transpose2(AEA(1,1,1),auxmatd(1,1))
8735 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8736 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8737 call transpose2(AEAderg(1,1,2),atempd(1,1))
8738 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8739 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8741 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8742 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8743 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8749 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8750 C Derivatives in gamma(i+3)
8752 call transpose2(AEA(1,1,1),auxmatd(1,1))
8753 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8754 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8755 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8757 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8758 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8759 s2d = scalar2(b1(1,itk),vtemp1d(1))
8761 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8762 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8764 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8766 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8767 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8768 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8776 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8777 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8779 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8780 & -0.5d0*ekont*(s2d+s12d)
8782 C Derivatives in gamma(i+4)
8783 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8784 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8785 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8787 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8788 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8789 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8797 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8799 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8801 C Derivatives in gamma(i+5)
8803 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8804 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8805 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8807 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8808 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8809 s2d = scalar2(b1(1,itk),vtemp1d(1))
8811 call transpose2(AEA(1,1,2),atempd(1,1))
8812 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8813 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8815 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8816 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8818 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8819 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8820 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8828 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8829 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8831 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8832 & -0.5d0*ekont*(s2d+s12d)
8834 C Cartesian derivatives
8839 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8840 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8841 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8843 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8844 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8846 s2d = scalar2(b1(1,itk),vtemp1d(1))
8848 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8849 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8850 s8d = -(atempd(1,1)+atempd(2,2))*
8851 & scalar2(cc(1,1,itl),vtemp2(1))
8853 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8855 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8856 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8863 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8866 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8870 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8871 & - 0.5d0*(s8d+s12d)
8873 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8882 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8884 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8885 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8886 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8887 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8888 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8890 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8891 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8892 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8896 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8897 cd & 16*eel_turn6_num
8899 if (j.lt.nres-1) then
8906 if (l.lt.nres-1) then
8914 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8915 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8916 cgrad ghalf=0.5d0*ggg1(ll)
8918 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8919 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8920 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8921 & +ekont*derx_turn(ll,2,1)
8922 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8923 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8924 & +ekont*derx_turn(ll,4,1)
8925 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8926 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8927 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8928 cgrad ghalf=0.5d0*ggg2(ll)
8930 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8931 & +ekont*derx_turn(ll,2,2)
8932 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8933 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8934 & +ekont*derx_turn(ll,4,2)
8935 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8936 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8937 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8942 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8947 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8953 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8958 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8962 cd write (2,*) iii,g_corr6_loc(iii)
8964 eello_turn6=ekont*eel_turn6
8965 cd write (2,*) 'ekont',ekont
8966 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8970 C-----------------------------------------------------------------------------
8971 double precision function scalar(u,v)
8972 !DIR$ INLINEALWAYS scalar
8974 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8977 double precision u(3),v(3)
8978 cd double precision sc
8986 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8989 crc-------------------------------------------------
8990 SUBROUTINE MATVEC2(A1,V1,V2)
8991 !DIR$ INLINEALWAYS MATVEC2
8993 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8995 implicit real*8 (a-h,o-z)
8996 include 'DIMENSIONS'
8997 DIMENSION A1(2,2),V1(2),V2(2)
9001 c 3 VI=VI+A1(I,K)*V1(K)
9005 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9006 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9011 C---------------------------------------
9012 SUBROUTINE MATMAT2(A1,A2,A3)
9014 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9016 implicit real*8 (a-h,o-z)
9017 include 'DIMENSIONS'
9018 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9019 c DIMENSION AI3(2,2)
9023 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9029 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9030 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9031 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9032 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9040 c-------------------------------------------------------------------------
9041 double precision function scalar2(u,v)
9042 !DIR$ INLINEALWAYS scalar2
9044 double precision u(2),v(2)
9047 scalar2=u(1)*v(1)+u(2)*v(2)
9051 C-----------------------------------------------------------------------------
9053 subroutine transpose2(a,at)
9054 !DIR$ INLINEALWAYS transpose2
9056 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9059 double precision a(2,2),at(2,2)
9066 c--------------------------------------------------------------------------
9067 subroutine transpose(n,a,at)
9070 double precision a(n,n),at(n,n)
9078 C---------------------------------------------------------------------------
9079 subroutine prodmat3(a1,a2,kk,transp,prod)
9080 !DIR$ INLINEALWAYS prodmat3
9082 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9086 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9088 crc double precision auxmat(2,2),prod_(2,2)
9091 crc call transpose2(kk(1,1),auxmat(1,1))
9092 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9093 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9095 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9096 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9097 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9098 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9099 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9100 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9101 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9102 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9105 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9106 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9108 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9109 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9110 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9111 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9112 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9113 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9114 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9115 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9118 c call transpose2(a2(1,1),a2t(1,1))
9121 crc print *,((prod_(i,j),i=1,2),j=1,2)
9122 crc print *,((prod(i,j),i=1,2),j=1,2)