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'
486 include 'COMMON.SCCOR'
495 write (iout,*) "sum_gradient gvdwc, gvdwx"
497 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
498 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
499 & (gvdwcT(j,i),j=1,3)
504 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
505 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
506 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
509 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
510 C in virtual-bond-vector coordinates
513 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
515 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
516 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
518 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
520 c write (iout,'(i5,3f10.5,2x,f10.5)')
521 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
523 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
525 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
526 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
535 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
536 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
537 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
538 & wel_loc*gel_loc_long(j,i)+
539 & wcorr*gradcorr_long(j,i)+
540 & wcorr5*gradcorr5_long(j,i)+
541 & wcorr6*gradcorr6_long(j,i)+
542 & wturn6*gcorr6_turn_long(j,i)+
549 gradbufc(j,i)=wsc*gvdwc(j,i)+
550 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
551 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
552 & wel_loc*gel_loc_long(j,i)+
553 & wcorr*gradcorr_long(j,i)+
554 & wcorr5*gradcorr5_long(j,i)+
555 & wcorr6*gradcorr6_long(j,i)+
556 & wturn6*gcorr6_turn_long(j,i)+
564 gradbufc(j,i)=wsc*gvdwc(j,i)+
565 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
566 & welec*gelc_long(j,i)+
568 & wel_loc*gel_loc_long(j,i)+
569 & wcorr*gradcorr_long(j,i)+
570 & wcorr5*gradcorr5_long(j,i)+
571 & wcorr6*gradcorr6_long(j,i)+
572 & wturn6*gcorr6_turn_long(j,i)+
578 if (nfgtasks.gt.1) then
581 write (iout,*) "gradbufc before allreduce"
583 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
589 gradbufc_sum(j,i)=gradbufc(j,i)
592 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
593 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
594 c time_reduce=time_reduce+MPI_Wtime()-time00
596 c write (iout,*) "gradbufc_sum after allreduce"
598 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
603 c time_allreduce=time_allreduce+MPI_Wtime()-time00
611 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
612 write (iout,*) (i," jgrad_start",jgrad_start(i),
613 & " jgrad_end ",jgrad_end(i),
614 & i=igrad_start,igrad_end)
617 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
618 c do not parallelize this part.
620 c do i=igrad_start,igrad_end
621 c do j=jgrad_start(i),jgrad_end(i)
623 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
628 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
632 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
636 write (iout,*) "gradbufc after summing"
638 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
645 write (iout,*) "gradbufc"
647 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
653 gradbufc_sum(j,i)=gradbufc(j,i)
658 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
662 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
667 c gradbufc(k,i)=0.0d0
671 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
676 write (iout,*) "gradbufc after summing"
678 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
686 gradbufc(k,nres)=0.0d0
691 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
692 & wel_loc*gel_loc(j,i)+
693 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
694 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
695 & wel_loc*gel_loc_long(j,i)+
696 & wcorr*gradcorr_long(j,i)+
697 & wcorr5*gradcorr5_long(j,i)+
698 & wcorr6*gradcorr6_long(j,i)+
699 & wturn6*gcorr6_turn_long(j,i))+
701 & wcorr*gradcorr(j,i)+
702 & wturn3*gcorr3_turn(j,i)+
703 & wturn4*gcorr4_turn(j,i)+
704 & wcorr5*gradcorr5(j,i)+
705 & wcorr6*gradcorr6(j,i)+
706 & wturn6*gcorr6_turn(j,i)+
707 & wsccor*gsccorc(j,i)
708 & +wscloc*gscloc(j,i)
710 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
711 & wel_loc*gel_loc(j,i)+
712 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
713 & welec*gelc_long(j,i)+
714 & wel_loc*gel_loc_long(j,i)+
715 & wcorr*gcorr_long(j,i)+
716 & wcorr5*gradcorr5_long(j,i)+
717 & wcorr6*gradcorr6_long(j,i)+
718 & wturn6*gcorr6_turn_long(j,i))+
720 & wcorr*gradcorr(j,i)+
721 & wturn3*gcorr3_turn(j,i)+
722 & wturn4*gcorr4_turn(j,i)+
723 & wcorr5*gradcorr5(j,i)+
724 & wcorr6*gradcorr6(j,i)+
725 & wturn6*gcorr6_turn(j,i)+
726 & wsccor*gsccorc(j,i)
727 & +wscloc*gscloc(j,i)
730 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
731 & wscp*gradx_scp(j,i)+
733 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
734 & wsccor*gsccorx(j,i)
735 & +wscloc*gsclocx(j,i)
737 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
739 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
740 & wsccor*gsccorx(j,i)
741 & +wscloc*gsclocx(j,i)
746 write (iout,*) "gloc before adding corr"
748 write (iout,*) i,gloc(i,icg)
752 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
753 & +wcorr5*g_corr5_loc(i)
754 & +wcorr6*g_corr6_loc(i)
755 & +wturn4*gel_loc_turn4(i)
756 & +wturn3*gel_loc_turn3(i)
757 & +wturn6*gel_loc_turn6(i)
758 & +wel_loc*gel_loc_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 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 c write (iout,*) "gloci", gloc(i-3,icg)
5769 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5770 cd & rad2deg*phi0(i), rad2deg*drange(i),
5771 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5773 cd write (iout,*) 'edihcnstr',edihcnstr
5776 c----------------------------------------------------------------------------
5777 subroutine etor_d(etors_d)
5778 C 6/23/01 Compute double torsional energy
5779 implicit real*8 (a-h,o-z)
5780 include 'DIMENSIONS'
5781 include 'COMMON.VAR'
5782 include 'COMMON.GEO'
5783 include 'COMMON.LOCAL'
5784 include 'COMMON.TORSION'
5785 include 'COMMON.INTERACT'
5786 include 'COMMON.DERIV'
5787 include 'COMMON.CHAIN'
5788 include 'COMMON.NAMES'
5789 include 'COMMON.IOUNITS'
5790 include 'COMMON.FFIELD'
5791 include 'COMMON.TORCNSTR'
5793 C Set lprn=.true. for debugging
5797 do i=iphid_start,iphid_end
5798 itori=itortyp(itype(i-2))
5799 itori1=itortyp(itype(i-1))
5800 itori2=itortyp(itype(i))
5805 do j=1,ntermd_1(itori,itori1,itori2)
5806 v1cij=v1c(1,j,itori,itori1,itori2)
5807 v1sij=v1s(1,j,itori,itori1,itori2)
5808 v2cij=v1c(2,j,itori,itori1,itori2)
5809 v2sij=v1s(2,j,itori,itori1,itori2)
5810 cosphi1=dcos(j*phii)
5811 sinphi1=dsin(j*phii)
5812 cosphi2=dcos(j*phii1)
5813 sinphi2=dsin(j*phii1)
5814 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5815 & v2cij*cosphi2+v2sij*sinphi2
5816 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5817 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5819 do k=2,ntermd_2(itori,itori1,itori2)
5821 v1cdij = v2c(k,l,itori,itori1,itori2)
5822 v2cdij = v2c(l,k,itori,itori1,itori2)
5823 v1sdij = v2s(k,l,itori,itori1,itori2)
5824 v2sdij = v2s(l,k,itori,itori1,itori2)
5825 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5826 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5827 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5828 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5829 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5830 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5831 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5832 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5833 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5834 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5837 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5838 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5839 c write (iout,*) "gloci", gloc(i-3,icg)
5844 c------------------------------------------------------------------------------
5845 subroutine eback_sc_corr(esccor)
5846 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5847 c conformational states; temporarily implemented as differences
5848 c between UNRES torsional potentials (dependent on three types of
5849 c residues) and the torsional potentials dependent on all 20 types
5850 c of residues computed from AM1 energy surfaces of terminally-blocked
5851 c amino-acid residues.
5852 implicit real*8 (a-h,o-z)
5853 include 'DIMENSIONS'
5854 include 'COMMON.VAR'
5855 include 'COMMON.GEO'
5856 include 'COMMON.LOCAL'
5857 include 'COMMON.TORSION'
5858 include 'COMMON.SCCOR'
5859 include 'COMMON.INTERACT'
5860 include 'COMMON.DERIV'
5861 include 'COMMON.CHAIN'
5862 include 'COMMON.NAMES'
5863 include 'COMMON.IOUNITS'
5864 include 'COMMON.FFIELD'
5865 include 'COMMON.CONTROL'
5867 C Set lprn=.true. for debugging
5870 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5872 do i=iphi_start-1,iphi_end+1
5874 isccori=isccortyp(itype(i-2))
5875 isccori1=isccortyp(itype(i-1))
5877 cccc Added 9 May 2012
5878 cc Tauangle is torsional engle depending on the value of first digit
5879 c(see comment below)
5880 cc Omicron is flat angle depending on the value of first digit
5881 c(see comment below)
5884 do intertyp=1,1 !intertyp
5885 cc Added 09 May 2012 (Adasko)
5886 cc Intertyp means interaction type of backbone mainchain correlation:
5887 c 1 = SC...Ca...Ca...Ca
5888 c 2 = Ca...Ca...Ca...SC
5889 c 3 = SC...Ca...Ca...SC
5890 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5891 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5892 & (itype(i-1).eq.21)))
5893 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5894 & .or.(itype(i-2).eq.21)))
5895 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5896 & (itype(i-1).eq.21)))) cycle
5897 if ((intertyp.eq.2).and.(i.le.iphi_start-1)) cycle
5898 if ((intertyp.eq.1).and.(i.ge.iphi_end+1)) cycle
5899 do j=1,nterm_sccor(isccori,isccori1)
5900 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5901 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5902 cosphi=dcos(j*tauangle(intertyp,i))
5903 sinphi=dsin(j*tauangle(intertyp,i))
5904 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5905 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5907 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5908 c write (iout,*) "WTF",intertyp,i,itype(i),
5909 c &gloc_sc(intertyp,i-3,icg)
5911 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5912 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5913 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5914 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5915 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5919 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5923 c----------------------------------------------------------------------------
5924 subroutine multibody(ecorr)
5925 C This subroutine calculates multi-body contributions to energy following
5926 C the idea of Skolnick et al. If side chains I and J make a contact and
5927 C at the same time side chains I+1 and J+1 make a contact, an extra
5928 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5929 implicit real*8 (a-h,o-z)
5930 include 'DIMENSIONS'
5931 include 'COMMON.IOUNITS'
5932 include 'COMMON.DERIV'
5933 include 'COMMON.INTERACT'
5934 include 'COMMON.CONTACTS'
5935 double precision gx(3),gx1(3)
5938 C Set lprn=.true. for debugging
5942 write (iout,'(a)') 'Contact function values:'
5944 write (iout,'(i2,20(1x,i2,f10.5))')
5945 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5960 num_conti=num_cont(i)
5961 num_conti1=num_cont(i1)
5966 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5967 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5968 cd & ' ishift=',ishift
5969 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5970 C The system gains extra energy.
5971 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5972 endif ! j1==j+-ishift
5981 c------------------------------------------------------------------------------
5982 double precision function esccorr(i,j,k,l,jj,kk)
5983 implicit real*8 (a-h,o-z)
5984 include 'DIMENSIONS'
5985 include 'COMMON.IOUNITS'
5986 include 'COMMON.DERIV'
5987 include 'COMMON.INTERACT'
5988 include 'COMMON.CONTACTS'
5989 double precision gx(3),gx1(3)
5994 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5995 C Calculate the multi-body contribution to energy.
5996 C Calculate multi-body contributions to the gradient.
5997 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5998 cd & k,l,(gacont(m,kk,k),m=1,3)
6000 gx(m) =ekl*gacont(m,jj,i)
6001 gx1(m)=eij*gacont(m,kk,k)
6002 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6003 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6004 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6005 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6009 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6014 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6020 c------------------------------------------------------------------------------
6021 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6022 C This subroutine calculates multi-body contributions to hydrogen-bonding
6023 implicit real*8 (a-h,o-z)
6024 include 'DIMENSIONS'
6025 include 'COMMON.IOUNITS'
6028 parameter (max_cont=maxconts)
6029 parameter (max_dim=26)
6030 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6031 double precision zapas(max_dim,maxconts,max_fg_procs),
6032 & zapas_recv(max_dim,maxconts,max_fg_procs)
6033 common /przechowalnia/ zapas
6034 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6035 & status_array(MPI_STATUS_SIZE,maxconts*2)
6037 include 'COMMON.SETUP'
6038 include 'COMMON.FFIELD'
6039 include 'COMMON.DERIV'
6040 include 'COMMON.INTERACT'
6041 include 'COMMON.CONTACTS'
6042 include 'COMMON.CONTROL'
6043 include 'COMMON.LOCAL'
6044 double precision gx(3),gx1(3),time00
6047 C Set lprn=.true. for debugging
6052 if (nfgtasks.le.1) goto 30
6054 write (iout,'(a)') 'Contact function values before RECEIVE:'
6056 write (iout,'(2i3,50(1x,i2,f5.2))')
6057 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6058 & j=1,num_cont_hb(i))
6062 do i=1,ntask_cont_from
6065 do i=1,ntask_cont_to
6068 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6070 C Make the list of contacts to send to send to other procesors
6071 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6073 do i=iturn3_start,iturn3_end
6074 c write (iout,*) "make contact list turn3",i," num_cont",
6076 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6078 do i=iturn4_start,iturn4_end
6079 c write (iout,*) "make contact list turn4",i," num_cont",
6081 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6085 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6087 do j=1,num_cont_hb(i)
6090 iproc=iint_sent_local(k,jjc,ii)
6091 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6092 if (iproc.gt.0) then
6093 ncont_sent(iproc)=ncont_sent(iproc)+1
6094 nn=ncont_sent(iproc)
6096 zapas(2,nn,iproc)=jjc
6097 zapas(3,nn,iproc)=facont_hb(j,i)
6098 zapas(4,nn,iproc)=ees0p(j,i)
6099 zapas(5,nn,iproc)=ees0m(j,i)
6100 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6101 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6102 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6103 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6104 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6105 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6106 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6107 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6108 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6109 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6110 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6111 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6112 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6113 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6114 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6115 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6116 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6117 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6118 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6119 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6120 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6127 & "Numbers of contacts to be sent to other processors",
6128 & (ncont_sent(i),i=1,ntask_cont_to)
6129 write (iout,*) "Contacts sent"
6130 do ii=1,ntask_cont_to
6132 iproc=itask_cont_to(ii)
6133 write (iout,*) nn," contacts to processor",iproc,
6134 & " of CONT_TO_COMM group"
6136 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6144 CorrelID1=nfgtasks+fg_rank+1
6146 C Receive the numbers of needed contacts from other processors
6147 do ii=1,ntask_cont_from
6148 iproc=itask_cont_from(ii)
6150 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6151 & FG_COMM,req(ireq),IERR)
6153 c write (iout,*) "IRECV ended"
6155 C Send the number of contacts needed by other processors
6156 do ii=1,ntask_cont_to
6157 iproc=itask_cont_to(ii)
6159 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6160 & FG_COMM,req(ireq),IERR)
6162 c write (iout,*) "ISEND ended"
6163 c write (iout,*) "number of requests (nn)",ireq
6166 & call MPI_Waitall(ireq,req,status_array,ierr)
6168 c & "Numbers of contacts to be received from other processors",
6169 c & (ncont_recv(i),i=1,ntask_cont_from)
6173 do ii=1,ntask_cont_from
6174 iproc=itask_cont_from(ii)
6176 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6177 c & " of CONT_TO_COMM group"
6181 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6182 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6183 c write (iout,*) "ireq,req",ireq,req(ireq)
6186 C Send the contacts to processors that need them
6187 do ii=1,ntask_cont_to
6188 iproc=itask_cont_to(ii)
6190 c write (iout,*) nn," contacts to processor",iproc,
6191 c & " of CONT_TO_COMM group"
6194 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6195 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6196 c write (iout,*) "ireq,req",ireq,req(ireq)
6198 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6202 c write (iout,*) "number of requests (contacts)",ireq
6203 c write (iout,*) "req",(req(i),i=1,4)
6206 & call MPI_Waitall(ireq,req,status_array,ierr)
6207 do iii=1,ntask_cont_from
6208 iproc=itask_cont_from(iii)
6211 write (iout,*) "Received",nn," contacts from processor",iproc,
6212 & " of CONT_FROM_COMM group"
6215 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6220 ii=zapas_recv(1,i,iii)
6221 c Flag the received contacts to prevent double-counting
6222 jj=-zapas_recv(2,i,iii)
6223 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6225 nnn=num_cont_hb(ii)+1
6228 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6229 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6230 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6231 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6232 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6233 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6234 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6235 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6236 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6237 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6238 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6239 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6240 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6241 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6242 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6243 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6244 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6245 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6246 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6247 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6248 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6249 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6250 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6251 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6256 write (iout,'(a)') 'Contact function values after receive:'
6258 write (iout,'(2i3,50(1x,i3,f5.2))')
6259 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6260 & j=1,num_cont_hb(i))
6267 write (iout,'(a)') 'Contact function values:'
6269 write (iout,'(2i3,50(1x,i3,f5.2))')
6270 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6271 & j=1,num_cont_hb(i))
6275 C Remove the loop below after debugging !!!
6282 C Calculate the local-electrostatic correlation terms
6283 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6285 num_conti=num_cont_hb(i)
6286 num_conti1=num_cont_hb(i+1)
6293 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6294 c & ' jj=',jj,' kk=',kk
6295 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6296 & .or. j.lt.0 .and. j1.gt.0) .and.
6297 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6298 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6299 C The system gains extra energy.
6300 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6301 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6302 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6304 else if (j1.eq.j) then
6305 C Contacts I-J and I-(J+1) occur simultaneously.
6306 C The system loses extra energy.
6307 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6312 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6313 c & ' jj=',jj,' kk=',kk
6315 C Contacts I-J and (I+1)-J occur simultaneously.
6316 C The system loses extra energy.
6317 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6324 c------------------------------------------------------------------------------
6325 subroutine add_hb_contact(ii,jj,itask)
6326 implicit real*8 (a-h,o-z)
6327 include "DIMENSIONS"
6328 include "COMMON.IOUNITS"
6331 parameter (max_cont=maxconts)
6332 parameter (max_dim=26)
6333 include "COMMON.CONTACTS"
6334 double precision zapas(max_dim,maxconts,max_fg_procs),
6335 & zapas_recv(max_dim,maxconts,max_fg_procs)
6336 common /przechowalnia/ zapas
6337 integer i,j,ii,jj,iproc,itask(4),nn
6338 c write (iout,*) "itask",itask
6341 if (iproc.gt.0) then
6342 do j=1,num_cont_hb(ii)
6344 c write (iout,*) "i",ii," j",jj," jjc",jjc
6346 ncont_sent(iproc)=ncont_sent(iproc)+1
6347 nn=ncont_sent(iproc)
6348 zapas(1,nn,iproc)=ii
6349 zapas(2,nn,iproc)=jjc
6350 zapas(3,nn,iproc)=facont_hb(j,ii)
6351 zapas(4,nn,iproc)=ees0p(j,ii)
6352 zapas(5,nn,iproc)=ees0m(j,ii)
6353 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6354 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6355 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6356 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6357 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6358 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6359 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6360 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6361 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6362 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6363 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6364 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6365 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6366 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6367 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6368 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6369 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6370 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6371 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6372 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6373 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6381 c------------------------------------------------------------------------------
6382 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6384 C This subroutine calculates multi-body contributions to hydrogen-bonding
6385 implicit real*8 (a-h,o-z)
6386 include 'DIMENSIONS'
6387 include 'COMMON.IOUNITS'
6390 parameter (max_cont=maxconts)
6391 parameter (max_dim=70)
6392 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6393 double precision zapas(max_dim,maxconts,max_fg_procs),
6394 & zapas_recv(max_dim,maxconts,max_fg_procs)
6395 common /przechowalnia/ zapas
6396 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6397 & status_array(MPI_STATUS_SIZE,maxconts*2)
6399 include 'COMMON.SETUP'
6400 include 'COMMON.FFIELD'
6401 include 'COMMON.DERIV'
6402 include 'COMMON.LOCAL'
6403 include 'COMMON.INTERACT'
6404 include 'COMMON.CONTACTS'
6405 include 'COMMON.CHAIN'
6406 include 'COMMON.CONTROL'
6407 double precision gx(3),gx1(3)
6408 integer num_cont_hb_old(maxres)
6410 double precision eello4,eello5,eelo6,eello_turn6
6411 external eello4,eello5,eello6,eello_turn6
6412 C Set lprn=.true. for debugging
6417 num_cont_hb_old(i)=num_cont_hb(i)
6421 if (nfgtasks.le.1) goto 30
6423 write (iout,'(a)') 'Contact function values before RECEIVE:'
6425 write (iout,'(2i3,50(1x,i2,f5.2))')
6426 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6427 & j=1,num_cont_hb(i))
6431 do i=1,ntask_cont_from
6434 do i=1,ntask_cont_to
6437 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6439 C Make the list of contacts to send to send to other procesors
6440 do i=iturn3_start,iturn3_end
6441 c write (iout,*) "make contact list turn3",i," num_cont",
6443 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6445 do i=iturn4_start,iturn4_end
6446 c write (iout,*) "make contact list turn4",i," num_cont",
6448 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6452 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6454 do j=1,num_cont_hb(i)
6457 iproc=iint_sent_local(k,jjc,ii)
6458 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6459 if (iproc.ne.0) then
6460 ncont_sent(iproc)=ncont_sent(iproc)+1
6461 nn=ncont_sent(iproc)
6463 zapas(2,nn,iproc)=jjc
6464 zapas(3,nn,iproc)=d_cont(j,i)
6468 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6473 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6481 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6492 & "Numbers of contacts to be sent to other processors",
6493 & (ncont_sent(i),i=1,ntask_cont_to)
6494 write (iout,*) "Contacts sent"
6495 do ii=1,ntask_cont_to
6497 iproc=itask_cont_to(ii)
6498 write (iout,*) nn," contacts to processor",iproc,
6499 & " of CONT_TO_COMM group"
6501 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6509 CorrelID1=nfgtasks+fg_rank+1
6511 C Receive the numbers of needed contacts from other processors
6512 do ii=1,ntask_cont_from
6513 iproc=itask_cont_from(ii)
6515 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6516 & FG_COMM,req(ireq),IERR)
6518 c write (iout,*) "IRECV ended"
6520 C Send the number of contacts needed by other processors
6521 do ii=1,ntask_cont_to
6522 iproc=itask_cont_to(ii)
6524 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6525 & FG_COMM,req(ireq),IERR)
6527 c write (iout,*) "ISEND ended"
6528 c write (iout,*) "number of requests (nn)",ireq
6531 & call MPI_Waitall(ireq,req,status_array,ierr)
6533 c & "Numbers of contacts to be received from other processors",
6534 c & (ncont_recv(i),i=1,ntask_cont_from)
6538 do ii=1,ntask_cont_from
6539 iproc=itask_cont_from(ii)
6541 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6542 c & " of CONT_TO_COMM group"
6546 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6547 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6548 c write (iout,*) "ireq,req",ireq,req(ireq)
6551 C Send the contacts to processors that need them
6552 do ii=1,ntask_cont_to
6553 iproc=itask_cont_to(ii)
6555 c write (iout,*) nn," contacts to processor",iproc,
6556 c & " of CONT_TO_COMM group"
6559 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6560 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6561 c write (iout,*) "ireq,req",ireq,req(ireq)
6563 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6567 c write (iout,*) "number of requests (contacts)",ireq
6568 c write (iout,*) "req",(req(i),i=1,4)
6571 & call MPI_Waitall(ireq,req,status_array,ierr)
6572 do iii=1,ntask_cont_from
6573 iproc=itask_cont_from(iii)
6576 write (iout,*) "Received",nn," contacts from processor",iproc,
6577 & " of CONT_FROM_COMM group"
6580 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6585 ii=zapas_recv(1,i,iii)
6586 c Flag the received contacts to prevent double-counting
6587 jj=-zapas_recv(2,i,iii)
6588 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6590 nnn=num_cont_hb(ii)+1
6593 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6597 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6602 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6610 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6619 write (iout,'(a)') 'Contact function values after receive:'
6621 write (iout,'(2i3,50(1x,i3,5f6.3))')
6622 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6623 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6630 write (iout,'(a)') 'Contact function values:'
6632 write (iout,'(2i3,50(1x,i2,5f6.3))')
6633 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6634 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6640 C Remove the loop below after debugging !!!
6647 C Calculate the dipole-dipole interaction energies
6648 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6649 do i=iatel_s,iatel_e+1
6650 num_conti=num_cont_hb(i)
6659 C Calculate the local-electrostatic correlation terms
6660 c write (iout,*) "gradcorr5 in eello5 before loop"
6662 c write (iout,'(i5,3f10.5)')
6663 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6665 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6666 c write (iout,*) "corr loop i",i
6668 num_conti=num_cont_hb(i)
6669 num_conti1=num_cont_hb(i+1)
6676 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6677 c & ' jj=',jj,' kk=',kk
6678 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6679 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6680 & .or. j.lt.0 .and. j1.gt.0) .and.
6681 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6682 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6683 C The system gains extra energy.
6685 sqd1=dsqrt(d_cont(jj,i))
6686 sqd2=dsqrt(d_cont(kk,i1))
6687 sred_geom = sqd1*sqd2
6688 IF (sred_geom.lt.cutoff_corr) THEN
6689 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6691 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6692 cd & ' jj=',jj,' kk=',kk
6693 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6694 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6696 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6697 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6700 cd write (iout,*) 'sred_geom=',sred_geom,
6701 cd & ' ekont=',ekont,' fprim=',fprimcont,
6702 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6703 cd write (iout,*) "g_contij",g_contij
6704 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6705 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6706 call calc_eello(i,jp,i+1,jp1,jj,kk)
6707 if (wcorr4.gt.0.0d0)
6708 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6709 if (energy_dec.and.wcorr4.gt.0.0d0)
6710 1 write (iout,'(a6,4i5,0pf7.3)')
6711 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6712 c write (iout,*) "gradcorr5 before eello5"
6714 c write (iout,'(i5,3f10.5)')
6715 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6717 if (wcorr5.gt.0.0d0)
6718 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6719 c write (iout,*) "gradcorr5 after eello5"
6721 c write (iout,'(i5,3f10.5)')
6722 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6724 if (energy_dec.and.wcorr5.gt.0.0d0)
6725 1 write (iout,'(a6,4i5,0pf7.3)')
6726 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6727 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6728 cd write(2,*)'ijkl',i,jp,i+1,jp1
6729 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6730 & .or. wturn6.eq.0.0d0))then
6731 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6732 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6733 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6734 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6735 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6736 cd & 'ecorr6=',ecorr6
6737 cd write (iout,'(4e15.5)') sred_geom,
6738 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6739 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6740 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6741 else if (wturn6.gt.0.0d0
6742 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6743 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6744 eturn6=eturn6+eello_turn6(i,jj,kk)
6745 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6746 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6747 cd write (2,*) 'multibody_eello:eturn6',eturn6
6756 num_cont_hb(i)=num_cont_hb_old(i)
6758 c write (iout,*) "gradcorr5 in eello5"
6760 c write (iout,'(i5,3f10.5)')
6761 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6765 c------------------------------------------------------------------------------
6766 subroutine add_hb_contact_eello(ii,jj,itask)
6767 implicit real*8 (a-h,o-z)
6768 include "DIMENSIONS"
6769 include "COMMON.IOUNITS"
6772 parameter (max_cont=maxconts)
6773 parameter (max_dim=70)
6774 include "COMMON.CONTACTS"
6775 double precision zapas(max_dim,maxconts,max_fg_procs),
6776 & zapas_recv(max_dim,maxconts,max_fg_procs)
6777 common /przechowalnia/ zapas
6778 integer i,j,ii,jj,iproc,itask(4),nn
6779 c write (iout,*) "itask",itask
6782 if (iproc.gt.0) then
6783 do j=1,num_cont_hb(ii)
6785 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6787 ncont_sent(iproc)=ncont_sent(iproc)+1
6788 nn=ncont_sent(iproc)
6789 zapas(1,nn,iproc)=ii
6790 zapas(2,nn,iproc)=jjc
6791 zapas(3,nn,iproc)=d_cont(j,ii)
6795 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6800 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6808 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6820 c------------------------------------------------------------------------------
6821 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6822 implicit real*8 (a-h,o-z)
6823 include 'DIMENSIONS'
6824 include 'COMMON.IOUNITS'
6825 include 'COMMON.DERIV'
6826 include 'COMMON.INTERACT'
6827 include 'COMMON.CONTACTS'
6828 double precision gx(3),gx1(3)
6838 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6839 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6840 C Following 4 lines for diagnostics.
6845 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6846 c & 'Contacts ',i,j,
6847 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6848 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6850 C Calculate the multi-body contribution to energy.
6851 c ecorr=ecorr+ekont*ees
6852 C Calculate multi-body contributions to the gradient.
6853 coeffpees0pij=coeffp*ees0pij
6854 coeffmees0mij=coeffm*ees0mij
6855 coeffpees0pkl=coeffp*ees0pkl
6856 coeffmees0mkl=coeffm*ees0mkl
6858 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6859 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6860 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6861 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6862 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6863 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6864 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6865 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6866 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6867 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6868 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6869 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6870 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6871 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6872 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6873 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6874 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6875 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6876 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6877 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6878 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6879 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6880 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6881 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6882 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6887 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6888 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6889 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6890 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6895 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6896 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6897 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6898 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6901 c write (iout,*) "ehbcorr",ekont*ees
6906 C---------------------------------------------------------------------------
6907 subroutine dipole(i,j,jj)
6908 implicit real*8 (a-h,o-z)
6909 include 'DIMENSIONS'
6910 include 'COMMON.IOUNITS'
6911 include 'COMMON.CHAIN'
6912 include 'COMMON.FFIELD'
6913 include 'COMMON.DERIV'
6914 include 'COMMON.INTERACT'
6915 include 'COMMON.CONTACTS'
6916 include 'COMMON.TORSION'
6917 include 'COMMON.VAR'
6918 include 'COMMON.GEO'
6919 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6921 iti1 = itortyp(itype(i+1))
6922 if (j.lt.nres-1) then
6923 itj1 = itortyp(itype(j+1))
6928 dipi(iii,1)=Ub2(iii,i)
6929 dipderi(iii)=Ub2der(iii,i)
6930 dipi(iii,2)=b1(iii,iti1)
6931 dipj(iii,1)=Ub2(iii,j)
6932 dipderj(iii)=Ub2der(iii,j)
6933 dipj(iii,2)=b1(iii,itj1)
6937 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6940 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6947 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6951 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6956 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6957 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6959 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6961 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6963 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6968 C---------------------------------------------------------------------------
6969 subroutine calc_eello(i,j,k,l,jj,kk)
6971 C This subroutine computes matrices and vectors needed to calculate
6972 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'COMMON.IOUNITS'
6977 include 'COMMON.CHAIN'
6978 include 'COMMON.DERIV'
6979 include 'COMMON.INTERACT'
6980 include 'COMMON.CONTACTS'
6981 include 'COMMON.TORSION'
6982 include 'COMMON.VAR'
6983 include 'COMMON.GEO'
6984 include 'COMMON.FFIELD'
6985 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6986 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6989 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6990 cd & ' jj=',jj,' kk=',kk
6991 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6992 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6993 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6996 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6997 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7000 call transpose2(aa1(1,1),aa1t(1,1))
7001 call transpose2(aa2(1,1),aa2t(1,1))
7004 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7005 & aa1tder(1,1,lll,kkk))
7006 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7007 & aa2tder(1,1,lll,kkk))
7011 C parallel orientation of the two CA-CA-CA frames.
7013 iti=itortyp(itype(i))
7017 itk1=itortyp(itype(k+1))
7018 itj=itortyp(itype(j))
7019 if (l.lt.nres-1) then
7020 itl1=itortyp(itype(l+1))
7024 C A1 kernel(j+1) A2T
7026 cd write (iout,'(3f10.5,5x,3f10.5)')
7027 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7029 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7030 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7031 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7032 C Following matrices are needed only for 6-th order cumulants
7033 IF (wcorr6.gt.0.0d0) THEN
7034 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7035 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7036 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7037 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7038 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7039 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7040 & ADtEAderx(1,1,1,1,1,1))
7042 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7043 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7044 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7045 & ADtEA1derx(1,1,1,1,1,1))
7047 C End 6-th order cumulants
7050 cd write (2,*) 'In calc_eello6'
7052 cd write (2,*) 'iii=',iii
7054 cd write (2,*) 'kkk=',kkk
7056 cd write (2,'(3(2f10.5),5x)')
7057 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7062 call transpose2(EUgder(1,1,k),auxmat(1,1))
7063 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7064 call transpose2(EUg(1,1,k),auxmat(1,1))
7065 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7066 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7070 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7071 & EAEAderx(1,1,lll,kkk,iii,1))
7075 C A1T kernel(i+1) A2
7076 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7077 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7078 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7079 C Following matrices are needed only for 6-th order cumulants
7080 IF (wcorr6.gt.0.0d0) THEN
7081 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7082 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7083 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7084 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7085 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7086 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7087 & ADtEAderx(1,1,1,1,1,2))
7088 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7089 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7090 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7091 & ADtEA1derx(1,1,1,1,1,2))
7093 C End 6-th order cumulants
7094 call transpose2(EUgder(1,1,l),auxmat(1,1))
7095 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7096 call transpose2(EUg(1,1,l),auxmat(1,1))
7097 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7098 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7102 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7103 & EAEAderx(1,1,lll,kkk,iii,2))
7108 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7109 C They are needed only when the fifth- or the sixth-order cumulants are
7111 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7112 call transpose2(AEA(1,1,1),auxmat(1,1))
7113 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7114 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7115 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7116 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7117 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7118 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7119 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7120 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7121 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7122 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7123 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7124 call transpose2(AEA(1,1,2),auxmat(1,1))
7125 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7126 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7127 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7128 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7130 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7131 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7132 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7133 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7134 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7135 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7136 C Calculate the Cartesian derivatives of the vectors.
7140 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,iti),
7142 & AEAb1derx(1,lll,kkk,iii,1,1))
7143 call matvec2(auxmat(1,1),Ub2(1,i),
7144 & AEAb2derx(1,lll,kkk,iii,1,1))
7145 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7146 & AEAb1derx(1,lll,kkk,iii,2,1))
7147 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7148 & AEAb2derx(1,lll,kkk,iii,2,1))
7149 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7150 call matvec2(auxmat(1,1),b1(1,itj),
7151 & AEAb1derx(1,lll,kkk,iii,1,2))
7152 call matvec2(auxmat(1,1),Ub2(1,j),
7153 & AEAb2derx(1,lll,kkk,iii,1,2))
7154 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7155 & AEAb1derx(1,lll,kkk,iii,2,2))
7156 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7157 & AEAb2derx(1,lll,kkk,iii,2,2))
7164 C Antiparallel orientation of the two CA-CA-CA frames.
7166 iti=itortyp(itype(i))
7170 itk1=itortyp(itype(k+1))
7171 itl=itortyp(itype(l))
7172 itj=itortyp(itype(j))
7173 if (j.lt.nres-1) then
7174 itj1=itortyp(itype(j+1))
7178 C A2 kernel(j-1)T A1T
7179 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7180 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7181 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7182 C Following matrices are needed only for 6-th order cumulants
7183 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7184 & j.eq.i+4 .and. l.eq.i+3)) THEN
7185 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7186 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7187 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7188 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7189 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7190 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7191 & ADtEAderx(1,1,1,1,1,1))
7192 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7193 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7194 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7195 & ADtEA1derx(1,1,1,1,1,1))
7197 C End 6-th order cumulants
7198 call transpose2(EUgder(1,1,k),auxmat(1,1))
7199 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7200 call transpose2(EUg(1,1,k),auxmat(1,1))
7201 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7202 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7206 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7207 & EAEAderx(1,1,lll,kkk,iii,1))
7211 C A2T kernel(i+1)T A1
7212 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7213 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7214 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7215 C Following matrices are needed only for 6-th order cumulants
7216 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7217 & j.eq.i+4 .and. l.eq.i+3)) THEN
7218 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7219 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7220 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7221 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7222 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7223 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7224 & ADtEAderx(1,1,1,1,1,2))
7225 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7226 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7227 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7228 & ADtEA1derx(1,1,1,1,1,2))
7230 C End 6-th order cumulants
7231 call transpose2(EUgder(1,1,j),auxmat(1,1))
7232 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7233 call transpose2(EUg(1,1,j),auxmat(1,1))
7234 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7235 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7239 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7240 & EAEAderx(1,1,lll,kkk,iii,2))
7245 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7246 C They are needed only when the fifth- or the sixth-order cumulants are
7248 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7249 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7250 call transpose2(AEA(1,1,1),auxmat(1,1))
7251 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7252 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7253 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7254 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7255 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7256 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7257 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7258 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7259 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7260 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7261 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7262 call transpose2(AEA(1,1,2),auxmat(1,1))
7263 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7264 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7265 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7266 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7267 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7268 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7269 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7270 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7271 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7272 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7273 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7274 C Calculate the Cartesian derivatives of the vectors.
7278 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7279 call matvec2(auxmat(1,1),b1(1,iti),
7280 & AEAb1derx(1,lll,kkk,iii,1,1))
7281 call matvec2(auxmat(1,1),Ub2(1,i),
7282 & AEAb2derx(1,lll,kkk,iii,1,1))
7283 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7284 & AEAb1derx(1,lll,kkk,iii,2,1))
7285 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7286 & AEAb2derx(1,lll,kkk,iii,2,1))
7287 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7288 call matvec2(auxmat(1,1),b1(1,itl),
7289 & AEAb1derx(1,lll,kkk,iii,1,2))
7290 call matvec2(auxmat(1,1),Ub2(1,l),
7291 & AEAb2derx(1,lll,kkk,iii,1,2))
7292 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7293 & AEAb1derx(1,lll,kkk,iii,2,2))
7294 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7295 & AEAb2derx(1,lll,kkk,iii,2,2))
7304 C---------------------------------------------------------------------------
7305 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7306 & KK,KKderg,AKA,AKAderg,AKAderx)
7310 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7311 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7312 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7317 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7319 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7322 cd if (lprn) write (2,*) 'In kernel'
7324 cd if (lprn) write (2,*) 'kkk=',kkk
7326 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7327 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7329 cd write (2,*) 'lll=',lll
7330 cd write (2,*) 'iii=1'
7332 cd write (2,'(3(2f10.5),5x)')
7333 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7336 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7337 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7339 cd write (2,*) 'lll=',lll
7340 cd write (2,*) 'iii=2'
7342 cd write (2,'(3(2f10.5),5x)')
7343 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7350 C---------------------------------------------------------------------------
7351 double precision function eello4(i,j,k,l,jj,kk)
7352 implicit real*8 (a-h,o-z)
7353 include 'DIMENSIONS'
7354 include 'COMMON.IOUNITS'
7355 include 'COMMON.CHAIN'
7356 include 'COMMON.DERIV'
7357 include 'COMMON.INTERACT'
7358 include 'COMMON.CONTACTS'
7359 include 'COMMON.TORSION'
7360 include 'COMMON.VAR'
7361 include 'COMMON.GEO'
7362 double precision pizda(2,2),ggg1(3),ggg2(3)
7363 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7367 cd print *,'eello4:',i,j,k,l,jj,kk
7368 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7369 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7370 cold eij=facont_hb(jj,i)
7371 cold ekl=facont_hb(kk,k)
7373 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7374 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7375 gcorr_loc(k-1)=gcorr_loc(k-1)
7376 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7378 gcorr_loc(l-1)=gcorr_loc(l-1)
7379 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7381 gcorr_loc(j-1)=gcorr_loc(j-1)
7382 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7387 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7388 & -EAEAderx(2,2,lll,kkk,iii,1)
7389 cd derx(lll,kkk,iii)=0.0d0
7393 cd gcorr_loc(l-1)=0.0d0
7394 cd gcorr_loc(j-1)=0.0d0
7395 cd gcorr_loc(k-1)=0.0d0
7397 cd write (iout,*)'Contacts have occurred for peptide groups',
7398 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7399 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7400 if (j.lt.nres-1) then
7407 if (l.lt.nres-1) then
7415 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7416 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7417 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7418 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7419 cgrad ghalf=0.5d0*ggg1(ll)
7420 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7421 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7422 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7423 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7424 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7425 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7426 cgrad ghalf=0.5d0*ggg2(ll)
7427 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7428 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7429 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7430 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7431 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7432 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7436 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7441 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7446 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7451 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7455 cd write (2,*) iii,gcorr_loc(iii)
7458 cd write (2,*) 'ekont',ekont
7459 cd write (iout,*) 'eello4',ekont*eel4
7462 C---------------------------------------------------------------------------
7463 double precision function eello5(i,j,k,l,jj,kk)
7464 implicit real*8 (a-h,o-z)
7465 include 'DIMENSIONS'
7466 include 'COMMON.IOUNITS'
7467 include 'COMMON.CHAIN'
7468 include 'COMMON.DERIV'
7469 include 'COMMON.INTERACT'
7470 include 'COMMON.CONTACTS'
7471 include 'COMMON.TORSION'
7472 include 'COMMON.VAR'
7473 include 'COMMON.GEO'
7474 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7475 double precision ggg1(3),ggg2(3)
7476 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7481 C /l\ / \ \ / \ / \ / C
7482 C / \ / \ \ / \ / \ / C
7483 C j| o |l1 | o | o| o | | o |o C
7484 C \ |/k\| |/ \| / |/ \| |/ \| C
7485 C \i/ \ / \ / / \ / \ C
7487 C (I) (II) (III) (IV) C
7489 C eello5_1 eello5_2 eello5_3 eello5_4 C
7491 C Antiparallel chains C
7494 C /j\ / \ \ / \ / \ / C
7495 C / \ / \ \ / \ / \ / C
7496 C j1| o |l | o | o| o | | o |o C
7497 C \ |/k\| |/ \| / |/ \| |/ \| C
7498 C \i/ \ / \ / / \ / \ C
7500 C (I) (II) (III) (IV) C
7502 C eello5_1 eello5_2 eello5_3 eello5_4 C
7504 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7507 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7512 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7514 itk=itortyp(itype(k))
7515 itl=itortyp(itype(l))
7516 itj=itortyp(itype(j))
7521 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7522 cd & eel5_3_num,eel5_4_num)
7526 derx(lll,kkk,iii)=0.0d0
7530 cd eij=facont_hb(jj,i)
7531 cd ekl=facont_hb(kk,k)
7533 cd write (iout,*)'Contacts have occurred for peptide groups',
7534 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7536 C Contribution from the graph I.
7537 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7538 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7539 call transpose2(EUg(1,1,k),auxmat(1,1))
7540 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7541 vv(1)=pizda(1,1)-pizda(2,2)
7542 vv(2)=pizda(1,2)+pizda(2,1)
7543 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7544 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7545 C Explicit gradient in virtual-dihedral angles.
7546 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7547 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7548 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7549 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7550 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7551 vv(1)=pizda(1,1)-pizda(2,2)
7552 vv(2)=pizda(1,2)+pizda(2,1)
7553 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7554 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7555 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7556 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7557 vv(1)=pizda(1,1)-pizda(2,2)
7558 vv(2)=pizda(1,2)+pizda(2,1)
7560 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7561 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7562 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7564 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7565 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7566 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7568 C Cartesian gradient
7572 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7574 vv(1)=pizda(1,1)-pizda(2,2)
7575 vv(2)=pizda(1,2)+pizda(2,1)
7576 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7577 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7578 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7584 C Contribution from graph II
7585 call transpose2(EE(1,1,itk),auxmat(1,1))
7586 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7587 vv(1)=pizda(1,1)+pizda(2,2)
7588 vv(2)=pizda(2,1)-pizda(1,2)
7589 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7590 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7591 C Explicit gradient in virtual-dihedral angles.
7592 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7593 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7594 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7595 vv(1)=pizda(1,1)+pizda(2,2)
7596 vv(2)=pizda(2,1)-pizda(1,2)
7598 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7599 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7600 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7602 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7603 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7604 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7606 C Cartesian gradient
7610 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7612 vv(1)=pizda(1,1)+pizda(2,2)
7613 vv(2)=pizda(2,1)-pizda(1,2)
7614 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7615 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7616 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7624 C Parallel orientation
7625 C Contribution from graph III
7626 call transpose2(EUg(1,1,l),auxmat(1,1))
7627 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7628 vv(1)=pizda(1,1)-pizda(2,2)
7629 vv(2)=pizda(1,2)+pizda(2,1)
7630 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7631 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7632 C Explicit gradient in virtual-dihedral angles.
7633 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7634 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7635 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7636 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7637 vv(1)=pizda(1,1)-pizda(2,2)
7638 vv(2)=pizda(1,2)+pizda(2,1)
7639 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7640 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7641 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7642 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7643 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7644 vv(1)=pizda(1,1)-pizda(2,2)
7645 vv(2)=pizda(1,2)+pizda(2,1)
7646 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7647 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7648 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7649 C Cartesian gradient
7653 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7655 vv(1)=pizda(1,1)-pizda(2,2)
7656 vv(2)=pizda(1,2)+pizda(2,1)
7657 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7658 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7659 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7664 C Contribution from graph IV
7666 call transpose2(EE(1,1,itl),auxmat(1,1))
7667 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7668 vv(1)=pizda(1,1)+pizda(2,2)
7669 vv(2)=pizda(2,1)-pizda(1,2)
7670 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7671 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7672 C Explicit gradient in virtual-dihedral angles.
7673 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7674 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7675 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7676 vv(1)=pizda(1,1)+pizda(2,2)
7677 vv(2)=pizda(2,1)-pizda(1,2)
7678 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7679 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7680 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7681 C Cartesian gradient
7685 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7687 vv(1)=pizda(1,1)+pizda(2,2)
7688 vv(2)=pizda(2,1)-pizda(1,2)
7689 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7690 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7691 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7696 C Antiparallel orientation
7697 C Contribution from graph III
7699 call transpose2(EUg(1,1,j),auxmat(1,1))
7700 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7701 vv(1)=pizda(1,1)-pizda(2,2)
7702 vv(2)=pizda(1,2)+pizda(2,1)
7703 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7704 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7705 C Explicit gradient in virtual-dihedral angles.
7706 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7707 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7708 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7709 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)-pizda(2,2)
7711 vv(2)=pizda(1,2)+pizda(2,1)
7712 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7713 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7714 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7715 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7716 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7717 vv(1)=pizda(1,1)-pizda(2,2)
7718 vv(2)=pizda(1,2)+pizda(2,1)
7719 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7720 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7721 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7722 C Cartesian gradient
7726 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7728 vv(1)=pizda(1,1)-pizda(2,2)
7729 vv(2)=pizda(1,2)+pizda(2,1)
7730 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7731 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7732 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7737 C Contribution from graph IV
7739 call transpose2(EE(1,1,itj),auxmat(1,1))
7740 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7741 vv(1)=pizda(1,1)+pizda(2,2)
7742 vv(2)=pizda(2,1)-pizda(1,2)
7743 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7744 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7745 C Explicit gradient in virtual-dihedral angles.
7746 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7747 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7748 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7749 vv(1)=pizda(1,1)+pizda(2,2)
7750 vv(2)=pizda(2,1)-pizda(1,2)
7751 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7752 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7753 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7754 C Cartesian gradient
7758 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7760 vv(1)=pizda(1,1)+pizda(2,2)
7761 vv(2)=pizda(2,1)-pizda(1,2)
7762 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7763 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7764 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7770 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7771 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7772 cd write (2,*) 'ijkl',i,j,k,l
7773 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7774 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7776 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7777 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7778 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7779 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7780 if (j.lt.nres-1) then
7787 if (l.lt.nres-1) then
7797 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7798 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7799 C summed up outside the subrouine as for the other subroutines
7800 C handling long-range interactions. The old code is commented out
7801 C with "cgrad" to keep track of changes.
7803 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7804 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7805 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7806 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7807 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7808 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7809 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7810 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7811 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7812 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7814 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7815 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7816 cgrad ghalf=0.5d0*ggg1(ll)
7818 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7819 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7820 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7821 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7822 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7823 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7824 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7825 cgrad ghalf=0.5d0*ggg2(ll)
7827 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7828 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7829 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7830 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7831 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7832 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7837 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7838 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7843 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7844 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7850 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7855 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7859 cd write (2,*) iii,g_corr5_loc(iii)
7862 cd write (2,*) 'ekont',ekont
7863 cd write (iout,*) 'eello5',ekont*eel5
7866 c--------------------------------------------------------------------------
7867 double precision function eello6(i,j,k,l,jj,kk)
7868 implicit real*8 (a-h,o-z)
7869 include 'DIMENSIONS'
7870 include 'COMMON.IOUNITS'
7871 include 'COMMON.CHAIN'
7872 include 'COMMON.DERIV'
7873 include 'COMMON.INTERACT'
7874 include 'COMMON.CONTACTS'
7875 include 'COMMON.TORSION'
7876 include 'COMMON.VAR'
7877 include 'COMMON.GEO'
7878 include 'COMMON.FFIELD'
7879 double precision ggg1(3),ggg2(3)
7880 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7885 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7893 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7894 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7898 derx(lll,kkk,iii)=0.0d0
7902 cd eij=facont_hb(jj,i)
7903 cd ekl=facont_hb(kk,k)
7909 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7910 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7911 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7912 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7913 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7914 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7916 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7917 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7918 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7919 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7920 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7921 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7925 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7927 C If turn contributions are considered, they will be handled separately.
7928 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7929 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7930 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7931 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7932 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7933 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7934 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7936 if (j.lt.nres-1) then
7943 if (l.lt.nres-1) then
7951 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7952 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7953 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7954 cgrad ghalf=0.5d0*ggg1(ll)
7956 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7957 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7958 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7959 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7960 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7961 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7962 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7963 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7964 cgrad ghalf=0.5d0*ggg2(ll)
7965 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7967 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7968 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7969 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7970 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7971 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7972 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7977 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7978 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7983 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7984 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7990 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7995 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7999 cd write (2,*) iii,g_corr6_loc(iii)
8002 cd write (2,*) 'ekont',ekont
8003 cd write (iout,*) 'eello6',ekont*eel6
8006 c--------------------------------------------------------------------------
8007 double precision function eello6_graph1(i,j,k,l,imat,swap)
8008 implicit real*8 (a-h,o-z)
8009 include 'DIMENSIONS'
8010 include 'COMMON.IOUNITS'
8011 include 'COMMON.CHAIN'
8012 include 'COMMON.DERIV'
8013 include 'COMMON.INTERACT'
8014 include 'COMMON.CONTACTS'
8015 include 'COMMON.TORSION'
8016 include 'COMMON.VAR'
8017 include 'COMMON.GEO'
8018 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8022 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8024 C Parallel Antiparallel
8030 C \ j|/k\| / \ |/k\|l /
8035 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8036 itk=itortyp(itype(k))
8037 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8038 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8039 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8040 call transpose2(EUgC(1,1,k),auxmat(1,1))
8041 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8042 vv1(1)=pizda1(1,1)-pizda1(2,2)
8043 vv1(2)=pizda1(1,2)+pizda1(2,1)
8044 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8045 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8046 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8047 s5=scalar2(vv(1),Dtobr2(1,i))
8048 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8049 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8050 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8051 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8052 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8053 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8054 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8055 & +scalar2(vv(1),Dtobr2der(1,i)))
8056 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8057 vv1(1)=pizda1(1,1)-pizda1(2,2)
8058 vv1(2)=pizda1(1,2)+pizda1(2,1)
8059 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8060 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8062 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8063 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8064 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8065 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8066 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8068 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8069 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8070 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8071 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8072 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8074 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8075 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8076 vv1(1)=pizda1(1,1)-pizda1(2,2)
8077 vv1(2)=pizda1(1,2)+pizda1(2,1)
8078 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8079 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8080 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8081 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8090 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8091 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8092 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8093 call transpose2(EUgC(1,1,k),auxmat(1,1))
8094 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8096 vv1(1)=pizda1(1,1)-pizda1(2,2)
8097 vv1(2)=pizda1(1,2)+pizda1(2,1)
8098 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8099 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8100 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8101 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8102 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8103 s5=scalar2(vv(1),Dtobr2(1,i))
8104 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8110 c----------------------------------------------------------------------------
8111 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8112 implicit real*8 (a-h,o-z)
8113 include 'DIMENSIONS'
8114 include 'COMMON.IOUNITS'
8115 include 'COMMON.CHAIN'
8116 include 'COMMON.DERIV'
8117 include 'COMMON.INTERACT'
8118 include 'COMMON.CONTACTS'
8119 include 'COMMON.TORSION'
8120 include 'COMMON.VAR'
8121 include 'COMMON.GEO'
8123 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8124 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8127 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8129 C Parallel Antiparallel
8140 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8141 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8142 C AL 7/4/01 s1 would occur in the sixth-order moment,
8143 C but not in a cluster cumulant
8145 s1=dip(1,jj,i)*dip(1,kk,k)
8147 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8148 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8149 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8150 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8151 call transpose2(EUg(1,1,k),auxmat(1,1))
8152 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8153 vv(1)=pizda(1,1)-pizda(2,2)
8154 vv(2)=pizda(1,2)+pizda(2,1)
8155 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8156 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8158 eello6_graph2=-(s1+s2+s3+s4)
8160 eello6_graph2=-(s2+s3+s4)
8163 C Derivatives in gamma(i-1)
8166 s1=dipderg(1,jj,i)*dip(1,kk,k)
8168 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8169 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8170 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8171 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8173 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8175 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8177 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8179 C Derivatives in gamma(k-1)
8181 s1=dip(1,jj,i)*dipderg(1,kk,k)
8183 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8184 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8185 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8186 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8187 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8188 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8189 vv(1)=pizda(1,1)-pizda(2,2)
8190 vv(2)=pizda(1,2)+pizda(2,1)
8191 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8193 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8195 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8197 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8198 C Derivatives in gamma(j-1) or gamma(l-1)
8201 s1=dipderg(3,jj,i)*dip(1,kk,k)
8203 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8204 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8205 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8206 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8207 vv(1)=pizda(1,1)-pizda(2,2)
8208 vv(2)=pizda(1,2)+pizda(2,1)
8209 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8212 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8214 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8217 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8218 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8220 C Derivatives in gamma(l-1) or gamma(j-1)
8223 s1=dip(1,jj,i)*dipderg(3,kk,k)
8225 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8226 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8227 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8228 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8229 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8230 vv(1)=pizda(1,1)-pizda(2,2)
8231 vv(2)=pizda(1,2)+pizda(2,1)
8232 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8235 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8237 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8240 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8241 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8243 C Cartesian derivatives.
8245 write (2,*) 'In eello6_graph2'
8247 write (2,*) 'iii=',iii
8249 write (2,*) 'kkk=',kkk
8251 write (2,'(3(2f10.5),5x)')
8252 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8262 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8264 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8267 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8269 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8270 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8272 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8273 call transpose2(EUg(1,1,k),auxmat(1,1))
8274 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8276 vv(1)=pizda(1,1)-pizda(2,2)
8277 vv(2)=pizda(1,2)+pizda(2,1)
8278 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8279 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8281 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8283 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8286 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8288 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8295 c----------------------------------------------------------------------------
8296 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8297 implicit real*8 (a-h,o-z)
8298 include 'DIMENSIONS'
8299 include 'COMMON.IOUNITS'
8300 include 'COMMON.CHAIN'
8301 include 'COMMON.DERIV'
8302 include 'COMMON.INTERACT'
8303 include 'COMMON.CONTACTS'
8304 include 'COMMON.TORSION'
8305 include 'COMMON.VAR'
8306 include 'COMMON.GEO'
8307 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8309 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8311 C Parallel Antiparallel
8322 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8324 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8325 C energy moment and not to the cluster cumulant.
8326 iti=itortyp(itype(i))
8327 if (j.lt.nres-1) then
8328 itj1=itortyp(itype(j+1))
8332 itk=itortyp(itype(k))
8333 itk1=itortyp(itype(k+1))
8334 if (l.lt.nres-1) then
8335 itl1=itortyp(itype(l+1))
8340 s1=dip(4,jj,i)*dip(4,kk,k)
8342 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8343 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8344 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8345 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8346 call transpose2(EE(1,1,itk),auxmat(1,1))
8347 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8348 vv(1)=pizda(1,1)+pizda(2,2)
8349 vv(2)=pizda(2,1)-pizda(1,2)
8350 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8351 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8352 cd & "sum",-(s2+s3+s4)
8354 eello6_graph3=-(s1+s2+s3+s4)
8356 eello6_graph3=-(s2+s3+s4)
8359 C Derivatives in gamma(k-1)
8360 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8361 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8362 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8363 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8364 C Derivatives in gamma(l-1)
8365 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8366 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8367 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8368 vv(1)=pizda(1,1)+pizda(2,2)
8369 vv(2)=pizda(2,1)-pizda(1,2)
8370 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8371 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8372 C Cartesian derivatives.
8378 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8380 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8383 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8385 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8386 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8388 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8389 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8391 vv(1)=pizda(1,1)+pizda(2,2)
8392 vv(2)=pizda(2,1)-pizda(1,2)
8393 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8395 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8397 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8400 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8402 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8404 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8410 c----------------------------------------------------------------------------
8411 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8412 implicit real*8 (a-h,o-z)
8413 include 'DIMENSIONS'
8414 include 'COMMON.IOUNITS'
8415 include 'COMMON.CHAIN'
8416 include 'COMMON.DERIV'
8417 include 'COMMON.INTERACT'
8418 include 'COMMON.CONTACTS'
8419 include 'COMMON.TORSION'
8420 include 'COMMON.VAR'
8421 include 'COMMON.GEO'
8422 include 'COMMON.FFIELD'
8423 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8424 & auxvec1(2),auxmat1(2,2)
8426 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8428 C Parallel Antiparallel
8439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8441 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8442 C energy moment and not to the cluster cumulant.
8443 cd write (2,*) 'eello_graph4: wturn6',wturn6
8444 iti=itortyp(itype(i))
8445 itj=itortyp(itype(j))
8446 if (j.lt.nres-1) then
8447 itj1=itortyp(itype(j+1))
8451 itk=itortyp(itype(k))
8452 if (k.lt.nres-1) then
8453 itk1=itortyp(itype(k+1))
8457 itl=itortyp(itype(l))
8458 if (l.lt.nres-1) then
8459 itl1=itortyp(itype(l+1))
8463 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8464 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8465 cd & ' itl',itl,' itl1',itl1
8468 s1=dip(3,jj,i)*dip(3,kk,k)
8470 s1=dip(2,jj,j)*dip(2,kk,l)
8473 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8474 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8476 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8477 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8479 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8480 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8482 call transpose2(EUg(1,1,k),auxmat(1,1))
8483 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8484 vv(1)=pizda(1,1)-pizda(2,2)
8485 vv(2)=pizda(2,1)+pizda(1,2)
8486 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8487 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8489 eello6_graph4=-(s1+s2+s3+s4)
8491 eello6_graph4=-(s2+s3+s4)
8493 C Derivatives in gamma(i-1)
8497 s1=dipderg(2,jj,i)*dip(3,kk,k)
8499 s1=dipderg(4,jj,j)*dip(2,kk,l)
8502 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8504 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8505 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8507 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8508 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8510 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8511 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8512 cd write (2,*) 'turn6 derivatives'
8514 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8516 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8520 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8522 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8526 C Derivatives in gamma(k-1)
8529 s1=dip(3,jj,i)*dipderg(2,kk,k)
8531 s1=dip(2,jj,j)*dipderg(4,kk,l)
8534 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8535 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8537 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8538 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8540 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8541 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8543 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8544 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8545 vv(1)=pizda(1,1)-pizda(2,2)
8546 vv(2)=pizda(2,1)+pizda(1,2)
8547 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8548 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8550 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8552 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8556 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8558 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8561 C Derivatives in gamma(j-1) or gamma(l-1)
8562 if (l.eq.j+1 .and. l.gt.1) then
8563 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8564 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8565 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8566 vv(1)=pizda(1,1)-pizda(2,2)
8567 vv(2)=pizda(2,1)+pizda(1,2)
8568 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8569 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8570 else if (j.gt.1) then
8571 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8572 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8573 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8574 vv(1)=pizda(1,1)-pizda(2,2)
8575 vv(2)=pizda(2,1)+pizda(1,2)
8576 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8577 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8578 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8580 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8583 C Cartesian derivatives.
8590 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8592 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8596 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8598 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8602 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8604 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8606 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8607 & b1(1,itj1),auxvec(1))
8608 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8610 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8611 & b1(1,itl1),auxvec(1))
8612 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8614 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8616 vv(1)=pizda(1,1)-pizda(2,2)
8617 vv(2)=pizda(2,1)+pizda(1,2)
8618 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8620 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8622 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8625 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8628 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8631 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8633 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8635 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8639 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8641 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8644 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8646 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8654 c----------------------------------------------------------------------------
8655 double precision function eello_turn6(i,jj,kk)
8656 implicit real*8 (a-h,o-z)
8657 include 'DIMENSIONS'
8658 include 'COMMON.IOUNITS'
8659 include 'COMMON.CHAIN'
8660 include 'COMMON.DERIV'
8661 include 'COMMON.INTERACT'
8662 include 'COMMON.CONTACTS'
8663 include 'COMMON.TORSION'
8664 include 'COMMON.VAR'
8665 include 'COMMON.GEO'
8666 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8667 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8669 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8670 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8671 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8672 C the respective energy moment and not to the cluster cumulant.
8681 iti=itortyp(itype(i))
8682 itk=itortyp(itype(k))
8683 itk1=itortyp(itype(k+1))
8684 itl=itortyp(itype(l))
8685 itj=itortyp(itype(j))
8686 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8687 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8688 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8693 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8695 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8699 derx_turn(lll,kkk,iii)=0.0d0
8706 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8708 cd write (2,*) 'eello6_5',eello6_5
8710 call transpose2(AEA(1,1,1),auxmat(1,1))
8711 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8712 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8713 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8715 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8716 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8717 s2 = scalar2(b1(1,itk),vtemp1(1))
8719 call transpose2(AEA(1,1,2),atemp(1,1))
8720 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8721 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8722 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8724 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8725 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8726 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8728 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8729 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8730 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8731 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8732 ss13 = scalar2(b1(1,itk),vtemp4(1))
8733 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8735 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8741 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8742 C Derivatives in gamma(i+2)
8746 call transpose2(AEA(1,1,1),auxmatd(1,1))
8747 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8748 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8749 call transpose2(AEAderg(1,1,2),atempd(1,1))
8750 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8751 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8753 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8754 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8755 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8761 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8762 C Derivatives in gamma(i+3)
8764 call transpose2(AEA(1,1,1),auxmatd(1,1))
8765 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8766 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8767 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8769 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8770 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8771 s2d = scalar2(b1(1,itk),vtemp1d(1))
8773 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8774 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8776 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8778 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8779 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8780 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8788 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8789 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8791 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8792 & -0.5d0*ekont*(s2d+s12d)
8794 C Derivatives in gamma(i+4)
8795 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8796 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8797 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8799 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8800 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8801 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8809 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8811 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8813 C Derivatives in gamma(i+5)
8815 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8816 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8817 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8819 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8820 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8821 s2d = scalar2(b1(1,itk),vtemp1d(1))
8823 call transpose2(AEA(1,1,2),atempd(1,1))
8824 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8825 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8827 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8828 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8830 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8831 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8832 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8840 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8841 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8843 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8844 & -0.5d0*ekont*(s2d+s12d)
8846 C Cartesian derivatives
8851 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8852 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8853 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8855 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8856 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8858 s2d = scalar2(b1(1,itk),vtemp1d(1))
8860 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8861 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8862 s8d = -(atempd(1,1)+atempd(2,2))*
8863 & scalar2(cc(1,1,itl),vtemp2(1))
8865 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8867 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8868 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8875 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8878 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8882 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8883 & - 0.5d0*(s8d+s12d)
8885 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8894 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8896 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8897 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8898 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8899 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8900 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8902 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8903 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8904 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8908 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8909 cd & 16*eel_turn6_num
8911 if (j.lt.nres-1) then
8918 if (l.lt.nres-1) then
8926 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8927 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8928 cgrad ghalf=0.5d0*ggg1(ll)
8930 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8931 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8932 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8933 & +ekont*derx_turn(ll,2,1)
8934 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8935 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8936 & +ekont*derx_turn(ll,4,1)
8937 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8938 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8939 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8940 cgrad ghalf=0.5d0*ggg2(ll)
8942 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8943 & +ekont*derx_turn(ll,2,2)
8944 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8945 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8946 & +ekont*derx_turn(ll,4,2)
8947 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8948 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8949 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8954 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8959 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8965 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8970 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8974 cd write (2,*) iii,g_corr6_loc(iii)
8976 eello_turn6=ekont*eel_turn6
8977 cd write (2,*) 'ekont',ekont
8978 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8982 C-----------------------------------------------------------------------------
8983 double precision function scalar(u,v)
8984 !DIR$ INLINEALWAYS scalar
8986 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8989 double precision u(3),v(3)
8990 cd double precision sc
8998 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9001 crc-------------------------------------------------
9002 SUBROUTINE MATVEC2(A1,V1,V2)
9003 !DIR$ INLINEALWAYS MATVEC2
9005 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9007 implicit real*8 (a-h,o-z)
9008 include 'DIMENSIONS'
9009 DIMENSION A1(2,2),V1(2),V2(2)
9013 c 3 VI=VI+A1(I,K)*V1(K)
9017 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9018 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9023 C---------------------------------------
9024 SUBROUTINE MATMAT2(A1,A2,A3)
9026 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9028 implicit real*8 (a-h,o-z)
9029 include 'DIMENSIONS'
9030 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9031 c DIMENSION AI3(2,2)
9035 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9041 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9042 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9043 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9044 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9052 c-------------------------------------------------------------------------
9053 double precision function scalar2(u,v)
9054 !DIR$ INLINEALWAYS scalar2
9056 double precision u(2),v(2)
9059 scalar2=u(1)*v(1)+u(2)*v(2)
9063 C-----------------------------------------------------------------------------
9065 subroutine transpose2(a,at)
9066 !DIR$ INLINEALWAYS transpose2
9068 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9071 double precision a(2,2),at(2,2)
9078 c--------------------------------------------------------------------------
9079 subroutine transpose(n,a,at)
9082 double precision a(n,n),at(n,n)
9090 C---------------------------------------------------------------------------
9091 subroutine prodmat3(a1,a2,kk,transp,prod)
9092 !DIR$ INLINEALWAYS prodmat3
9094 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9098 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9100 crc double precision auxmat(2,2),prod_(2,2)
9103 crc call transpose2(kk(1,1),auxmat(1,1))
9104 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9105 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9107 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9108 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9109 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9110 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9111 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9112 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9113 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9114 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9117 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9118 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9120 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9121 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9122 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9123 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9124 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9125 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9126 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9127 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9130 c call transpose2(a2(1,1),a2t(1,1))
9133 crc print *,((prod_(i,j),i=1,2),j=1,2)
9134 crc print *,((prod(i,j),i=1,2),j=1,2)