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),gloc_scbuf(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)
779 write (iout,*) "gloc_sc before reduce"
782 write (iout,*) i,j,gloc_sc(j,i,icg)
789 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
793 call MPI_Barrier(FG_COMM,IERR)
794 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
796 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
797 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
798 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
799 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
800 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
801 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
802 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
803 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
804 time_reduce=time_reduce+MPI_Wtime()-time00
807 write (iout,*) "gloc_sc after reduce"
810 write (iout,*) i,j,gloc_sc(j,i,icg)
816 write (iout,*) "gloc after reduce"
818 write (iout,*) i,gloc(i,icg)
823 if (gnorm_check) then
825 c Compute the maximum elements of the gradient
835 gcorr3_turn_max=0.0d0
836 gcorr4_turn_max=0.0d0
839 gcorr6_turn_max=0.0d0
849 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
850 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
852 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
853 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
855 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
856 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
857 & gvdwc_scp_max=gvdwc_scp_norm
858 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
859 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
860 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
861 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
862 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
863 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
864 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
865 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
866 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
867 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
868 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
869 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
870 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
872 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
873 & gcorr3_turn_max=gcorr3_turn_norm
874 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
876 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
877 & gcorr4_turn_max=gcorr4_turn_norm
878 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
879 if (gradcorr5_norm.gt.gradcorr5_max)
880 & gradcorr5_max=gradcorr5_norm
881 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
882 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
883 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
885 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
886 & gcorr6_turn_max=gcorr6_turn_norm
887 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
888 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
889 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
890 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
891 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
892 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
894 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
895 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
897 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
898 if (gradx_scp_norm.gt.gradx_scp_max)
899 & gradx_scp_max=gradx_scp_norm
900 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
901 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
902 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
903 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
904 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
905 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
906 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
907 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
911 open(istat,file=statname,position="append")
913 open(istat,file=statname,access="append")
915 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
916 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
917 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
918 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
919 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
920 & gsccorx_max,gsclocx_max
922 if (gvdwc_max.gt.1.0d4) then
923 write (iout,*) "gvdwc gvdwx gradb gradbx"
925 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
926 & gradb(j,i),gradbx(j,i),j=1,3)
928 call pdbout(0.0d0,'cipiszcze',iout)
934 write (iout,*) "gradc gradx gloc"
936 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
937 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
942 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
944 time_sumgradient=time_sumgradient+tcpu()-time01
949 c-------------------------------------------------------------------------------
950 subroutine rescale_weights(t_bath)
951 implicit real*8 (a-h,o-z)
953 include 'COMMON.IOUNITS'
954 include 'COMMON.FFIELD'
955 include 'COMMON.SBRIDGE'
956 double precision kfac /2.4d0/
957 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
959 c facT=2*temp0/(t_bath+temp0)
960 if (rescale_mode.eq.0) then
966 else if (rescale_mode.eq.1) then
967 facT=kfac/(kfac-1.0d0+t_bath/temp0)
968 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
969 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
970 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
971 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
972 else if (rescale_mode.eq.2) then
978 facT=licznik/dlog(dexp(x)+dexp(-x))
979 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
980 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
981 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
982 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
984 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
985 write (*,*) "Wrong RESCALE_MODE",rescale_mode
987 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
991 welec=weights(3)*fact
992 wcorr=weights(4)*fact3
993 wcorr5=weights(5)*fact4
994 wcorr6=weights(6)*fact5
995 wel_loc=weights(7)*fact2
996 wturn3=weights(8)*fact2
997 wturn4=weights(9)*fact3
998 wturn6=weights(10)*fact5
999 wtor=weights(13)*fact
1000 wtor_d=weights(14)*fact2
1001 wsccor=weights(21)*fact
1004 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1008 C------------------------------------------------------------------------
1009 subroutine enerprint(energia)
1010 implicit real*8 (a-h,o-z)
1011 include 'DIMENSIONS'
1012 include 'COMMON.IOUNITS'
1013 include 'COMMON.FFIELD'
1014 include 'COMMON.SBRIDGE'
1016 double precision energia(0:n_ene)
1019 evdw=energia(22)+wsct*energia(23)
1025 evdw2=energia(2)+energia(18)
1037 eello_turn3=energia(8)
1038 eello_turn4=energia(9)
1039 eello_turn6=energia(10)
1045 edihcnstr=energia(19)
1050 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1051 & estr,wbond,ebe,wang,
1052 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1054 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1055 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1056 & edihcnstr,ebr*nss,
1058 10 format (/'Virtual-chain energies:'//
1059 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1060 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1061 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1062 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1063 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1064 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1065 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1066 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1067 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1068 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1069 & ' (SS bridges & dist. cnstr.)'/
1070 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1071 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1072 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1073 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1074 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1075 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1076 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1077 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1078 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1079 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1080 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1081 & 'ETOT= ',1pE16.6,' (total)')
1083 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1084 & estr,wbond,ebe,wang,
1085 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1087 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1088 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1089 & ebr*nss,Uconst,etot
1090 10 format (/'Virtual-chain energies:'//
1091 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1092 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1093 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1094 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1095 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1096 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1097 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1098 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1099 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1100 & ' (SS bridges & dist. cnstr.)'/
1101 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1102 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1103 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1104 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1105 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1106 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1107 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1108 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1109 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1110 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1111 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1112 & 'ETOT= ',1pE16.6,' (total)')
1116 C-----------------------------------------------------------------------
1117 subroutine elj(evdw,evdw_p,evdw_m)
1119 C This subroutine calculates the interaction energy of nonbonded side chains
1120 C assuming the LJ potential of interaction.
1122 implicit real*8 (a-h,o-z)
1123 include 'DIMENSIONS'
1124 parameter (accur=1.0d-10)
1125 include 'COMMON.GEO'
1126 include 'COMMON.VAR'
1127 include 'COMMON.LOCAL'
1128 include 'COMMON.CHAIN'
1129 include 'COMMON.DERIV'
1130 include 'COMMON.INTERACT'
1131 include 'COMMON.TORSION'
1132 include 'COMMON.SBRIDGE'
1133 include 'COMMON.NAMES'
1134 include 'COMMON.IOUNITS'
1135 include 'COMMON.CONTACTS'
1137 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1139 do i=iatsc_s,iatsc_e
1148 C Calculate SC interaction energy.
1150 do iint=1,nint_gr(i)
1151 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1152 cd & 'iend=',iend(i,iint)
1153 do j=istart(i,iint),iend(i,iint)
1158 C Change 12/1/95 to calculate four-body interactions
1159 rij=xj*xj+yj*yj+zj*zj
1161 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1162 eps0ij=eps(itypi,itypj)
1164 e1=fac*fac*aa(itypi,itypj)
1165 e2=fac*bb(itypi,itypj)
1167 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1168 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1169 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1170 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1171 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1172 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1174 if (bb(itypi,itypj).gt.0) then
1175 evdw_p=evdw_p+evdwij
1177 evdw_m=evdw_m+evdwij
1183 C Calculate the components of the gradient in DC and X
1185 fac=-rrij*(e1+evdwij)
1190 if (bb(itypi,itypj).gt.0.0d0) then
1192 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1193 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1194 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1195 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1199 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1200 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1201 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1202 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1207 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1208 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1209 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1210 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1215 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1219 C 12/1/95, revised on 5/20/97
1221 C Calculate the contact function. The ith column of the array JCONT will
1222 C contain the numbers of atoms that make contacts with the atom I (of numbers
1223 C greater than I). The arrays FACONT and GACONT will contain the values of
1224 C the contact function and its derivative.
1226 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1227 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1228 C Uncomment next line, if the correlation interactions are contact function only
1229 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1231 sigij=sigma(itypi,itypj)
1232 r0ij=rs0(itypi,itypj)
1234 C Check whether the SC's are not too far to make a contact.
1237 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1238 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1240 if (fcont.gt.0.0D0) then
1241 C If the SC-SC distance if close to sigma, apply spline.
1242 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1243 cAdam & fcont1,fprimcont1)
1244 cAdam fcont1=1.0d0-fcont1
1245 cAdam if (fcont1.gt.0.0d0) then
1246 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1247 cAdam fcont=fcont*fcont1
1249 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1250 cga eps0ij=1.0d0/dsqrt(eps0ij)
1252 cga gg(k)=gg(k)*eps0ij
1254 cga eps0ij=-evdwij*eps0ij
1255 C Uncomment for AL's type of SC correlation interactions.
1256 cadam eps0ij=-evdwij
1257 num_conti=num_conti+1
1258 jcont(num_conti,i)=j
1259 facont(num_conti,i)=fcont*eps0ij
1260 fprimcont=eps0ij*fprimcont/rij
1262 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1263 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1264 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1265 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1266 gacont(1,num_conti,i)=-fprimcont*xj
1267 gacont(2,num_conti,i)=-fprimcont*yj
1268 gacont(3,num_conti,i)=-fprimcont*zj
1269 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1270 cd write (iout,'(2i3,3f10.5)')
1271 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1277 num_cont(i)=num_conti
1281 gvdwc(j,i)=expon*gvdwc(j,i)
1282 gvdwx(j,i)=expon*gvdwx(j,i)
1285 C******************************************************************************
1289 C To save time, the factor of EXPON has been extracted from ALL components
1290 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1293 C******************************************************************************
1296 C-----------------------------------------------------------------------------
1297 subroutine eljk(evdw,evdw_p,evdw_m)
1299 C This subroutine calculates the interaction energy of nonbonded side chains
1300 C assuming the LJK potential of interaction.
1302 implicit real*8 (a-h,o-z)
1303 include 'DIMENSIONS'
1304 include 'COMMON.GEO'
1305 include 'COMMON.VAR'
1306 include 'COMMON.LOCAL'
1307 include 'COMMON.CHAIN'
1308 include 'COMMON.DERIV'
1309 include 'COMMON.INTERACT'
1310 include 'COMMON.IOUNITS'
1311 include 'COMMON.NAMES'
1314 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1316 do i=iatsc_s,iatsc_e
1323 C Calculate SC interaction energy.
1325 do iint=1,nint_gr(i)
1326 do j=istart(i,iint),iend(i,iint)
1331 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1332 fac_augm=rrij**expon
1333 e_augm=augm(itypi,itypj)*fac_augm
1334 r_inv_ij=dsqrt(rrij)
1336 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1337 fac=r_shift_inv**expon
1338 e1=fac*fac*aa(itypi,itypj)
1339 e2=fac*bb(itypi,itypj)
1341 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1342 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1343 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1344 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1345 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1346 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1347 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1349 if (bb(itypi,itypj).gt.0) then
1350 evdw_p=evdw_p+evdwij
1352 evdw_m=evdw_m+evdwij
1358 C Calculate the components of the gradient in DC and X
1360 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1365 if (bb(itypi,itypj).gt.0.0d0) then
1367 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1368 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1369 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1370 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1374 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1375 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1376 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1377 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1382 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1383 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1384 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1385 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1390 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1398 gvdwc(j,i)=expon*gvdwc(j,i)
1399 gvdwx(j,i)=expon*gvdwx(j,i)
1404 C-----------------------------------------------------------------------------
1405 subroutine ebp(evdw,evdw_p,evdw_m)
1407 C This subroutine calculates the interaction energy of nonbonded side chains
1408 C assuming the Berne-Pechukas potential of interaction.
1410 implicit real*8 (a-h,o-z)
1411 include 'DIMENSIONS'
1412 include 'COMMON.GEO'
1413 include 'COMMON.VAR'
1414 include 'COMMON.LOCAL'
1415 include 'COMMON.CHAIN'
1416 include 'COMMON.DERIV'
1417 include 'COMMON.NAMES'
1418 include 'COMMON.INTERACT'
1419 include 'COMMON.IOUNITS'
1420 include 'COMMON.CALC'
1421 common /srutu/ icall
1422 c double precision rrsave(maxdim)
1425 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1427 c if (icall.eq.0) then
1433 do i=iatsc_s,iatsc_e
1439 dxi=dc_norm(1,nres+i)
1440 dyi=dc_norm(2,nres+i)
1441 dzi=dc_norm(3,nres+i)
1442 c dsci_inv=dsc_inv(itypi)
1443 dsci_inv=vbld_inv(i+nres)
1445 C Calculate SC interaction energy.
1447 do iint=1,nint_gr(i)
1448 do j=istart(i,iint),iend(i,iint)
1451 c dscj_inv=dsc_inv(itypj)
1452 dscj_inv=vbld_inv(j+nres)
1453 chi1=chi(itypi,itypj)
1454 chi2=chi(itypj,itypi)
1461 alf12=0.5D0*(alf1+alf2)
1462 C For diagnostics only!!!
1475 dxj=dc_norm(1,nres+j)
1476 dyj=dc_norm(2,nres+j)
1477 dzj=dc_norm(3,nres+j)
1478 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1479 cd if (icall.eq.0) then
1485 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1487 C Calculate whole angle-dependent part of epsilon and contributions
1488 C to its derivatives
1489 fac=(rrij*sigsq)**expon2
1490 e1=fac*fac*aa(itypi,itypj)
1491 e2=fac*bb(itypi,itypj)
1492 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1493 eps2der=evdwij*eps3rt
1494 eps3der=evdwij*eps2rt
1495 evdwij=evdwij*eps2rt*eps3rt
1497 if (bb(itypi,itypj).gt.0) then
1498 evdw_p=evdw_p+evdwij
1500 evdw_m=evdw_m+evdwij
1506 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1507 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1508 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1509 cd & restyp(itypi),i,restyp(itypj),j,
1510 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1511 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1512 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1515 C Calculate gradient components.
1516 e1=e1*eps1*eps2rt**2*eps3rt**2
1517 fac=-expon*(e1+evdwij)
1520 C Calculate radial part of the gradient
1524 C Calculate the angular part of the gradient and sum add the contributions
1525 C to the appropriate components of the Cartesian gradient.
1527 if (bb(itypi,itypj).gt.0) then
1541 C-----------------------------------------------------------------------------
1542 subroutine egb(evdw,evdw_p,evdw_m)
1544 C This subroutine calculates the interaction energy of nonbonded side chains
1545 C assuming the Gay-Berne potential of interaction.
1547 implicit real*8 (a-h,o-z)
1548 include 'DIMENSIONS'
1549 include 'COMMON.GEO'
1550 include 'COMMON.VAR'
1551 include 'COMMON.LOCAL'
1552 include 'COMMON.CHAIN'
1553 include 'COMMON.DERIV'
1554 include 'COMMON.NAMES'
1555 include 'COMMON.INTERACT'
1556 include 'COMMON.IOUNITS'
1557 include 'COMMON.CALC'
1558 include 'COMMON.CONTROL'
1561 ccccc energy_dec=.false.
1562 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1567 c if (icall.eq.0) lprn=.false.
1569 do i=iatsc_s,iatsc_e
1575 dxi=dc_norm(1,nres+i)
1576 dyi=dc_norm(2,nres+i)
1577 dzi=dc_norm(3,nres+i)
1578 c dsci_inv=dsc_inv(itypi)
1579 dsci_inv=vbld_inv(i+nres)
1580 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1581 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1583 C Calculate SC interaction energy.
1585 do iint=1,nint_gr(i)
1586 do j=istart(i,iint),iend(i,iint)
1589 c dscj_inv=dsc_inv(itypj)
1590 dscj_inv=vbld_inv(j+nres)
1591 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1592 c & 1.0d0/vbld(j+nres)
1593 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1594 sig0ij=sigma(itypi,itypj)
1595 chi1=chi(itypi,itypj)
1596 chi2=chi(itypj,itypi)
1603 alf12=0.5D0*(alf1+alf2)
1604 C For diagnostics only!!!
1617 dxj=dc_norm(1,nres+j)
1618 dyj=dc_norm(2,nres+j)
1619 dzj=dc_norm(3,nres+j)
1620 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1621 c write (iout,*) "j",j," dc_norm",
1622 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1623 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1625 C Calculate angle-dependent terms of energy and contributions to their
1629 sig=sig0ij*dsqrt(sigsq)
1630 rij_shift=1.0D0/rij-sig+sig0ij
1631 c for diagnostics; uncomment
1632 c rij_shift=1.2*sig0ij
1633 C I hate to put IF's in the loops, but here don't have another choice!!!!
1634 if (rij_shift.le.0.0D0) then
1636 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1637 cd & restyp(itypi),i,restyp(itypj),j,
1638 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1642 c---------------------------------------------------------------
1643 rij_shift=1.0D0/rij_shift
1644 fac=rij_shift**expon
1645 e1=fac*fac*aa(itypi,itypj)
1646 e2=fac*bb(itypi,itypj)
1647 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1648 eps2der=evdwij*eps3rt
1649 eps3der=evdwij*eps2rt
1650 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1651 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1652 evdwij=evdwij*eps2rt*eps3rt
1654 if (bb(itypi,itypj).gt.0) then
1655 evdw_p=evdw_p+evdwij
1657 evdw_m=evdw_m+evdwij
1663 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1664 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1665 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1666 & restyp(itypi),i,restyp(itypj),j,
1667 & epsi,sigm,chi1,chi2,chip1,chip2,
1668 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1669 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1673 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1676 C Calculate gradient components.
1677 e1=e1*eps1*eps2rt**2*eps3rt**2
1678 fac=-expon*(e1+evdwij)*rij_shift
1682 C Calculate the radial part of the gradient
1686 C Calculate angular part of the gradient.
1688 if (bb(itypi,itypj).gt.0) then
1699 c write (iout,*) "Number of loop steps in EGB:",ind
1700 cccc energy_dec=.false.
1703 C-----------------------------------------------------------------------------
1704 subroutine egbv(evdw,evdw_p,evdw_m)
1706 C This subroutine calculates the interaction energy of nonbonded side chains
1707 C assuming the Gay-Berne-Vorobjev potential of interaction.
1709 implicit real*8 (a-h,o-z)
1710 include 'DIMENSIONS'
1711 include 'COMMON.GEO'
1712 include 'COMMON.VAR'
1713 include 'COMMON.LOCAL'
1714 include 'COMMON.CHAIN'
1715 include 'COMMON.DERIV'
1716 include 'COMMON.NAMES'
1717 include 'COMMON.INTERACT'
1718 include 'COMMON.IOUNITS'
1719 include 'COMMON.CALC'
1720 common /srutu/ icall
1723 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1726 c if (icall.eq.0) lprn=.true.
1728 do i=iatsc_s,iatsc_e
1734 dxi=dc_norm(1,nres+i)
1735 dyi=dc_norm(2,nres+i)
1736 dzi=dc_norm(3,nres+i)
1737 c dsci_inv=dsc_inv(itypi)
1738 dsci_inv=vbld_inv(i+nres)
1740 C Calculate SC interaction energy.
1742 do iint=1,nint_gr(i)
1743 do j=istart(i,iint),iend(i,iint)
1746 c dscj_inv=dsc_inv(itypj)
1747 dscj_inv=vbld_inv(j+nres)
1748 sig0ij=sigma(itypi,itypj)
1749 r0ij=r0(itypi,itypj)
1750 chi1=chi(itypi,itypj)
1751 chi2=chi(itypj,itypi)
1758 alf12=0.5D0*(alf1+alf2)
1759 C For diagnostics only!!!
1772 dxj=dc_norm(1,nres+j)
1773 dyj=dc_norm(2,nres+j)
1774 dzj=dc_norm(3,nres+j)
1775 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1777 C Calculate angle-dependent terms of energy and contributions to their
1781 sig=sig0ij*dsqrt(sigsq)
1782 rij_shift=1.0D0/rij-sig+r0ij
1783 C I hate to put IF's in the loops, but here don't have another choice!!!!
1784 if (rij_shift.le.0.0D0) then
1789 c---------------------------------------------------------------
1790 rij_shift=1.0D0/rij_shift
1791 fac=rij_shift**expon
1792 e1=fac*fac*aa(itypi,itypj)
1793 e2=fac*bb(itypi,itypj)
1794 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1795 eps2der=evdwij*eps3rt
1796 eps3der=evdwij*eps2rt
1797 fac_augm=rrij**expon
1798 e_augm=augm(itypi,itypj)*fac_augm
1799 evdwij=evdwij*eps2rt*eps3rt
1801 if (bb(itypi,itypj).gt.0) then
1802 evdw_p=evdw_p+evdwij+e_augm
1804 evdw_m=evdw_m+evdwij+e_augm
1807 evdw=evdw+evdwij+e_augm
1810 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1811 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1812 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1813 & restyp(itypi),i,restyp(itypj),j,
1814 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1815 & chi1,chi2,chip1,chip2,
1816 & eps1,eps2rt**2,eps3rt**2,
1817 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1820 C Calculate gradient components.
1821 e1=e1*eps1*eps2rt**2*eps3rt**2
1822 fac=-expon*(e1+evdwij)*rij_shift
1824 fac=rij*fac-2*expon*rrij*e_augm
1825 C Calculate the radial part of the gradient
1829 C Calculate angular part of the gradient.
1831 if (bb(itypi,itypj).gt.0) then
1843 C-----------------------------------------------------------------------------
1844 subroutine sc_angular
1845 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1846 C om12. Called by ebp, egb, and egbv.
1848 include 'COMMON.CALC'
1849 include 'COMMON.IOUNITS'
1853 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1854 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1855 om12=dxi*dxj+dyi*dyj+dzi*dzj
1857 C Calculate eps1(om12) and its derivative in om12
1858 faceps1=1.0D0-om12*chiom12
1859 faceps1_inv=1.0D0/faceps1
1860 eps1=dsqrt(faceps1_inv)
1861 C Following variable is eps1*deps1/dom12
1862 eps1_om12=faceps1_inv*chiom12
1867 c write (iout,*) "om12",om12," eps1",eps1
1868 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1873 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1874 sigsq=1.0D0-facsig*faceps1_inv
1875 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1876 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1877 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1883 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1884 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1886 C Calculate eps2 and its derivatives in om1, om2, and om12.
1889 chipom12=chip12*om12
1890 facp=1.0D0-om12*chipom12
1892 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1893 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1894 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1895 C Following variable is the square root of eps2
1896 eps2rt=1.0D0-facp1*facp_inv
1897 C Following three variables are the derivatives of the square root of eps
1898 C in om1, om2, and om12.
1899 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1900 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1901 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1902 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1903 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1904 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1905 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1906 c & " eps2rt_om12",eps2rt_om12
1907 C Calculate whole angle-dependent part of epsilon and contributions
1908 C to its derivatives
1912 C----------------------------------------------------------------------------
1913 subroutine sc_grad_T
1914 implicit real*8 (a-h,o-z)
1915 include 'DIMENSIONS'
1916 include 'COMMON.CHAIN'
1917 include 'COMMON.DERIV'
1918 include 'COMMON.CALC'
1919 include 'COMMON.IOUNITS'
1920 double precision dcosom1(3),dcosom2(3)
1921 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1922 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1923 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1924 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1928 c eom12=evdwij*eps1_om12
1930 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1931 c & " sigder",sigder
1932 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1933 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1935 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1936 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1939 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1941 c write (iout,*) "gg",(gg(k),k=1,3)
1943 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1944 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1945 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1946 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1947 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1948 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1949 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1950 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1951 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1952 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1955 C Calculate the components of the gradient in DC and X
1959 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1963 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1964 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1969 C----------------------------------------------------------------------------
1971 implicit real*8 (a-h,o-z)
1972 include 'DIMENSIONS'
1973 include 'COMMON.CHAIN'
1974 include 'COMMON.DERIV'
1975 include 'COMMON.CALC'
1976 include 'COMMON.IOUNITS'
1977 double precision dcosom1(3),dcosom2(3)
1978 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1979 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1980 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1981 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1985 c eom12=evdwij*eps1_om12
1987 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1988 c & " sigder",sigder
1989 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1990 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1992 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1993 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1996 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1998 c write (iout,*) "gg",(gg(k),k=1,3)
2000 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2001 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2002 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2003 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2004 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2005 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2006 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2007 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2008 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2009 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2012 C Calculate the components of the gradient in DC and X
2016 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2020 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2021 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2025 C-----------------------------------------------------------------------
2026 subroutine e_softsphere(evdw)
2028 C This subroutine calculates the interaction energy of nonbonded side chains
2029 C assuming the LJ potential of interaction.
2031 implicit real*8 (a-h,o-z)
2032 include 'DIMENSIONS'
2033 parameter (accur=1.0d-10)
2034 include 'COMMON.GEO'
2035 include 'COMMON.VAR'
2036 include 'COMMON.LOCAL'
2037 include 'COMMON.CHAIN'
2038 include 'COMMON.DERIV'
2039 include 'COMMON.INTERACT'
2040 include 'COMMON.TORSION'
2041 include 'COMMON.SBRIDGE'
2042 include 'COMMON.NAMES'
2043 include 'COMMON.IOUNITS'
2044 include 'COMMON.CONTACTS'
2046 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2048 do i=iatsc_s,iatsc_e
2055 C Calculate SC interaction energy.
2057 do iint=1,nint_gr(i)
2058 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2059 cd & 'iend=',iend(i,iint)
2060 do j=istart(i,iint),iend(i,iint)
2065 rij=xj*xj+yj*yj+zj*zj
2066 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2067 r0ij=r0(itypi,itypj)
2069 c print *,i,j,r0ij,dsqrt(rij)
2070 if (rij.lt.r0ijsq) then
2071 evdwij=0.25d0*(rij-r0ijsq)**2
2079 C Calculate the components of the gradient in DC and X
2085 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2086 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2087 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2088 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2092 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2100 C--------------------------------------------------------------------------
2101 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2104 C Soft-sphere potential of p-p interaction
2106 implicit real*8 (a-h,o-z)
2107 include 'DIMENSIONS'
2108 include 'COMMON.CONTROL'
2109 include 'COMMON.IOUNITS'
2110 include 'COMMON.GEO'
2111 include 'COMMON.VAR'
2112 include 'COMMON.LOCAL'
2113 include 'COMMON.CHAIN'
2114 include 'COMMON.DERIV'
2115 include 'COMMON.INTERACT'
2116 include 'COMMON.CONTACTS'
2117 include 'COMMON.TORSION'
2118 include 'COMMON.VECTORS'
2119 include 'COMMON.FFIELD'
2121 cd write(iout,*) 'In EELEC_soft_sphere'
2128 do i=iatel_s,iatel_e
2132 xmedi=c(1,i)+0.5d0*dxi
2133 ymedi=c(2,i)+0.5d0*dyi
2134 zmedi=c(3,i)+0.5d0*dzi
2136 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2137 do j=ielstart(i),ielend(i)
2141 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2142 r0ij=rpp(iteli,itelj)
2147 xj=c(1,j)+0.5D0*dxj-xmedi
2148 yj=c(2,j)+0.5D0*dyj-ymedi
2149 zj=c(3,j)+0.5D0*dzj-zmedi
2150 rij=xj*xj+yj*yj+zj*zj
2151 if (rij.lt.r0ijsq) then
2152 evdw1ij=0.25d0*(rij-r0ijsq)**2
2160 C Calculate contributions to the Cartesian gradient.
2166 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2167 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2170 * Loop over residues i+1 thru j-1.
2174 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2179 cgrad do i=nnt,nct-1
2181 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2183 cgrad do j=i+1,nct-1
2185 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2191 c------------------------------------------------------------------------------
2192 subroutine vec_and_deriv
2193 implicit real*8 (a-h,o-z)
2194 include 'DIMENSIONS'
2198 include 'COMMON.IOUNITS'
2199 include 'COMMON.GEO'
2200 include 'COMMON.VAR'
2201 include 'COMMON.LOCAL'
2202 include 'COMMON.CHAIN'
2203 include 'COMMON.VECTORS'
2204 include 'COMMON.SETUP'
2205 include 'COMMON.TIME1'
2206 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2207 C Compute the local reference systems. For reference system (i), the
2208 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2209 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2211 do i=ivec_start,ivec_end
2215 if (i.eq.nres-1) then
2216 C Case of the last full residue
2217 C Compute the Z-axis
2218 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2219 costh=dcos(pi-theta(nres))
2220 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2224 C Compute the derivatives of uz
2226 uzder(2,1,1)=-dc_norm(3,i-1)
2227 uzder(3,1,1)= dc_norm(2,i-1)
2228 uzder(1,2,1)= dc_norm(3,i-1)
2230 uzder(3,2,1)=-dc_norm(1,i-1)
2231 uzder(1,3,1)=-dc_norm(2,i-1)
2232 uzder(2,3,1)= dc_norm(1,i-1)
2235 uzder(2,1,2)= dc_norm(3,i)
2236 uzder(3,1,2)=-dc_norm(2,i)
2237 uzder(1,2,2)=-dc_norm(3,i)
2239 uzder(3,2,2)= dc_norm(1,i)
2240 uzder(1,3,2)= dc_norm(2,i)
2241 uzder(2,3,2)=-dc_norm(1,i)
2243 C Compute the Y-axis
2246 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2248 C Compute the derivatives of uy
2251 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2252 & -dc_norm(k,i)*dc_norm(j,i-1)
2253 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2255 uyder(j,j,1)=uyder(j,j,1)-costh
2256 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2261 uygrad(l,k,j,i)=uyder(l,k,j)
2262 uzgrad(l,k,j,i)=uzder(l,k,j)
2266 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2267 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2268 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2269 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2272 C Compute the Z-axis
2273 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2274 costh=dcos(pi-theta(i+2))
2275 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2279 C Compute the derivatives of uz
2281 uzder(2,1,1)=-dc_norm(3,i+1)
2282 uzder(3,1,1)= dc_norm(2,i+1)
2283 uzder(1,2,1)= dc_norm(3,i+1)
2285 uzder(3,2,1)=-dc_norm(1,i+1)
2286 uzder(1,3,1)=-dc_norm(2,i+1)
2287 uzder(2,3,1)= dc_norm(1,i+1)
2290 uzder(2,1,2)= dc_norm(3,i)
2291 uzder(3,1,2)=-dc_norm(2,i)
2292 uzder(1,2,2)=-dc_norm(3,i)
2294 uzder(3,2,2)= dc_norm(1,i)
2295 uzder(1,3,2)= dc_norm(2,i)
2296 uzder(2,3,2)=-dc_norm(1,i)
2298 C Compute the Y-axis
2301 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2303 C Compute the derivatives of uy
2306 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2307 & -dc_norm(k,i)*dc_norm(j,i+1)
2308 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2310 uyder(j,j,1)=uyder(j,j,1)-costh
2311 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2316 uygrad(l,k,j,i)=uyder(l,k,j)
2317 uzgrad(l,k,j,i)=uzder(l,k,j)
2321 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2322 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2323 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2324 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2328 vbld_inv_temp(1)=vbld_inv(i+1)
2329 if (i.lt.nres-1) then
2330 vbld_inv_temp(2)=vbld_inv(i+2)
2332 vbld_inv_temp(2)=vbld_inv(i)
2337 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2338 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2343 #if defined(PARVEC) && defined(MPI)
2344 if (nfgtasks1.gt.1) then
2346 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2347 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2348 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2349 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2350 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2352 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2353 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2355 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2356 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2357 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2358 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2359 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2360 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2361 time_gather=time_gather+MPI_Wtime()-time00
2363 c if (fg_rank.eq.0) then
2364 c write (iout,*) "Arrays UY and UZ"
2366 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2373 C-----------------------------------------------------------------------------
2374 subroutine check_vecgrad
2375 implicit real*8 (a-h,o-z)
2376 include 'DIMENSIONS'
2377 include 'COMMON.IOUNITS'
2378 include 'COMMON.GEO'
2379 include 'COMMON.VAR'
2380 include 'COMMON.LOCAL'
2381 include 'COMMON.CHAIN'
2382 include 'COMMON.VECTORS'
2383 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2384 dimension uyt(3,maxres),uzt(3,maxres)
2385 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2386 double precision delta /1.0d-7/
2389 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2390 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2391 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2392 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2393 cd & (dc_norm(if90,i),if90=1,3)
2394 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2395 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2396 cd write(iout,'(a)')
2402 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2403 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2416 cd write (iout,*) 'i=',i
2418 erij(k)=dc_norm(k,i)
2422 dc_norm(k,i)=erij(k)
2424 dc_norm(j,i)=dc_norm(j,i)+delta
2425 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2427 c dc_norm(k,i)=dc_norm(k,i)/fac
2429 c write (iout,*) (dc_norm(k,i),k=1,3)
2430 c write (iout,*) (erij(k),k=1,3)
2433 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2434 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2435 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2436 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2438 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2439 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2440 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2443 dc_norm(k,i)=erij(k)
2446 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2447 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2448 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2449 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2450 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2451 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2452 cd write (iout,'(a)')
2457 C--------------------------------------------------------------------------
2458 subroutine set_matrices
2459 implicit real*8 (a-h,o-z)
2460 include 'DIMENSIONS'
2463 include "COMMON.SETUP"
2465 integer status(MPI_STATUS_SIZE)
2467 include 'COMMON.IOUNITS'
2468 include 'COMMON.GEO'
2469 include 'COMMON.VAR'
2470 include 'COMMON.LOCAL'
2471 include 'COMMON.CHAIN'
2472 include 'COMMON.DERIV'
2473 include 'COMMON.INTERACT'
2474 include 'COMMON.CONTACTS'
2475 include 'COMMON.TORSION'
2476 include 'COMMON.VECTORS'
2477 include 'COMMON.FFIELD'
2478 double precision auxvec(2),auxmat(2,2)
2480 C Compute the virtual-bond-torsional-angle dependent quantities needed
2481 C to calculate the el-loc multibody terms of various order.
2484 do i=ivec_start+2,ivec_end+2
2488 if (i .lt. nres+1) then
2525 if (i .gt. 3 .and. i .lt. nres+1) then
2526 obrot_der(1,i-2)=-sin1
2527 obrot_der(2,i-2)= cos1
2528 Ugder(1,1,i-2)= sin1
2529 Ugder(1,2,i-2)=-cos1
2530 Ugder(2,1,i-2)=-cos1
2531 Ugder(2,2,i-2)=-sin1
2534 obrot2_der(1,i-2)=-dwasin2
2535 obrot2_der(2,i-2)= dwacos2
2536 Ug2der(1,1,i-2)= dwasin2
2537 Ug2der(1,2,i-2)=-dwacos2
2538 Ug2der(2,1,i-2)=-dwacos2
2539 Ug2der(2,2,i-2)=-dwasin2
2541 obrot_der(1,i-2)=0.0d0
2542 obrot_der(2,i-2)=0.0d0
2543 Ugder(1,1,i-2)=0.0d0
2544 Ugder(1,2,i-2)=0.0d0
2545 Ugder(2,1,i-2)=0.0d0
2546 Ugder(2,2,i-2)=0.0d0
2547 obrot2_der(1,i-2)=0.0d0
2548 obrot2_der(2,i-2)=0.0d0
2549 Ug2der(1,1,i-2)=0.0d0
2550 Ug2der(1,2,i-2)=0.0d0
2551 Ug2der(2,1,i-2)=0.0d0
2552 Ug2der(2,2,i-2)=0.0d0
2554 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2555 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2556 iti = itortyp(itype(i-2))
2560 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2561 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2562 iti1 = itortyp(itype(i-1))
2566 cd write (iout,*) '*******i',i,' iti1',iti
2567 cd write (iout,*) 'b1',b1(:,iti)
2568 cd write (iout,*) 'b2',b2(:,iti)
2569 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2570 c if (i .gt. iatel_s+2) then
2571 if (i .gt. nnt+2) then
2572 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2573 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2574 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2576 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2577 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2578 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2579 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2580 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2591 DtUg2(l,k,i-2)=0.0d0
2595 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2596 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2598 muder(k,i-2)=Ub2der(k,i-2)
2600 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2601 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2602 iti1 = itortyp(itype(i-1))
2607 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2609 cd write (iout,*) 'mu ',mu(:,i-2)
2610 cd write (iout,*) 'mu1',mu1(:,i-2)
2611 cd write (iout,*) 'mu2',mu2(:,i-2)
2612 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2614 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2615 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2616 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2617 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2618 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2619 C Vectors and matrices dependent on a single virtual-bond dihedral.
2620 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2621 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2622 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2623 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2624 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2625 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2626 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2627 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2628 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2631 C Matrices dependent on two consecutive virtual-bond dihedrals.
2632 C The order of matrices is from left to right.
2633 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2635 c do i=max0(ivec_start,2),ivec_end
2637 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2638 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2639 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2640 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2641 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2642 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2643 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2644 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2647 #if defined(MPI) && defined(PARMAT)
2649 c if (fg_rank.eq.0) then
2650 write (iout,*) "Arrays UG and UGDER before GATHER"
2652 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2653 & ((ug(l,k,i),l=1,2),k=1,2),
2654 & ((ugder(l,k,i),l=1,2),k=1,2)
2656 write (iout,*) "Arrays UG2 and UG2DER"
2658 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2659 & ((ug2(l,k,i),l=1,2),k=1,2),
2660 & ((ug2der(l,k,i),l=1,2),k=1,2)
2662 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2664 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2665 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2666 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2668 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2670 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2671 & costab(i),sintab(i),costab2(i),sintab2(i)
2673 write (iout,*) "Array MUDER"
2675 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2679 if (nfgtasks.gt.1) then
2681 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2682 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2683 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2685 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2686 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2688 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2689 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2691 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2692 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2694 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2695 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2700 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2703 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2704 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2705 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2706 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2707 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2708 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2709 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2710 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2711 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2712 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2713 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2714 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2715 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2717 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2718 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2720 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2721 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2723 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2724 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2726 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2727 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2729 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2730 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2732 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2733 & ivec_count(fg_rank1),
2734 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2736 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2737 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2739 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2740 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2742 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2743 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2745 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2746 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2748 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2749 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2751 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2752 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2754 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2755 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2757 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2758 & ivec_count(fg_rank1),
2759 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2761 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2762 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2764 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2765 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2767 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2768 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2770 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2771 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2773 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2774 & ivec_count(fg_rank1),
2775 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2777 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2778 & ivec_count(fg_rank1),
2779 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2781 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2782 & ivec_count(fg_rank1),
2783 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2784 & MPI_MAT2,FG_COMM1,IERR)
2785 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2786 & ivec_count(fg_rank1),
2787 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2788 & MPI_MAT2,FG_COMM1,IERR)
2791 c Passes matrix info through the ring
2794 if (irecv.lt.0) irecv=nfgtasks1-1
2797 if (inext.ge.nfgtasks1) inext=0
2799 c write (iout,*) "isend",isend," irecv",irecv
2801 lensend=lentyp(isend)
2802 lenrecv=lentyp(irecv)
2803 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2804 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2805 c & MPI_ROTAT1(lensend),inext,2200+isend,
2806 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2807 c & iprev,2200+irecv,FG_COMM,status,IERR)
2808 c write (iout,*) "Gather ROTAT1"
2810 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2811 c & MPI_ROTAT2(lensend),inext,3300+isend,
2812 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2813 c & iprev,3300+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather ROTAT2"
2816 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2817 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2818 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2819 & iprev,4400+irecv,FG_COMM,status,IERR)
2820 c write (iout,*) "Gather ROTAT_OLD"
2822 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2823 & MPI_PRECOMP11(lensend),inext,5500+isend,
2824 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2825 & iprev,5500+irecv,FG_COMM,status,IERR)
2826 c write (iout,*) "Gather PRECOMP11"
2828 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2829 & MPI_PRECOMP12(lensend),inext,6600+isend,
2830 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2831 & iprev,6600+irecv,FG_COMM,status,IERR)
2832 c write (iout,*) "Gather PRECOMP12"
2834 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2836 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2837 & MPI_ROTAT2(lensend),inext,7700+isend,
2838 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2839 & iprev,7700+irecv,FG_COMM,status,IERR)
2840 c write (iout,*) "Gather PRECOMP21"
2842 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2843 & MPI_PRECOMP22(lensend),inext,8800+isend,
2844 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2845 & iprev,8800+irecv,FG_COMM,status,IERR)
2846 c write (iout,*) "Gather PRECOMP22"
2848 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2849 & MPI_PRECOMP23(lensend),inext,9900+isend,
2850 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2851 & MPI_PRECOMP23(lenrecv),
2852 & iprev,9900+irecv,FG_COMM,status,IERR)
2853 c write (iout,*) "Gather PRECOMP23"
2858 if (irecv.lt.0) irecv=nfgtasks1-1
2861 time_gather=time_gather+MPI_Wtime()-time00
2864 c if (fg_rank.eq.0) then
2865 write (iout,*) "Arrays UG and UGDER"
2867 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2868 & ((ug(l,k,i),l=1,2),k=1,2),
2869 & ((ugder(l,k,i),l=1,2),k=1,2)
2871 write (iout,*) "Arrays UG2 and UG2DER"
2873 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2874 & ((ug2(l,k,i),l=1,2),k=1,2),
2875 & ((ug2der(l,k,i),l=1,2),k=1,2)
2877 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2879 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2880 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2881 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2883 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2885 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2886 & costab(i),sintab(i),costab2(i),sintab2(i)
2888 write (iout,*) "Array MUDER"
2890 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2896 cd iti = itortyp(itype(i))
2899 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2900 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2905 C--------------------------------------------------------------------------
2906 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2908 C This subroutine calculates the average interaction energy and its gradient
2909 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2910 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2911 C The potential depends both on the distance of peptide-group centers and on
2912 C the orientation of the CA-CA virtual bonds.
2914 implicit real*8 (a-h,o-z)
2918 include 'DIMENSIONS'
2919 include 'COMMON.CONTROL'
2920 include 'COMMON.SETUP'
2921 include 'COMMON.IOUNITS'
2922 include 'COMMON.GEO'
2923 include 'COMMON.VAR'
2924 include 'COMMON.LOCAL'
2925 include 'COMMON.CHAIN'
2926 include 'COMMON.DERIV'
2927 include 'COMMON.INTERACT'
2928 include 'COMMON.CONTACTS'
2929 include 'COMMON.TORSION'
2930 include 'COMMON.VECTORS'
2931 include 'COMMON.FFIELD'
2932 include 'COMMON.TIME1'
2933 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2934 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2935 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2936 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2937 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2938 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2940 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2942 double precision scal_el /1.0d0/
2944 double precision scal_el /0.5d0/
2947 C 13-go grudnia roku pamietnego...
2948 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2949 & 0.0d0,1.0d0,0.0d0,
2950 & 0.0d0,0.0d0,1.0d0/
2951 cd write(iout,*) 'In EELEC'
2953 cd write(iout,*) 'Type',i
2954 cd write(iout,*) 'B1',B1(:,i)
2955 cd write(iout,*) 'B2',B2(:,i)
2956 cd write(iout,*) 'CC',CC(:,:,i)
2957 cd write(iout,*) 'DD',DD(:,:,i)
2958 cd write(iout,*) 'EE',EE(:,:,i)
2960 cd call check_vecgrad
2962 if (icheckgrad.eq.1) then
2964 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2966 dc_norm(k,i)=dc(k,i)*fac
2968 c write (iout,*) 'i',i,' fac',fac
2971 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2972 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2973 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2974 c call vec_and_deriv
2980 time_mat=time_mat+MPI_Wtime()-time01
2984 cd write (iout,*) 'i=',i
2986 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2989 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2990 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3003 cd print '(a)','Enter EELEC'
3004 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3006 gel_loc_loc(i)=0.0d0
3011 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3013 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3015 do i=iturn3_start,iturn3_end
3019 dx_normi=dc_norm(1,i)
3020 dy_normi=dc_norm(2,i)
3021 dz_normi=dc_norm(3,i)
3022 xmedi=c(1,i)+0.5d0*dxi
3023 ymedi=c(2,i)+0.5d0*dyi
3024 zmedi=c(3,i)+0.5d0*dzi
3026 call eelecij(i,i+2,ees,evdw1,eel_loc)
3027 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3028 num_cont_hb(i)=num_conti
3030 do i=iturn4_start,iturn4_end
3034 dx_normi=dc_norm(1,i)
3035 dy_normi=dc_norm(2,i)
3036 dz_normi=dc_norm(3,i)
3037 xmedi=c(1,i)+0.5d0*dxi
3038 ymedi=c(2,i)+0.5d0*dyi
3039 zmedi=c(3,i)+0.5d0*dzi
3040 num_conti=num_cont_hb(i)
3041 call eelecij(i,i+3,ees,evdw1,eel_loc)
3042 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3043 num_cont_hb(i)=num_conti
3046 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3048 do i=iatel_s,iatel_e
3052 dx_normi=dc_norm(1,i)
3053 dy_normi=dc_norm(2,i)
3054 dz_normi=dc_norm(3,i)
3055 xmedi=c(1,i)+0.5d0*dxi
3056 ymedi=c(2,i)+0.5d0*dyi
3057 zmedi=c(3,i)+0.5d0*dzi
3058 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3059 num_conti=num_cont_hb(i)
3060 do j=ielstart(i),ielend(i)
3061 call eelecij(i,j,ees,evdw1,eel_loc)
3063 num_cont_hb(i)=num_conti
3065 c write (iout,*) "Number of loop steps in EELEC:",ind
3067 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3068 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3070 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3071 ccc eel_loc=eel_loc+eello_turn3
3072 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3075 C-------------------------------------------------------------------------------
3076 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3077 implicit real*8 (a-h,o-z)
3078 include 'DIMENSIONS'
3082 include 'COMMON.CONTROL'
3083 include 'COMMON.IOUNITS'
3084 include 'COMMON.GEO'
3085 include 'COMMON.VAR'
3086 include 'COMMON.LOCAL'
3087 include 'COMMON.CHAIN'
3088 include 'COMMON.DERIV'
3089 include 'COMMON.INTERACT'
3090 include 'COMMON.CONTACTS'
3091 include 'COMMON.TORSION'
3092 include 'COMMON.VECTORS'
3093 include 'COMMON.FFIELD'
3094 include 'COMMON.TIME1'
3095 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3096 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3097 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3098 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3099 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3100 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3102 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3104 double precision scal_el /1.0d0/
3106 double precision scal_el /0.5d0/
3109 C 13-go grudnia roku pamietnego...
3110 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3111 & 0.0d0,1.0d0,0.0d0,
3112 & 0.0d0,0.0d0,1.0d0/
3113 c time00=MPI_Wtime()
3114 cd write (iout,*) "eelecij",i,j
3118 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3119 aaa=app(iteli,itelj)
3120 bbb=bpp(iteli,itelj)
3121 ael6i=ael6(iteli,itelj)
3122 ael3i=ael3(iteli,itelj)
3126 dx_normj=dc_norm(1,j)
3127 dy_normj=dc_norm(2,j)
3128 dz_normj=dc_norm(3,j)
3129 xj=c(1,j)+0.5D0*dxj-xmedi
3130 yj=c(2,j)+0.5D0*dyj-ymedi
3131 zj=c(3,j)+0.5D0*dzj-zmedi
3132 rij=xj*xj+yj*yj+zj*zj
3138 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3139 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3140 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3141 fac=cosa-3.0D0*cosb*cosg
3143 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3144 if (j.eq.i+2) ev1=scal_el*ev1
3149 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3152 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3153 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3156 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3157 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3158 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3159 cd & xmedi,ymedi,zmedi,xj,yj,zj
3161 if (energy_dec) then
3162 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3163 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3167 C Calculate contributions to the Cartesian gradient.
3170 facvdw=-6*rrmij*(ev1+evdwij)
3171 facel=-3*rrmij*(el1+eesij)
3177 * Radial derivatives. First process both termini of the fragment (i,j)
3183 c ghalf=0.5D0*ggg(k)
3184 c gelc(k,i)=gelc(k,i)+ghalf
3185 c gelc(k,j)=gelc(k,j)+ghalf
3187 c 9/28/08 AL Gradient compotents will be summed only at the end
3189 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3190 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3193 * Loop over residues i+1 thru j-1.
3197 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3204 c ghalf=0.5D0*ggg(k)
3205 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3206 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3208 c 9/28/08 AL Gradient compotents will be summed only at the end
3210 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3211 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3214 * Loop over residues i+1 thru j-1.
3218 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3225 fac=-3*rrmij*(facvdw+facvdw+facel)
3230 * Radial derivatives. First process both termini of the fragment (i,j)
3236 c ghalf=0.5D0*ggg(k)
3237 c gelc(k,i)=gelc(k,i)+ghalf
3238 c gelc(k,j)=gelc(k,j)+ghalf
3240 c 9/28/08 AL Gradient compotents will be summed only at the end
3242 gelc_long(k,j)=gelc(k,j)+ggg(k)
3243 gelc_long(k,i)=gelc(k,i)-ggg(k)
3246 * Loop over residues i+1 thru j-1.
3250 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3253 c 9/28/08 AL Gradient compotents will be summed only at the end
3258 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3259 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3265 ecosa=2.0D0*fac3*fac1+fac4
3268 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3269 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3271 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3272 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3274 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3275 cd & (dcosg(k),k=1,3)
3277 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3280 c ghalf=0.5D0*ggg(k)
3281 c gelc(k,i)=gelc(k,i)+ghalf
3282 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3283 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3284 c gelc(k,j)=gelc(k,j)+ghalf
3285 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3286 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3290 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3295 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3296 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3298 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3299 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3300 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3301 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3303 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3304 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3305 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3307 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3308 C energy of a peptide unit is assumed in the form of a second-order
3309 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3310 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3311 C are computed for EVERY pair of non-contiguous peptide groups.
3313 if (j.lt.nres-1) then
3324 muij(kkk)=mu(k,i)*mu(l,j)
3327 cd write (iout,*) 'EELEC: i',i,' j',j
3328 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3329 cd write(iout,*) 'muij',muij
3330 ury=scalar(uy(1,i),erij)
3331 urz=scalar(uz(1,i),erij)
3332 vry=scalar(uy(1,j),erij)
3333 vrz=scalar(uz(1,j),erij)
3334 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3335 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3336 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3337 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3338 fac=dsqrt(-ael6i)*r3ij
3343 cd write (iout,'(4i5,4f10.5)')
3344 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3345 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3346 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3347 cd & uy(:,j),uz(:,j)
3348 cd write (iout,'(4f10.5)')
3349 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3350 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3351 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3352 cd write (iout,'(9f10.5/)')
3353 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3354 C Derivatives of the elements of A in virtual-bond vectors
3355 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3357 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3358 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3359 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3360 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3361 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3362 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3363 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3364 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3365 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3366 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3367 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3368 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3370 C Compute radial contributions to the gradient
3388 C Add the contributions coming from er
3391 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3392 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3393 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3394 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3397 C Derivatives in DC(i)
3398 cgrad ghalf1=0.5d0*agg(k,1)
3399 cgrad ghalf2=0.5d0*agg(k,2)
3400 cgrad ghalf3=0.5d0*agg(k,3)
3401 cgrad ghalf4=0.5d0*agg(k,4)
3402 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3403 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3404 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3405 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3406 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3407 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3408 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3409 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3410 C Derivatives in DC(i+1)
3411 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3412 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3413 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3414 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3415 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3416 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3417 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3418 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3419 C Derivatives in DC(j)
3420 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3421 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3422 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3423 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3424 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3425 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3426 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3427 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3428 C Derivatives in DC(j+1) or DC(nres-1)
3429 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3430 & -3.0d0*vryg(k,3)*ury)
3431 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3432 & -3.0d0*vrzg(k,3)*ury)
3433 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3434 & -3.0d0*vryg(k,3)*urz)
3435 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3436 & -3.0d0*vrzg(k,3)*urz)
3437 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3439 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3452 aggi(k,l)=-aggi(k,l)
3453 aggi1(k,l)=-aggi1(k,l)
3454 aggj(k,l)=-aggj(k,l)
3455 aggj1(k,l)=-aggj1(k,l)
3458 if (j.lt.nres-1) then
3464 aggi(k,l)=-aggi(k,l)
3465 aggi1(k,l)=-aggi1(k,l)
3466 aggj(k,l)=-aggj(k,l)
3467 aggj1(k,l)=-aggj1(k,l)
3478 aggi(k,l)=-aggi(k,l)
3479 aggi1(k,l)=-aggi1(k,l)
3480 aggj(k,l)=-aggj(k,l)
3481 aggj1(k,l)=-aggj1(k,l)
3486 IF (wel_loc.gt.0.0d0) THEN
3487 C Contribution to the local-electrostatic energy coming from the i-j pair
3488 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3490 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3492 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3493 & 'eelloc',i,j,eel_loc_ij
3495 eel_loc=eel_loc+eel_loc_ij
3496 C Partial derivatives in virtual-bond dihedral angles gamma
3498 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3499 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3500 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3501 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3502 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3503 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3504 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3506 ggg(l)=agg(l,1)*muij(1)+
3507 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3508 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3509 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3510 cgrad ghalf=0.5d0*ggg(l)
3511 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3512 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3516 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3519 C Remaining derivatives of eello
3521 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3522 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3523 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3524 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3525 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3526 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3527 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3528 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3531 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3532 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3533 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3534 & .and. num_conti.le.maxconts) then
3535 c write (iout,*) i,j," entered corr"
3537 C Calculate the contact function. The ith column of the array JCONT will
3538 C contain the numbers of atoms that make contacts with the atom I (of numbers
3539 C greater than I). The arrays FACONT and GACONT will contain the values of
3540 C the contact function and its derivative.
3541 c r0ij=1.02D0*rpp(iteli,itelj)
3542 c r0ij=1.11D0*rpp(iteli,itelj)
3543 r0ij=2.20D0*rpp(iteli,itelj)
3544 c r0ij=1.55D0*rpp(iteli,itelj)
3545 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3546 if (fcont.gt.0.0D0) then
3547 num_conti=num_conti+1
3548 if (num_conti.gt.maxconts) then
3549 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3550 & ' will skip next contacts for this conf.'
3552 jcont_hb(num_conti,i)=j
3553 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3554 cd & " jcont_hb",jcont_hb(num_conti,i)
3555 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3556 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3557 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3559 d_cont(num_conti,i)=rij
3560 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3561 C --- Electrostatic-interaction matrix ---
3562 a_chuj(1,1,num_conti,i)=a22
3563 a_chuj(1,2,num_conti,i)=a23
3564 a_chuj(2,1,num_conti,i)=a32
3565 a_chuj(2,2,num_conti,i)=a33
3566 C --- Gradient of rij
3568 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3575 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3576 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3577 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3578 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3579 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3584 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3585 C Calculate contact energies
3587 wij=cosa-3.0D0*cosb*cosg
3590 c fac3=dsqrt(-ael6i)/r0ij**3
3591 fac3=dsqrt(-ael6i)*r3ij
3592 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3593 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3594 if (ees0tmp.gt.0) then
3595 ees0pij=dsqrt(ees0tmp)
3599 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3600 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3601 if (ees0tmp.gt.0) then
3602 ees0mij=dsqrt(ees0tmp)
3607 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3608 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3609 C Diagnostics. Comment out or remove after debugging!
3610 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3611 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3612 c ees0m(num_conti,i)=0.0D0
3614 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3615 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3616 C Angular derivatives of the contact function
3617 ees0pij1=fac3/ees0pij
3618 ees0mij1=fac3/ees0mij
3619 fac3p=-3.0D0*fac3*rrmij
3620 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3621 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3623 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3624 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3625 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3626 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3627 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3628 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3629 ecosap=ecosa1+ecosa2
3630 ecosbp=ecosb1+ecosb2
3631 ecosgp=ecosg1+ecosg2
3632 ecosam=ecosa1-ecosa2
3633 ecosbm=ecosb1-ecosb2
3634 ecosgm=ecosg1-ecosg2
3643 facont_hb(num_conti,i)=fcont
3644 fprimcont=fprimcont/rij
3645 cd facont_hb(num_conti,i)=1.0D0
3646 C Following line is for diagnostics.
3649 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3650 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3653 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3654 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3656 gggp(1)=gggp(1)+ees0pijp*xj
3657 gggp(2)=gggp(2)+ees0pijp*yj
3658 gggp(3)=gggp(3)+ees0pijp*zj
3659 gggm(1)=gggm(1)+ees0mijp*xj
3660 gggm(2)=gggm(2)+ees0mijp*yj
3661 gggm(3)=gggm(3)+ees0mijp*zj
3662 C Derivatives due to the contact function
3663 gacont_hbr(1,num_conti,i)=fprimcont*xj
3664 gacont_hbr(2,num_conti,i)=fprimcont*yj
3665 gacont_hbr(3,num_conti,i)=fprimcont*zj
3668 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3669 c following the change of gradient-summation algorithm.
3671 cgrad ghalfp=0.5D0*gggp(k)
3672 cgrad ghalfm=0.5D0*gggm(k)
3673 gacontp_hb1(k,num_conti,i)=!ghalfp
3674 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3675 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3676 gacontp_hb2(k,num_conti,i)=!ghalfp
3677 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3678 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3679 gacontp_hb3(k,num_conti,i)=gggp(k)
3680 gacontm_hb1(k,num_conti,i)=!ghalfm
3681 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3682 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3683 gacontm_hb2(k,num_conti,i)=!ghalfm
3684 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3685 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3686 gacontm_hb3(k,num_conti,i)=gggm(k)
3688 C Diagnostics. Comment out or remove after debugging!
3690 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3691 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3692 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3693 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3694 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3695 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3698 endif ! num_conti.le.maxconts
3701 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3704 ghalf=0.5d0*agg(l,k)
3705 aggi(l,k)=aggi(l,k)+ghalf
3706 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3707 aggj(l,k)=aggj(l,k)+ghalf
3710 if (j.eq.nres-1 .and. i.lt.j-2) then
3713 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3718 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3721 C-----------------------------------------------------------------------------
3722 subroutine eturn3(i,eello_turn3)
3723 C Third- and fourth-order contributions from turns
3724 implicit real*8 (a-h,o-z)
3725 include 'DIMENSIONS'
3726 include 'COMMON.IOUNITS'
3727 include 'COMMON.GEO'
3728 include 'COMMON.VAR'
3729 include 'COMMON.LOCAL'
3730 include 'COMMON.CHAIN'
3731 include 'COMMON.DERIV'
3732 include 'COMMON.INTERACT'
3733 include 'COMMON.CONTACTS'
3734 include 'COMMON.TORSION'
3735 include 'COMMON.VECTORS'
3736 include 'COMMON.FFIELD'
3737 include 'COMMON.CONTROL'
3739 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3740 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3741 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3742 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3743 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3744 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3745 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3748 c write (iout,*) "eturn3",i,j,j1,j2
3753 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3755 C Third-order contributions
3762 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3763 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3764 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3765 call transpose2(auxmat(1,1),auxmat1(1,1))
3766 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3767 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3768 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3769 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3770 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3771 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3772 cd & ' eello_turn3_num',4*eello_turn3_num
3773 C Derivatives in gamma(i)
3774 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3775 call transpose2(auxmat2(1,1),auxmat3(1,1))
3776 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3777 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3778 C Derivatives in gamma(i+1)
3779 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3780 call transpose2(auxmat2(1,1),auxmat3(1,1))
3781 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3782 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3783 & +0.5d0*(pizda(1,1)+pizda(2,2))
3784 C Cartesian derivatives
3786 c ghalf1=0.5d0*agg(l,1)
3787 c ghalf2=0.5d0*agg(l,2)
3788 c ghalf3=0.5d0*agg(l,3)
3789 c ghalf4=0.5d0*agg(l,4)
3790 a_temp(1,1)=aggi(l,1)!+ghalf1
3791 a_temp(1,2)=aggi(l,2)!+ghalf2
3792 a_temp(2,1)=aggi(l,3)!+ghalf3
3793 a_temp(2,2)=aggi(l,4)!+ghalf4
3794 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3795 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3796 & +0.5d0*(pizda(1,1)+pizda(2,2))
3797 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3798 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3799 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3800 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3801 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3802 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3803 & +0.5d0*(pizda(1,1)+pizda(2,2))
3804 a_temp(1,1)=aggj(l,1)!+ghalf1
3805 a_temp(1,2)=aggj(l,2)!+ghalf2
3806 a_temp(2,1)=aggj(l,3)!+ghalf3
3807 a_temp(2,2)=aggj(l,4)!+ghalf4
3808 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3809 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3810 & +0.5d0*(pizda(1,1)+pizda(2,2))
3811 a_temp(1,1)=aggj1(l,1)
3812 a_temp(1,2)=aggj1(l,2)
3813 a_temp(2,1)=aggj1(l,3)
3814 a_temp(2,2)=aggj1(l,4)
3815 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3816 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3817 & +0.5d0*(pizda(1,1)+pizda(2,2))
3821 C-------------------------------------------------------------------------------
3822 subroutine eturn4(i,eello_turn4)
3823 C Third- and fourth-order contributions from turns
3824 implicit real*8 (a-h,o-z)
3825 include 'DIMENSIONS'
3826 include 'COMMON.IOUNITS'
3827 include 'COMMON.GEO'
3828 include 'COMMON.VAR'
3829 include 'COMMON.LOCAL'
3830 include 'COMMON.CHAIN'
3831 include 'COMMON.DERIV'
3832 include 'COMMON.INTERACT'
3833 include 'COMMON.CONTACTS'
3834 include 'COMMON.TORSION'
3835 include 'COMMON.VECTORS'
3836 include 'COMMON.FFIELD'
3837 include 'COMMON.CONTROL'
3839 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3840 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3841 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3842 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3843 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3844 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3845 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3848 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3850 C Fourth-order contributions
3858 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3859 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3860 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3865 iti1=itortyp(itype(i+1))
3866 iti2=itortyp(itype(i+2))
3867 iti3=itortyp(itype(i+3))
3868 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3869 call transpose2(EUg(1,1,i+1),e1t(1,1))
3870 call transpose2(Eug(1,1,i+2),e2t(1,1))
3871 call transpose2(Eug(1,1,i+3),e3t(1,1))
3872 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3873 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3874 s1=scalar2(b1(1,iti2),auxvec(1))
3875 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3876 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3877 s2=scalar2(b1(1,iti1),auxvec(1))
3878 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3879 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3880 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3881 eello_turn4=eello_turn4-(s1+s2+s3)
3882 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3883 & 'eturn4',i,j,-(s1+s2+s3)
3884 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3885 cd & ' eello_turn4_num',8*eello_turn4_num
3886 C Derivatives in gamma(i)
3887 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3888 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3889 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3890 s1=scalar2(b1(1,iti2),auxvec(1))
3891 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3892 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3893 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3894 C Derivatives in gamma(i+1)
3895 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3896 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3897 s2=scalar2(b1(1,iti1),auxvec(1))
3898 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3899 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3900 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3901 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3902 C Derivatives in gamma(i+2)
3903 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3904 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3905 s1=scalar2(b1(1,iti2),auxvec(1))
3906 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3907 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3908 s2=scalar2(b1(1,iti1),auxvec(1))
3909 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3910 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3911 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3912 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3913 C Cartesian derivatives
3914 C Derivatives of this turn contributions in DC(i+2)
3915 if (j.lt.nres-1) then
3917 a_temp(1,1)=agg(l,1)
3918 a_temp(1,2)=agg(l,2)
3919 a_temp(2,1)=agg(l,3)
3920 a_temp(2,2)=agg(l,4)
3921 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3922 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3923 s1=scalar2(b1(1,iti2),auxvec(1))
3924 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3925 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3926 s2=scalar2(b1(1,iti1),auxvec(1))
3927 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3928 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3929 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3931 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3934 C Remaining derivatives of this turn contribution
3936 a_temp(1,1)=aggi(l,1)
3937 a_temp(1,2)=aggi(l,2)
3938 a_temp(2,1)=aggi(l,3)
3939 a_temp(2,2)=aggi(l,4)
3940 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3941 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3942 s1=scalar2(b1(1,iti2),auxvec(1))
3943 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3944 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3945 s2=scalar2(b1(1,iti1),auxvec(1))
3946 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3947 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3948 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3949 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3950 a_temp(1,1)=aggi1(l,1)
3951 a_temp(1,2)=aggi1(l,2)
3952 a_temp(2,1)=aggi1(l,3)
3953 a_temp(2,2)=aggi1(l,4)
3954 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3955 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3956 s1=scalar2(b1(1,iti2),auxvec(1))
3957 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3958 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3959 s2=scalar2(b1(1,iti1),auxvec(1))
3960 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3961 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3962 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3963 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3964 a_temp(1,1)=aggj(l,1)
3965 a_temp(1,2)=aggj(l,2)
3966 a_temp(2,1)=aggj(l,3)
3967 a_temp(2,2)=aggj(l,4)
3968 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3969 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3970 s1=scalar2(b1(1,iti2),auxvec(1))
3971 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3972 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3973 s2=scalar2(b1(1,iti1),auxvec(1))
3974 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3975 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3976 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3977 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3978 a_temp(1,1)=aggj1(l,1)
3979 a_temp(1,2)=aggj1(l,2)
3980 a_temp(2,1)=aggj1(l,3)
3981 a_temp(2,2)=aggj1(l,4)
3982 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3983 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3984 s1=scalar2(b1(1,iti2),auxvec(1))
3985 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3986 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3987 s2=scalar2(b1(1,iti1),auxvec(1))
3988 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3989 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3990 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3991 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3992 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3996 C-----------------------------------------------------------------------------
3997 subroutine vecpr(u,v,w)
3998 implicit real*8(a-h,o-z)
3999 dimension u(3),v(3),w(3)
4000 w(1)=u(2)*v(3)-u(3)*v(2)
4001 w(2)=-u(1)*v(3)+u(3)*v(1)
4002 w(3)=u(1)*v(2)-u(2)*v(1)
4005 C-----------------------------------------------------------------------------
4006 subroutine unormderiv(u,ugrad,unorm,ungrad)
4007 C This subroutine computes the derivatives of a normalized vector u, given
4008 C the derivatives computed without normalization conditions, ugrad. Returns
4011 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4012 double precision vec(3)
4013 double precision scalar
4015 c write (2,*) 'ugrad',ugrad
4018 vec(i)=scalar(ugrad(1,i),u(1))
4020 c write (2,*) 'vec',vec
4023 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4026 c write (2,*) 'ungrad',ungrad
4029 C-----------------------------------------------------------------------------
4030 subroutine escp_soft_sphere(evdw2,evdw2_14)
4032 C This subroutine calculates the excluded-volume interaction energy between
4033 C peptide-group centers and side chains and its gradient in virtual-bond and
4034 C side-chain vectors.
4036 implicit real*8 (a-h,o-z)
4037 include 'DIMENSIONS'
4038 include 'COMMON.GEO'
4039 include 'COMMON.VAR'
4040 include 'COMMON.LOCAL'
4041 include 'COMMON.CHAIN'
4042 include 'COMMON.DERIV'
4043 include 'COMMON.INTERACT'
4044 include 'COMMON.FFIELD'
4045 include 'COMMON.IOUNITS'
4046 include 'COMMON.CONTROL'
4051 cd print '(a)','Enter ESCP'
4052 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4053 do i=iatscp_s,iatscp_e
4055 xi=0.5D0*(c(1,i)+c(1,i+1))
4056 yi=0.5D0*(c(2,i)+c(2,i+1))
4057 zi=0.5D0*(c(3,i)+c(3,i+1))
4059 do iint=1,nscp_gr(i)
4061 do j=iscpstart(i,iint),iscpend(i,iint)
4063 C Uncomment following three lines for SC-p interactions
4067 C Uncomment following three lines for Ca-p interactions
4071 rij=xj*xj+yj*yj+zj*zj
4074 if (rij.lt.r0ijsq) then
4075 evdwij=0.25d0*(rij-r0ijsq)**2
4083 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4088 cgrad if (j.lt.i) then
4089 cd write (iout,*) 'j<i'
4090 C Uncomment following three lines for SC-p interactions
4092 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4095 cd write (iout,*) 'j>i'
4097 cgrad ggg(k)=-ggg(k)
4098 C Uncomment following line for SC-p interactions
4099 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4103 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4105 cgrad kstart=min0(i+1,j)
4106 cgrad kend=max0(i-1,j-1)
4107 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4108 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4109 cgrad do k=kstart,kend
4111 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4115 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4116 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4124 C-----------------------------------------------------------------------------
4125 subroutine escp(evdw2,evdw2_14)
4127 C This subroutine calculates the excluded-volume interaction energy between
4128 C peptide-group centers and side chains and its gradient in virtual-bond and
4129 C side-chain vectors.
4131 implicit real*8 (a-h,o-z)
4132 include 'DIMENSIONS'
4133 include 'COMMON.GEO'
4134 include 'COMMON.VAR'
4135 include 'COMMON.LOCAL'
4136 include 'COMMON.CHAIN'
4137 include 'COMMON.DERIV'
4138 include 'COMMON.INTERACT'
4139 include 'COMMON.FFIELD'
4140 include 'COMMON.IOUNITS'
4141 include 'COMMON.CONTROL'
4145 cd print '(a)','Enter ESCP'
4146 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4147 do i=iatscp_s,iatscp_e
4149 xi=0.5D0*(c(1,i)+c(1,i+1))
4150 yi=0.5D0*(c(2,i)+c(2,i+1))
4151 zi=0.5D0*(c(3,i)+c(3,i+1))
4153 do iint=1,nscp_gr(i)
4155 do j=iscpstart(i,iint),iscpend(i,iint)
4157 C Uncomment following three lines for SC-p interactions
4161 C Uncomment following three lines for Ca-p interactions
4165 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4167 e1=fac*fac*aad(itypj,iteli)
4168 e2=fac*bad(itypj,iteli)
4169 if (iabs(j-i) .le. 2) then
4172 evdw2_14=evdw2_14+e1+e2
4176 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4177 & 'evdw2',i,j,evdwij
4179 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4181 fac=-(evdwij+e1)*rrij
4185 cgrad if (j.lt.i) then
4186 cd write (iout,*) 'j<i'
4187 C Uncomment following three lines for SC-p interactions
4189 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4192 cd write (iout,*) 'j>i'
4194 cgrad ggg(k)=-ggg(k)
4195 C Uncomment following line for SC-p interactions
4196 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4197 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4201 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4203 cgrad kstart=min0(i+1,j)
4204 cgrad kend=max0(i-1,j-1)
4205 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4206 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4207 cgrad do k=kstart,kend
4209 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4213 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4214 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4222 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4223 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4224 gradx_scp(j,i)=expon*gradx_scp(j,i)
4227 C******************************************************************************
4231 C To save time the factor EXPON has been extracted from ALL components
4232 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4235 C******************************************************************************
4238 C--------------------------------------------------------------------------
4239 subroutine edis(ehpb)
4241 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4243 implicit real*8 (a-h,o-z)
4244 include 'DIMENSIONS'
4245 include 'COMMON.SBRIDGE'
4246 include 'COMMON.CHAIN'
4247 include 'COMMON.DERIV'
4248 include 'COMMON.VAR'
4249 include 'COMMON.INTERACT'
4250 include 'COMMON.IOUNITS'
4253 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4254 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4255 if (link_end.eq.0) return
4256 do i=link_start,link_end
4257 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4258 C CA-CA distance used in regularization of structure.
4261 C iii and jjj point to the residues for which the distance is assigned.
4262 if (ii.gt.nres) then
4269 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4270 c & dhpb(i),dhpb1(i),forcon(i)
4271 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4272 C distance and angle dependent SS bond potential.
4273 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4274 call ssbond_ene(iii,jjj,eij)
4276 cd write (iout,*) "eij",eij
4277 else if (ii.gt.nres .and. jj.gt.nres) then
4278 c Restraints from contact prediction
4280 if (dhpb1(i).gt.0.0d0) then
4281 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4282 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4283 c write (iout,*) "beta nmr",
4284 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4288 C Get the force constant corresponding to this distance.
4290 C Calculate the contribution to energy.
4291 ehpb=ehpb+waga*rdis*rdis
4292 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4294 C Evaluate gradient.
4299 ggg(j)=fac*(c(j,jj)-c(j,ii))
4302 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4303 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4306 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4307 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4310 C Calculate the distance between the two points and its difference from the
4313 if (dhpb1(i).gt.0.0d0) then
4314 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4315 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4316 c write (iout,*) "alph nmr",
4317 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4320 C Get the force constant corresponding to this distance.
4322 C Calculate the contribution to energy.
4323 ehpb=ehpb+waga*rdis*rdis
4324 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4326 C Evaluate gradient.
4330 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4331 cd & ' waga=',waga,' fac=',fac
4333 ggg(j)=fac*(c(j,jj)-c(j,ii))
4335 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4336 C If this is a SC-SC distance, we need to calculate the contributions to the
4337 C Cartesian gradient in the SC vectors (ghpbx).
4340 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4341 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4344 cgrad do j=iii,jjj-1
4346 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4350 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4351 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4358 C--------------------------------------------------------------------------
4359 subroutine ssbond_ene(i,j,eij)
4361 C Calculate the distance and angle dependent SS-bond potential energy
4362 C using a free-energy function derived based on RHF/6-31G** ab initio
4363 C calculations of diethyl disulfide.
4365 C A. Liwo and U. Kozlowska, 11/24/03
4367 implicit real*8 (a-h,o-z)
4368 include 'DIMENSIONS'
4369 include 'COMMON.SBRIDGE'
4370 include 'COMMON.CHAIN'
4371 include 'COMMON.DERIV'
4372 include 'COMMON.LOCAL'
4373 include 'COMMON.INTERACT'
4374 include 'COMMON.VAR'
4375 include 'COMMON.IOUNITS'
4376 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4381 dxi=dc_norm(1,nres+i)
4382 dyi=dc_norm(2,nres+i)
4383 dzi=dc_norm(3,nres+i)
4384 c dsci_inv=dsc_inv(itypi)
4385 dsci_inv=vbld_inv(nres+i)
4387 c dscj_inv=dsc_inv(itypj)
4388 dscj_inv=vbld_inv(nres+j)
4392 dxj=dc_norm(1,nres+j)
4393 dyj=dc_norm(2,nres+j)
4394 dzj=dc_norm(3,nres+j)
4395 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4400 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4401 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4402 om12=dxi*dxj+dyi*dyj+dzi*dzj
4404 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4405 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4411 deltat12=om2-om1+2.0d0
4413 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4414 & +akct*deltad*deltat12
4415 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4416 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4417 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4418 c & " deltat12",deltat12," eij",eij
4419 ed=2*akcm*deltad+akct*deltat12
4421 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4422 eom1=-2*akth*deltat1-pom1-om2*pom2
4423 eom2= 2*akth*deltat2+pom1-om1*pom2
4426 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4427 ghpbx(k,i)=ghpbx(k,i)-ggk
4428 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4429 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4430 ghpbx(k,j)=ghpbx(k,j)+ggk
4431 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4432 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4433 ghpbc(k,i)=ghpbc(k,i)-ggk
4434 ghpbc(k,j)=ghpbc(k,j)+ggk
4437 C Calculate the components of the gradient in DC and X
4441 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4446 C--------------------------------------------------------------------------
4447 subroutine ebond(estr)
4449 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4451 implicit real*8 (a-h,o-z)
4452 include 'DIMENSIONS'
4453 include 'COMMON.LOCAL'
4454 include 'COMMON.GEO'
4455 include 'COMMON.INTERACT'
4456 include 'COMMON.DERIV'
4457 include 'COMMON.VAR'
4458 include 'COMMON.CHAIN'
4459 include 'COMMON.IOUNITS'
4460 include 'COMMON.NAMES'
4461 include 'COMMON.FFIELD'
4462 include 'COMMON.CONTROL'
4463 include 'COMMON.SETUP'
4464 double precision u(3),ud(3)
4466 do i=ibondp_start,ibondp_end
4467 diff = vbld(i)-vbldp0
4468 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4471 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4473 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4477 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4479 do i=ibond_start,ibond_end
4484 diff=vbld(i+nres)-vbldsc0(1,iti)
4485 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4486 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4487 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4489 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4493 diff=vbld(i+nres)-vbldsc0(j,iti)
4494 ud(j)=aksc(j,iti)*diff
4495 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4509 uprod2=uprod2*u(k)*u(k)
4513 usumsqder=usumsqder+ud(j)*uprod2
4515 estr=estr+uprod/usum
4517 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4525 C--------------------------------------------------------------------------
4526 subroutine ebend(etheta)
4528 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4529 C angles gamma and its derivatives in consecutive thetas and gammas.
4531 implicit real*8 (a-h,o-z)
4532 include 'DIMENSIONS'
4533 include 'COMMON.LOCAL'
4534 include 'COMMON.GEO'
4535 include 'COMMON.INTERACT'
4536 include 'COMMON.DERIV'
4537 include 'COMMON.VAR'
4538 include 'COMMON.CHAIN'
4539 include 'COMMON.IOUNITS'
4540 include 'COMMON.NAMES'
4541 include 'COMMON.FFIELD'
4542 include 'COMMON.CONTROL'
4543 common /calcthet/ term1,term2,termm,diffak,ratak,
4544 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4545 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4546 double precision y(2),z(2)
4548 c time11=dexp(-2*time)
4551 c write (*,'(a,i2)') 'EBEND ICG=',icg
4552 do i=ithet_start,ithet_end
4553 C Zero the energy function and its derivative at 0 or pi.
4554 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4559 if (phii.ne.phii) phii=150.0
4572 if (phii1.ne.phii1) phii1=150.0
4584 C Calculate the "mean" value of theta from the part of the distribution
4585 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4586 C In following comments this theta will be referred to as t_c.
4587 thet_pred_mean=0.0d0
4591 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4593 dthett=thet_pred_mean*ssd
4594 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4595 C Derivatives of the "mean" values in gamma1 and gamma2.
4596 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4597 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4598 if (theta(i).gt.pi-delta) then
4599 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4601 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4602 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4603 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4605 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4607 else if (theta(i).lt.delta) then
4608 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4609 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4610 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4612 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4613 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4616 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4619 etheta=etheta+ethetai
4620 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4622 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4623 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4624 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4626 C Ufff.... We've done all this!!!
4629 C---------------------------------------------------------------------------
4630 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4632 implicit real*8 (a-h,o-z)
4633 include 'DIMENSIONS'
4634 include 'COMMON.LOCAL'
4635 include 'COMMON.IOUNITS'
4636 common /calcthet/ term1,term2,termm,diffak,ratak,
4637 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4638 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4639 C Calculate the contributions to both Gaussian lobes.
4640 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4641 C The "polynomial part" of the "standard deviation" of this part of
4645 sig=sig*thet_pred_mean+polthet(j,it)
4647 C Derivative of the "interior part" of the "standard deviation of the"
4648 C gamma-dependent Gaussian lobe in t_c.
4649 sigtc=3*polthet(3,it)
4651 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4654 C Set the parameters of both Gaussian lobes of the distribution.
4655 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4656 fac=sig*sig+sigc0(it)
4659 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4660 sigsqtc=-4.0D0*sigcsq*sigtc
4661 c print *,i,sig,sigtc,sigsqtc
4662 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4663 sigtc=-sigtc/(fac*fac)
4664 C Following variable is sigma(t_c)**(-2)
4665 sigcsq=sigcsq*sigcsq
4667 sig0inv=1.0D0/sig0i**2
4668 delthec=thetai-thet_pred_mean
4669 delthe0=thetai-theta0i
4670 term1=-0.5D0*sigcsq*delthec*delthec
4671 term2=-0.5D0*sig0inv*delthe0*delthe0
4672 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4673 C NaNs in taking the logarithm. We extract the largest exponent which is added
4674 C to the energy (this being the log of the distribution) at the end of energy
4675 C term evaluation for this virtual-bond angle.
4676 if (term1.gt.term2) then
4678 term2=dexp(term2-termm)
4682 term1=dexp(term1-termm)
4685 C The ratio between the gamma-independent and gamma-dependent lobes of
4686 C the distribution is a Gaussian function of thet_pred_mean too.
4687 diffak=gthet(2,it)-thet_pred_mean
4688 ratak=diffak/gthet(3,it)**2
4689 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4690 C Let's differentiate it in thet_pred_mean NOW.
4692 C Now put together the distribution terms to make complete distribution.
4693 termexp=term1+ak*term2
4694 termpre=sigc+ak*sig0i
4695 C Contribution of the bending energy from this theta is just the -log of
4696 C the sum of the contributions from the two lobes and the pre-exponential
4697 C factor. Simple enough, isn't it?
4698 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4699 C NOW the derivatives!!!
4700 C 6/6/97 Take into account the deformation.
4701 E_theta=(delthec*sigcsq*term1
4702 & +ak*delthe0*sig0inv*term2)/termexp
4703 E_tc=((sigtc+aktc*sig0i)/termpre
4704 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4705 & aktc*term2)/termexp)
4708 c-----------------------------------------------------------------------------
4709 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4710 implicit real*8 (a-h,o-z)
4711 include 'DIMENSIONS'
4712 include 'COMMON.LOCAL'
4713 include 'COMMON.IOUNITS'
4714 common /calcthet/ term1,term2,termm,diffak,ratak,
4715 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4716 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4717 delthec=thetai-thet_pred_mean
4718 delthe0=thetai-theta0i
4719 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4720 t3 = thetai-thet_pred_mean
4724 t14 = t12+t6*sigsqtc
4726 t21 = thetai-theta0i
4732 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4733 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4734 & *(-t12*t9-ak*sig0inv*t27)
4738 C--------------------------------------------------------------------------
4739 subroutine ebend(etheta)
4741 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4742 C angles gamma and its derivatives in consecutive thetas and gammas.
4743 C ab initio-derived potentials from
4744 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4746 implicit real*8 (a-h,o-z)
4747 include 'DIMENSIONS'
4748 include 'COMMON.LOCAL'
4749 include 'COMMON.GEO'
4750 include 'COMMON.INTERACT'
4751 include 'COMMON.DERIV'
4752 include 'COMMON.VAR'
4753 include 'COMMON.CHAIN'
4754 include 'COMMON.IOUNITS'
4755 include 'COMMON.NAMES'
4756 include 'COMMON.FFIELD'
4757 include 'COMMON.CONTROL'
4758 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4759 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4760 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4761 & sinph1ph2(maxdouble,maxdouble)
4762 logical lprn /.false./, lprn1 /.false./
4764 do i=ithet_start,ithet_end
4768 theti2=0.5d0*theta(i)
4769 ityp2=ithetyp(itype(i-1))
4771 coskt(k)=dcos(k*theti2)
4772 sinkt(k)=dsin(k*theti2)
4777 if (phii.ne.phii) phii=150.0
4781 ityp1=ithetyp(itype(i-2))
4783 cosph1(k)=dcos(k*phii)
4784 sinph1(k)=dsin(k*phii)
4797 if (phii1.ne.phii1) phii1=150.0
4802 ityp3=ithetyp(itype(i))
4804 cosph2(k)=dcos(k*phii1)
4805 sinph2(k)=dsin(k*phii1)
4815 ethetai=aa0thet(ityp1,ityp2,ityp3)
4818 ccl=cosph1(l)*cosph2(k-l)
4819 ssl=sinph1(l)*sinph2(k-l)
4820 scl=sinph1(l)*cosph2(k-l)
4821 csl=cosph1(l)*sinph2(k-l)
4822 cosph1ph2(l,k)=ccl-ssl
4823 cosph1ph2(k,l)=ccl+ssl
4824 sinph1ph2(l,k)=scl+csl
4825 sinph1ph2(k,l)=scl-csl
4829 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4830 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4831 write (iout,*) "coskt and sinkt"
4833 write (iout,*) k,coskt(k),sinkt(k)
4837 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4838 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4841 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4842 & " ethetai",ethetai
4845 write (iout,*) "cosph and sinph"
4847 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4849 write (iout,*) "cosph1ph2 and sinph2ph2"
4852 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4853 & sinph1ph2(l,k),sinph1ph2(k,l)
4856 write(iout,*) "ethetai",ethetai
4860 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4861 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4862 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4863 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4864 ethetai=ethetai+sinkt(m)*aux
4865 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4866 dephii=dephii+k*sinkt(m)*(
4867 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4868 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4869 dephii1=dephii1+k*sinkt(m)*(
4870 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4871 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4873 & write (iout,*) "m",m," k",k," bbthet",
4874 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4875 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4876 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4877 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4881 & write(iout,*) "ethetai",ethetai
4885 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4886 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4887 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4888 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4889 ethetai=ethetai+sinkt(m)*aux
4890 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4891 dephii=dephii+l*sinkt(m)*(
4892 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4893 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4894 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4895 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4896 dephii1=dephii1+(k-l)*sinkt(m)*(
4897 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4898 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4899 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4900 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4902 write (iout,*) "m",m," k",k," l",l," ffthet",
4903 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4904 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4905 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4906 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4907 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4908 & cosph1ph2(k,l)*sinkt(m),
4909 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4915 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4916 & i,theta(i)*rad2deg,phii*rad2deg,
4917 & phii1*rad2deg,ethetai
4918 etheta=etheta+ethetai
4919 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4920 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4921 gloc(nphi+i-2,icg)=wang*dethetai
4927 c-----------------------------------------------------------------------------
4928 subroutine esc(escloc)
4929 C Calculate the local energy of a side chain and its derivatives in the
4930 C corresponding virtual-bond valence angles THETA and the spherical angles
4932 implicit real*8 (a-h,o-z)
4933 include 'DIMENSIONS'
4934 include 'COMMON.GEO'
4935 include 'COMMON.LOCAL'
4936 include 'COMMON.VAR'
4937 include 'COMMON.INTERACT'
4938 include 'COMMON.DERIV'
4939 include 'COMMON.CHAIN'
4940 include 'COMMON.IOUNITS'
4941 include 'COMMON.NAMES'
4942 include 'COMMON.FFIELD'
4943 include 'COMMON.CONTROL'
4944 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4945 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4946 common /sccalc/ time11,time12,time112,theti,it,nlobit
4949 c write (iout,'(a)') 'ESC'
4950 do i=loc_start,loc_end
4952 if (it.eq.10) goto 1
4954 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4955 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4956 theti=theta(i+1)-pipol
4961 if (x(2).gt.pi-delta) then
4965 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4967 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4968 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4970 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4971 & ddersc0(1),dersc(1))
4972 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4973 & ddersc0(3),dersc(3))
4975 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4977 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4978 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4979 & dersc0(2),esclocbi,dersc02)
4980 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4982 call splinthet(x(2),0.5d0*delta,ss,ssd)
4987 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4989 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4990 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4992 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4994 c write (iout,*) escloci
4995 else if (x(2).lt.delta) then
4999 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5001 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5002 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5004 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5005 & ddersc0(1),dersc(1))
5006 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5007 & ddersc0(3),dersc(3))
5009 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5011 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5012 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5013 & dersc0(2),esclocbi,dersc02)
5014 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5019 call splinthet(x(2),0.5d0*delta,ss,ssd)
5021 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5023 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5024 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5026 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5027 c write (iout,*) escloci
5029 call enesc(x,escloci,dersc,ddummy,.false.)
5032 escloc=escloc+escloci
5033 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5034 & 'escloc',i,escloci
5035 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5037 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5039 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5040 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5045 C---------------------------------------------------------------------------
5046 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5047 implicit real*8 (a-h,o-z)
5048 include 'DIMENSIONS'
5049 include 'COMMON.GEO'
5050 include 'COMMON.LOCAL'
5051 include 'COMMON.IOUNITS'
5052 common /sccalc/ time11,time12,time112,theti,it,nlobit
5053 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5054 double precision contr(maxlob,-1:1)
5056 c write (iout,*) 'it=',it,' nlobit=',nlobit
5060 if (mixed) ddersc(j)=0.0d0
5064 C Because of periodicity of the dependence of the SC energy in omega we have
5065 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5066 C To avoid underflows, first compute & store the exponents.
5074 z(k)=x(k)-censc(k,j,it)
5079 Axk=Axk+gaussc(l,k,j,it)*z(l)
5085 expfac=expfac+Ax(k,j,iii)*z(k)
5093 C As in the case of ebend, we want to avoid underflows in exponentiation and
5094 C subsequent NaNs and INFs in energy calculation.
5095 C Find the largest exponent
5099 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5103 cd print *,'it=',it,' emin=',emin
5105 C Compute the contribution to SC energy and derivatives
5110 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5111 if(adexp.ne.adexp) adexp=1.0
5114 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5116 cd print *,'j=',j,' expfac=',expfac
5117 escloc_i=escloc_i+expfac
5119 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5123 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5124 & +gaussc(k,2,j,it))*expfac
5131 dersc(1)=dersc(1)/cos(theti)**2
5132 ddersc(1)=ddersc(1)/cos(theti)**2
5135 escloci=-(dlog(escloc_i)-emin)
5137 dersc(j)=dersc(j)/escloc_i
5141 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5146 C------------------------------------------------------------------------------
5147 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5148 implicit real*8 (a-h,o-z)
5149 include 'DIMENSIONS'
5150 include 'COMMON.GEO'
5151 include 'COMMON.LOCAL'
5152 include 'COMMON.IOUNITS'
5153 common /sccalc/ time11,time12,time112,theti,it,nlobit
5154 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5155 double precision contr(maxlob)
5166 z(k)=x(k)-censc(k,j,it)
5172 Axk=Axk+gaussc(l,k,j,it)*z(l)
5178 expfac=expfac+Ax(k,j)*z(k)
5183 C As in the case of ebend, we want to avoid underflows in exponentiation and
5184 C subsequent NaNs and INFs in energy calculation.
5185 C Find the largest exponent
5188 if (emin.gt.contr(j)) emin=contr(j)
5192 C Compute the contribution to SC energy and derivatives
5196 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5197 escloc_i=escloc_i+expfac
5199 dersc(k)=dersc(k)+Ax(k,j)*expfac
5201 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5202 & +gaussc(1,2,j,it))*expfac
5206 dersc(1)=dersc(1)/cos(theti)**2
5207 dersc12=dersc12/cos(theti)**2
5208 escloci=-(dlog(escloc_i)-emin)
5210 dersc(j)=dersc(j)/escloc_i
5212 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5216 c----------------------------------------------------------------------------------
5217 subroutine esc(escloc)
5218 C Calculate the local energy of a side chain and its derivatives in the
5219 C corresponding virtual-bond valence angles THETA and the spherical angles
5220 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5221 C added by Urszula Kozlowska. 07/11/2007
5223 implicit real*8 (a-h,o-z)
5224 include 'DIMENSIONS'
5225 include 'COMMON.GEO'
5226 include 'COMMON.LOCAL'
5227 include 'COMMON.VAR'
5228 include 'COMMON.SCROT'
5229 include 'COMMON.INTERACT'
5230 include 'COMMON.DERIV'
5231 include 'COMMON.CHAIN'
5232 include 'COMMON.IOUNITS'
5233 include 'COMMON.NAMES'
5234 include 'COMMON.FFIELD'
5235 include 'COMMON.CONTROL'
5236 include 'COMMON.VECTORS'
5237 double precision x_prime(3),y_prime(3),z_prime(3)
5238 & , sumene,dsc_i,dp2_i,x(65),
5239 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5240 & de_dxx,de_dyy,de_dzz,de_dt
5241 double precision s1_t,s1_6_t,s2_t,s2_6_t
5243 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5244 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5245 & dt_dCi(3),dt_dCi1(3)
5246 common /sccalc/ time11,time12,time112,theti,it,nlobit
5249 do i=loc_start,loc_end
5250 costtab(i+1) =dcos(theta(i+1))
5251 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5252 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5253 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5254 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5255 cosfac=dsqrt(cosfac2)
5256 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5257 sinfac=dsqrt(sinfac2)
5259 if (it.eq.10) goto 1
5261 C Compute the axes of tghe local cartesian coordinates system; store in
5262 c x_prime, y_prime and z_prime
5269 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5270 C & dc_norm(3,i+nres)
5272 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5273 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5276 z_prime(j) = -uz(j,i-1)
5279 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5280 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5281 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5282 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5283 c & " xy",scalar(x_prime(1),y_prime(1)),
5284 c & " xz",scalar(x_prime(1),z_prime(1)),
5285 c & " yy",scalar(y_prime(1),y_prime(1)),
5286 c & " yz",scalar(y_prime(1),z_prime(1)),
5287 c & " zz",scalar(z_prime(1),z_prime(1))
5289 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5290 C to local coordinate system. Store in xx, yy, zz.
5296 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5297 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5298 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5305 C Compute the energy of the ith side cbain
5307 c write (2,*) "xx",xx," yy",yy," zz",zz
5310 x(j) = sc_parmin(j,it)
5313 Cc diagnostics - remove later
5315 yy1 = dsin(alph(2))*dcos(omeg(2))
5316 zz1 = -dsin(alph(2))*dsin(omeg(2))
5317 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5318 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5320 C," --- ", xx_w,yy_w,zz_w
5323 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5324 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5326 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5327 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5329 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5330 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5331 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5332 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5333 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5335 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5336 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5337 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5338 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5339 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5341 dsc_i = 0.743d0+x(61)
5343 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5344 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5345 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5346 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5347 s1=(1+x(63))/(0.1d0 + dscp1)
5348 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5349 s2=(1+x(65))/(0.1d0 + dscp2)
5350 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5351 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5352 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5353 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5355 c & dscp1,dscp2,sumene
5356 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5357 escloc = escloc + sumene
5358 c write (2,*) "i",i," escloc",sumene,escloc
5361 C This section to check the numerical derivatives of the energy of ith side
5362 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5363 C #define DEBUG in the code to turn it on.
5365 write (2,*) "sumene =",sumene
5369 write (2,*) xx,yy,zz
5370 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5371 de_dxx_num=(sumenep-sumene)/aincr
5373 write (2,*) "xx+ sumene from enesc=",sumenep
5376 write (2,*) xx,yy,zz
5377 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5378 de_dyy_num=(sumenep-sumene)/aincr
5380 write (2,*) "yy+ sumene from enesc=",sumenep
5383 write (2,*) xx,yy,zz
5384 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5385 de_dzz_num=(sumenep-sumene)/aincr
5387 write (2,*) "zz+ sumene from enesc=",sumenep
5388 costsave=cost2tab(i+1)
5389 sintsave=sint2tab(i+1)
5390 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5391 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5392 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5393 de_dt_num=(sumenep-sumene)/aincr
5394 write (2,*) " t+ sumene from enesc=",sumenep
5395 cost2tab(i+1)=costsave
5396 sint2tab(i+1)=sintsave
5397 C End of diagnostics section.
5400 C Compute the gradient of esc
5402 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5403 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5404 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5405 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5406 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5407 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5408 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5409 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5410 pom1=(sumene3*sint2tab(i+1)+sumene1)
5411 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5412 pom2=(sumene4*cost2tab(i+1)+sumene2)
5413 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5414 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5415 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5416 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5418 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5419 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5420 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5422 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5423 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5424 & +(pom1+pom2)*pom_dx
5426 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5429 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5430 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5431 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5433 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5434 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5435 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5436 & +x(59)*zz**2 +x(60)*xx*zz
5437 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5438 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5439 & +(pom1-pom2)*pom_dy
5441 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5444 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5445 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5446 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5447 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5448 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5449 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5450 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5451 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5453 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5456 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5457 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5458 & +pom1*pom_dt1+pom2*pom_dt2
5460 write(2,*), "de_dt = ", de_dt,de_dt_num
5464 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5465 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5466 cosfac2xx=cosfac2*xx
5467 sinfac2yy=sinfac2*yy
5469 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5471 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5473 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5474 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5475 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5476 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5477 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5478 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5479 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5480 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5481 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5482 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5486 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5487 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5490 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5491 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5492 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5494 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5495 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5499 dXX_Ctab(k,i)=dXX_Ci(k)
5500 dXX_C1tab(k,i)=dXX_Ci1(k)
5501 dYY_Ctab(k,i)=dYY_Ci(k)
5502 dYY_C1tab(k,i)=dYY_Ci1(k)
5503 dZZ_Ctab(k,i)=dZZ_Ci(k)
5504 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5505 dXX_XYZtab(k,i)=dXX_XYZ(k)
5506 dYY_XYZtab(k,i)=dYY_XYZ(k)
5507 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5511 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5512 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5513 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5514 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5515 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5517 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5518 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5519 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5520 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5521 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5522 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5523 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5524 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5526 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5527 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5529 C to check gradient call subroutine check_grad
5535 c------------------------------------------------------------------------------
5536 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5538 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5539 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5540 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5541 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5543 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5544 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5546 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5547 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5548 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5549 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5550 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5552 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5553 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5554 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5555 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5556 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5558 dsc_i = 0.743d0+x(61)
5560 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5561 & *(xx*cost2+yy*sint2))
5562 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5563 & *(xx*cost2-yy*sint2))
5564 s1=(1+x(63))/(0.1d0 + dscp1)
5565 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5566 s2=(1+x(65))/(0.1d0 + dscp2)
5567 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5568 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5569 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5574 c------------------------------------------------------------------------------
5575 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5577 C This procedure calculates two-body contact function g(rij) and its derivative:
5580 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5583 C where x=(rij-r0ij)/delta
5585 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5588 double precision rij,r0ij,eps0ij,fcont,fprimcont
5589 double precision x,x2,x4,delta
5593 if (x.lt.-1.0D0) then
5596 else if (x.le.1.0D0) then
5599 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5600 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5607 c------------------------------------------------------------------------------
5608 subroutine splinthet(theti,delta,ss,ssder)
5609 implicit real*8 (a-h,o-z)
5610 include 'DIMENSIONS'
5611 include 'COMMON.VAR'
5612 include 'COMMON.GEO'
5615 if (theti.gt.pipol) then
5616 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5618 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5623 c------------------------------------------------------------------------------
5624 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5626 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5627 double precision ksi,ksi2,ksi3,a1,a2,a3
5628 a1=fprim0*delta/(f1-f0)
5634 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5635 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5638 c------------------------------------------------------------------------------
5639 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5641 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5642 double precision ksi,ksi2,ksi3,a1,a2,a3
5647 a2=3*(f1x-f0x)-2*fprim0x*delta
5648 a3=fprim0x*delta-2*(f1x-f0x)
5649 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5652 C-----------------------------------------------------------------------------
5654 C-----------------------------------------------------------------------------
5655 subroutine etor(etors,edihcnstr)
5656 implicit real*8 (a-h,o-z)
5657 include 'DIMENSIONS'
5658 include 'COMMON.VAR'
5659 include 'COMMON.GEO'
5660 include 'COMMON.LOCAL'
5661 include 'COMMON.TORSION'
5662 include 'COMMON.INTERACT'
5663 include 'COMMON.DERIV'
5664 include 'COMMON.CHAIN'
5665 include 'COMMON.NAMES'
5666 include 'COMMON.IOUNITS'
5667 include 'COMMON.FFIELD'
5668 include 'COMMON.TORCNSTR'
5669 include 'COMMON.CONTROL'
5671 C Set lprn=.true. for debugging
5675 do i=iphi_start,iphi_end
5677 itori=itortyp(itype(i-2))
5678 itori1=itortyp(itype(i-1))
5681 C Proline-Proline pair is a special case...
5682 if (itori.eq.3 .and. itori1.eq.3) then
5683 if (phii.gt.-dwapi3) then
5685 fac=1.0D0/(1.0D0-cosphi)
5686 etorsi=v1(1,3,3)*fac
5687 etorsi=etorsi+etorsi
5688 etors=etors+etorsi-v1(1,3,3)
5689 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5690 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5693 v1ij=v1(j+1,itori,itori1)
5694 v2ij=v2(j+1,itori,itori1)
5697 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5698 if (energy_dec) etors_ii=etors_ii+
5699 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5700 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5704 v1ij=v1(j,itori,itori1)
5705 v2ij=v2(j,itori,itori1)
5708 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5709 if (energy_dec) etors_ii=etors_ii+
5710 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5711 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5714 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5717 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5718 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5719 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5720 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5721 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5723 ! 6/20/98 - dihedral angle constraints
5726 itori=idih_constr(i)
5729 if (difi.gt.drange(i)) then
5731 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5732 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5733 else if (difi.lt.-drange(i)) then
5735 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5736 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5738 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5739 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5741 ! write (iout,*) 'edihcnstr',edihcnstr
5744 c------------------------------------------------------------------------------
5745 subroutine etor_d(etors_d)
5749 c----------------------------------------------------------------------------
5751 subroutine etor(etors,edihcnstr)
5752 implicit real*8 (a-h,o-z)
5753 include 'DIMENSIONS'
5754 include 'COMMON.VAR'
5755 include 'COMMON.GEO'
5756 include 'COMMON.LOCAL'
5757 include 'COMMON.TORSION'
5758 include 'COMMON.INTERACT'
5759 include 'COMMON.DERIV'
5760 include 'COMMON.CHAIN'
5761 include 'COMMON.NAMES'
5762 include 'COMMON.IOUNITS'
5763 include 'COMMON.FFIELD'
5764 include 'COMMON.TORCNSTR'
5765 include 'COMMON.CONTROL'
5767 C Set lprn=.true. for debugging
5771 do i=iphi_start,iphi_end
5773 itori=itortyp(itype(i-2))
5774 itori1=itortyp(itype(i-1))
5777 C Regular cosine and sine terms
5778 do j=1,nterm(itori,itori1)
5779 v1ij=v1(j,itori,itori1)
5780 v2ij=v2(j,itori,itori1)
5783 etors=etors+v1ij*cosphi+v2ij*sinphi
5784 if (energy_dec) etors_ii=etors_ii+
5785 & v1ij*cosphi+v2ij*sinphi
5786 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5790 C E = SUM ----------------------------------- - v1
5791 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5793 cosphi=dcos(0.5d0*phii)
5794 sinphi=dsin(0.5d0*phii)
5795 do j=1,nlor(itori,itori1)
5796 vl1ij=vlor1(j,itori,itori1)
5797 vl2ij=vlor2(j,itori,itori1)
5798 vl3ij=vlor3(j,itori,itori1)
5799 pom=vl2ij*cosphi+vl3ij*sinphi
5800 pom1=1.0d0/(pom*pom+1.0d0)
5801 etors=etors+vl1ij*pom1
5802 if (energy_dec) etors_ii=etors_ii+
5805 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5807 C Subtract the constant term
5808 etors=etors-v0(itori,itori1)
5809 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5810 & 'etor',i,etors_ii-v0(itori,itori1)
5812 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5813 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5814 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5815 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5816 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5818 ! 6/20/98 - dihedral angle constraints
5820 c do i=1,ndih_constr
5821 do i=idihconstr_start,idihconstr_end
5822 itori=idih_constr(i)
5824 difi=pinorm(phii-phi0(i))
5825 if (difi.gt.drange(i)) then
5827 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5828 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5829 else if (difi.lt.-drange(i)) then
5831 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5832 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5836 c write (iout,*) "gloci", gloc(i-3,icg)
5837 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5838 cd & rad2deg*phi0(i), rad2deg*drange(i),
5839 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5841 cd write (iout,*) 'edihcnstr',edihcnstr
5844 c----------------------------------------------------------------------------
5845 subroutine etor_d(etors_d)
5846 C 6/23/01 Compute double torsional energy
5847 implicit real*8 (a-h,o-z)
5848 include 'DIMENSIONS'
5849 include 'COMMON.VAR'
5850 include 'COMMON.GEO'
5851 include 'COMMON.LOCAL'
5852 include 'COMMON.TORSION'
5853 include 'COMMON.INTERACT'
5854 include 'COMMON.DERIV'
5855 include 'COMMON.CHAIN'
5856 include 'COMMON.NAMES'
5857 include 'COMMON.IOUNITS'
5858 include 'COMMON.FFIELD'
5859 include 'COMMON.TORCNSTR'
5861 C Set lprn=.true. for debugging
5865 do i=iphid_start,iphid_end
5866 itori=itortyp(itype(i-2))
5867 itori1=itortyp(itype(i-1))
5868 itori2=itortyp(itype(i))
5873 do j=1,ntermd_1(itori,itori1,itori2)
5874 v1cij=v1c(1,j,itori,itori1,itori2)
5875 v1sij=v1s(1,j,itori,itori1,itori2)
5876 v2cij=v1c(2,j,itori,itori1,itori2)
5877 v2sij=v1s(2,j,itori,itori1,itori2)
5878 cosphi1=dcos(j*phii)
5879 sinphi1=dsin(j*phii)
5880 cosphi2=dcos(j*phii1)
5881 sinphi2=dsin(j*phii1)
5882 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5883 & v2cij*cosphi2+v2sij*sinphi2
5884 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5885 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5887 do k=2,ntermd_2(itori,itori1,itori2)
5889 v1cdij = v2c(k,l,itori,itori1,itori2)
5890 v2cdij = v2c(l,k,itori,itori1,itori2)
5891 v1sdij = v2s(k,l,itori,itori1,itori2)
5892 v2sdij = v2s(l,k,itori,itori1,itori2)
5893 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5894 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5895 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5896 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5897 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5898 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5899 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5900 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5901 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5902 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5905 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5906 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5907 c write (iout,*) "gloci", gloc(i-3,icg)
5912 c------------------------------------------------------------------------------
5913 subroutine eback_sc_corr(esccor)
5914 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5915 c conformational states; temporarily implemented as differences
5916 c between UNRES torsional potentials (dependent on three types of
5917 c residues) and the torsional potentials dependent on all 20 types
5918 c of residues computed from AM1 energy surfaces of terminally-blocked
5919 c amino-acid residues.
5920 implicit real*8 (a-h,o-z)
5921 include 'DIMENSIONS'
5922 include 'COMMON.VAR'
5923 include 'COMMON.GEO'
5924 include 'COMMON.LOCAL'
5925 include 'COMMON.TORSION'
5926 include 'COMMON.SCCOR'
5927 include 'COMMON.INTERACT'
5928 include 'COMMON.DERIV'
5929 include 'COMMON.CHAIN'
5930 include 'COMMON.NAMES'
5931 include 'COMMON.IOUNITS'
5932 include 'COMMON.FFIELD'
5933 include 'COMMON.CONTROL'
5935 C Set lprn=.true. for debugging
5938 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5940 do i=itau_start,itau_end
5942 isccori=isccortyp(itype(i-2))
5943 isccori1=isccortyp(itype(i-1))
5945 cccc Added 9 May 2012
5946 cc Tauangle is torsional engle depending on the value of first digit
5947 c(see comment below)
5948 cc Omicron is flat angle depending on the value of first digit
5949 c(see comment below)
5952 do intertyp=1,3 !intertyp
5953 cc Added 09 May 2012 (Adasko)
5954 cc Intertyp means interaction type of backbone mainchain correlation:
5955 c 1 = SC...Ca...Ca...Ca
5956 c 2 = Ca...Ca...Ca...SC
5957 c 3 = SC...Ca...Ca...SCi
5959 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5960 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5961 & (itype(i-1).eq.21)))
5962 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5963 & .or.(itype(i-2).eq.21)))
5964 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5965 & (itype(i-1).eq.21)))) cycle
5966 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5967 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5969 do j=1,nterm_sccor(isccori,isccori1)
5970 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5971 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5972 cosphi=dcos(j*tauangle(intertyp,i))
5973 sinphi=dsin(j*tauangle(intertyp,i))
5974 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5975 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5977 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5978 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5979 c &gloc_sc(intertyp,i-3,icg)
5981 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5982 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5983 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5984 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5985 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5989 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5993 c----------------------------------------------------------------------------
5994 subroutine multibody(ecorr)
5995 C This subroutine calculates multi-body contributions to energy following
5996 C the idea of Skolnick et al. If side chains I and J make a contact and
5997 C at the same time side chains I+1 and J+1 make a contact, an extra
5998 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5999 implicit real*8 (a-h,o-z)
6000 include 'DIMENSIONS'
6001 include 'COMMON.IOUNITS'
6002 include 'COMMON.DERIV'
6003 include 'COMMON.INTERACT'
6004 include 'COMMON.CONTACTS'
6005 double precision gx(3),gx1(3)
6008 C Set lprn=.true. for debugging
6012 write (iout,'(a)') 'Contact function values:'
6014 write (iout,'(i2,20(1x,i2,f10.5))')
6015 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6030 num_conti=num_cont(i)
6031 num_conti1=num_cont(i1)
6036 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6037 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6038 cd & ' ishift=',ishift
6039 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6040 C The system gains extra energy.
6041 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6042 endif ! j1==j+-ishift
6051 c------------------------------------------------------------------------------
6052 double precision function esccorr(i,j,k,l,jj,kk)
6053 implicit real*8 (a-h,o-z)
6054 include 'DIMENSIONS'
6055 include 'COMMON.IOUNITS'
6056 include 'COMMON.DERIV'
6057 include 'COMMON.INTERACT'
6058 include 'COMMON.CONTACTS'
6059 double precision gx(3),gx1(3)
6064 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6065 C Calculate the multi-body contribution to energy.
6066 C Calculate multi-body contributions to the gradient.
6067 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6068 cd & k,l,(gacont(m,kk,k),m=1,3)
6070 gx(m) =ekl*gacont(m,jj,i)
6071 gx1(m)=eij*gacont(m,kk,k)
6072 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6073 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6074 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6075 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6079 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6084 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6090 c------------------------------------------------------------------------------
6091 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6092 C This subroutine calculates multi-body contributions to hydrogen-bonding
6093 implicit real*8 (a-h,o-z)
6094 include 'DIMENSIONS'
6095 include 'COMMON.IOUNITS'
6098 parameter (max_cont=maxconts)
6099 parameter (max_dim=26)
6100 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6101 double precision zapas(max_dim,maxconts,max_fg_procs),
6102 & zapas_recv(max_dim,maxconts,max_fg_procs)
6103 common /przechowalnia/ zapas
6104 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6105 & status_array(MPI_STATUS_SIZE,maxconts*2)
6107 include 'COMMON.SETUP'
6108 include 'COMMON.FFIELD'
6109 include 'COMMON.DERIV'
6110 include 'COMMON.INTERACT'
6111 include 'COMMON.CONTACTS'
6112 include 'COMMON.CONTROL'
6113 include 'COMMON.LOCAL'
6114 double precision gx(3),gx1(3),time00
6117 C Set lprn=.true. for debugging
6122 if (nfgtasks.le.1) goto 30
6124 write (iout,'(a)') 'Contact function values before RECEIVE:'
6126 write (iout,'(2i3,50(1x,i2,f5.2))')
6127 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6128 & j=1,num_cont_hb(i))
6132 do i=1,ntask_cont_from
6135 do i=1,ntask_cont_to
6138 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6140 C Make the list of contacts to send to send to other procesors
6141 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6143 do i=iturn3_start,iturn3_end
6144 c write (iout,*) "make contact list turn3",i," num_cont",
6146 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6148 do i=iturn4_start,iturn4_end
6149 c write (iout,*) "make contact list turn4",i," num_cont",
6151 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6155 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6157 do j=1,num_cont_hb(i)
6160 iproc=iint_sent_local(k,jjc,ii)
6161 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6162 if (iproc.gt.0) then
6163 ncont_sent(iproc)=ncont_sent(iproc)+1
6164 nn=ncont_sent(iproc)
6166 zapas(2,nn,iproc)=jjc
6167 zapas(3,nn,iproc)=facont_hb(j,i)
6168 zapas(4,nn,iproc)=ees0p(j,i)
6169 zapas(5,nn,iproc)=ees0m(j,i)
6170 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6171 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6172 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6173 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6174 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6175 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6176 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6177 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6178 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6179 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6180 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6181 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6182 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6183 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6184 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6185 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6186 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6187 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6188 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6189 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6190 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6197 & "Numbers of contacts to be sent to other processors",
6198 & (ncont_sent(i),i=1,ntask_cont_to)
6199 write (iout,*) "Contacts sent"
6200 do ii=1,ntask_cont_to
6202 iproc=itask_cont_to(ii)
6203 write (iout,*) nn," contacts to processor",iproc,
6204 & " of CONT_TO_COMM group"
6206 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6214 CorrelID1=nfgtasks+fg_rank+1
6216 C Receive the numbers of needed contacts from other processors
6217 do ii=1,ntask_cont_from
6218 iproc=itask_cont_from(ii)
6220 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6221 & FG_COMM,req(ireq),IERR)
6223 c write (iout,*) "IRECV ended"
6225 C Send the number of contacts needed by other processors
6226 do ii=1,ntask_cont_to
6227 iproc=itask_cont_to(ii)
6229 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6230 & FG_COMM,req(ireq),IERR)
6232 c write (iout,*) "ISEND ended"
6233 c write (iout,*) "number of requests (nn)",ireq
6236 & call MPI_Waitall(ireq,req,status_array,ierr)
6238 c & "Numbers of contacts to be received from other processors",
6239 c & (ncont_recv(i),i=1,ntask_cont_from)
6243 do ii=1,ntask_cont_from
6244 iproc=itask_cont_from(ii)
6246 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6247 c & " of CONT_TO_COMM group"
6251 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6252 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6253 c write (iout,*) "ireq,req",ireq,req(ireq)
6256 C Send the contacts to processors that need them
6257 do ii=1,ntask_cont_to
6258 iproc=itask_cont_to(ii)
6260 c write (iout,*) nn," contacts to processor",iproc,
6261 c & " of CONT_TO_COMM group"
6264 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6265 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6266 c write (iout,*) "ireq,req",ireq,req(ireq)
6268 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6272 c write (iout,*) "number of requests (contacts)",ireq
6273 c write (iout,*) "req",(req(i),i=1,4)
6276 & call MPI_Waitall(ireq,req,status_array,ierr)
6277 do iii=1,ntask_cont_from
6278 iproc=itask_cont_from(iii)
6281 write (iout,*) "Received",nn," contacts from processor",iproc,
6282 & " of CONT_FROM_COMM group"
6285 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6290 ii=zapas_recv(1,i,iii)
6291 c Flag the received contacts to prevent double-counting
6292 jj=-zapas_recv(2,i,iii)
6293 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6295 nnn=num_cont_hb(ii)+1
6298 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6299 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6300 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6301 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6302 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6303 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6304 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6305 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6306 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6307 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6308 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6309 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6310 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6311 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6312 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6313 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6314 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6315 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6316 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6317 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6318 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6319 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6320 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6321 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6326 write (iout,'(a)') 'Contact function values after receive:'
6328 write (iout,'(2i3,50(1x,i3,f5.2))')
6329 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6330 & j=1,num_cont_hb(i))
6337 write (iout,'(a)') 'Contact function values:'
6339 write (iout,'(2i3,50(1x,i3,f5.2))')
6340 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6341 & j=1,num_cont_hb(i))
6345 C Remove the loop below after debugging !!!
6352 C Calculate the local-electrostatic correlation terms
6353 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6355 num_conti=num_cont_hb(i)
6356 num_conti1=num_cont_hb(i+1)
6363 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6364 c & ' jj=',jj,' kk=',kk
6365 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6366 & .or. j.lt.0 .and. j1.gt.0) .and.
6367 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6368 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6369 C The system gains extra energy.
6370 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6371 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6372 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6374 else if (j1.eq.j) then
6375 C Contacts I-J and I-(J+1) occur simultaneously.
6376 C The system loses extra energy.
6377 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6382 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6383 c & ' jj=',jj,' kk=',kk
6385 C Contacts I-J and (I+1)-J occur simultaneously.
6386 C The system loses extra energy.
6387 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6394 c------------------------------------------------------------------------------
6395 subroutine add_hb_contact(ii,jj,itask)
6396 implicit real*8 (a-h,o-z)
6397 include "DIMENSIONS"
6398 include "COMMON.IOUNITS"
6401 parameter (max_cont=maxconts)
6402 parameter (max_dim=26)
6403 include "COMMON.CONTACTS"
6404 double precision zapas(max_dim,maxconts,max_fg_procs),
6405 & zapas_recv(max_dim,maxconts,max_fg_procs)
6406 common /przechowalnia/ zapas
6407 integer i,j,ii,jj,iproc,itask(4),nn
6408 c write (iout,*) "itask",itask
6411 if (iproc.gt.0) then
6412 do j=1,num_cont_hb(ii)
6414 c write (iout,*) "i",ii," j",jj," jjc",jjc
6416 ncont_sent(iproc)=ncont_sent(iproc)+1
6417 nn=ncont_sent(iproc)
6418 zapas(1,nn,iproc)=ii
6419 zapas(2,nn,iproc)=jjc
6420 zapas(3,nn,iproc)=facont_hb(j,ii)
6421 zapas(4,nn,iproc)=ees0p(j,ii)
6422 zapas(5,nn,iproc)=ees0m(j,ii)
6423 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6424 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6425 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6426 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6427 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6428 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6429 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6430 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6431 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6432 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6433 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6434 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6435 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6436 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6437 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6438 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6439 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6440 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6441 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6442 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6443 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6451 c------------------------------------------------------------------------------
6452 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6454 C This subroutine calculates multi-body contributions to hydrogen-bonding
6455 implicit real*8 (a-h,o-z)
6456 include 'DIMENSIONS'
6457 include 'COMMON.IOUNITS'
6460 parameter (max_cont=maxconts)
6461 parameter (max_dim=70)
6462 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6463 double precision zapas(max_dim,maxconts,max_fg_procs),
6464 & zapas_recv(max_dim,maxconts,max_fg_procs)
6465 common /przechowalnia/ zapas
6466 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6467 & status_array(MPI_STATUS_SIZE,maxconts*2)
6469 include 'COMMON.SETUP'
6470 include 'COMMON.FFIELD'
6471 include 'COMMON.DERIV'
6472 include 'COMMON.LOCAL'
6473 include 'COMMON.INTERACT'
6474 include 'COMMON.CONTACTS'
6475 include 'COMMON.CHAIN'
6476 include 'COMMON.CONTROL'
6477 double precision gx(3),gx1(3)
6478 integer num_cont_hb_old(maxres)
6480 double precision eello4,eello5,eelo6,eello_turn6
6481 external eello4,eello5,eello6,eello_turn6
6482 C Set lprn=.true. for debugging
6487 num_cont_hb_old(i)=num_cont_hb(i)
6491 if (nfgtasks.le.1) goto 30
6493 write (iout,'(a)') 'Contact function values before RECEIVE:'
6495 write (iout,'(2i3,50(1x,i2,f5.2))')
6496 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6497 & j=1,num_cont_hb(i))
6501 do i=1,ntask_cont_from
6504 do i=1,ntask_cont_to
6507 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6509 C Make the list of contacts to send to send to other procesors
6510 do i=iturn3_start,iturn3_end
6511 c write (iout,*) "make contact list turn3",i," num_cont",
6513 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6515 do i=iturn4_start,iturn4_end
6516 c write (iout,*) "make contact list turn4",i," num_cont",
6518 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6522 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6524 do j=1,num_cont_hb(i)
6527 iproc=iint_sent_local(k,jjc,ii)
6528 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6529 if (iproc.ne.0) then
6530 ncont_sent(iproc)=ncont_sent(iproc)+1
6531 nn=ncont_sent(iproc)
6533 zapas(2,nn,iproc)=jjc
6534 zapas(3,nn,iproc)=d_cont(j,i)
6538 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6543 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6551 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6562 & "Numbers of contacts to be sent to other processors",
6563 & (ncont_sent(i),i=1,ntask_cont_to)
6564 write (iout,*) "Contacts sent"
6565 do ii=1,ntask_cont_to
6567 iproc=itask_cont_to(ii)
6568 write (iout,*) nn," contacts to processor",iproc,
6569 & " of CONT_TO_COMM group"
6571 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6579 CorrelID1=nfgtasks+fg_rank+1
6581 C Receive the numbers of needed contacts from other processors
6582 do ii=1,ntask_cont_from
6583 iproc=itask_cont_from(ii)
6585 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6586 & FG_COMM,req(ireq),IERR)
6588 c write (iout,*) "IRECV ended"
6590 C Send the number of contacts needed by other processors
6591 do ii=1,ntask_cont_to
6592 iproc=itask_cont_to(ii)
6594 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6595 & FG_COMM,req(ireq),IERR)
6597 c write (iout,*) "ISEND ended"
6598 c write (iout,*) "number of requests (nn)",ireq
6601 & call MPI_Waitall(ireq,req,status_array,ierr)
6603 c & "Numbers of contacts to be received from other processors",
6604 c & (ncont_recv(i),i=1,ntask_cont_from)
6608 do ii=1,ntask_cont_from
6609 iproc=itask_cont_from(ii)
6611 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6612 c & " of CONT_TO_COMM group"
6616 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6617 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6618 c write (iout,*) "ireq,req",ireq,req(ireq)
6621 C Send the contacts to processors that need them
6622 do ii=1,ntask_cont_to
6623 iproc=itask_cont_to(ii)
6625 c write (iout,*) nn," contacts to processor",iproc,
6626 c & " of CONT_TO_COMM group"
6629 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6630 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6631 c write (iout,*) "ireq,req",ireq,req(ireq)
6633 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6637 c write (iout,*) "number of requests (contacts)",ireq
6638 c write (iout,*) "req",(req(i),i=1,4)
6641 & call MPI_Waitall(ireq,req,status_array,ierr)
6642 do iii=1,ntask_cont_from
6643 iproc=itask_cont_from(iii)
6646 write (iout,*) "Received",nn," contacts from processor",iproc,
6647 & " of CONT_FROM_COMM group"
6650 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6655 ii=zapas_recv(1,i,iii)
6656 c Flag the received contacts to prevent double-counting
6657 jj=-zapas_recv(2,i,iii)
6658 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6660 nnn=num_cont_hb(ii)+1
6663 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6667 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6672 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6680 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6689 write (iout,'(a)') 'Contact function values after receive:'
6691 write (iout,'(2i3,50(1x,i3,5f6.3))')
6692 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6693 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6700 write (iout,'(a)') 'Contact function values:'
6702 write (iout,'(2i3,50(1x,i2,5f6.3))')
6703 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6704 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6710 C Remove the loop below after debugging !!!
6717 C Calculate the dipole-dipole interaction energies
6718 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6719 do i=iatel_s,iatel_e+1
6720 num_conti=num_cont_hb(i)
6729 C Calculate the local-electrostatic correlation terms
6730 c write (iout,*) "gradcorr5 in eello5 before loop"
6732 c write (iout,'(i5,3f10.5)')
6733 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6735 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6736 c write (iout,*) "corr loop i",i
6738 num_conti=num_cont_hb(i)
6739 num_conti1=num_cont_hb(i+1)
6746 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6747 c & ' jj=',jj,' kk=',kk
6748 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6749 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6750 & .or. j.lt.0 .and. j1.gt.0) .and.
6751 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6752 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6753 C The system gains extra energy.
6755 sqd1=dsqrt(d_cont(jj,i))
6756 sqd2=dsqrt(d_cont(kk,i1))
6757 sred_geom = sqd1*sqd2
6758 IF (sred_geom.lt.cutoff_corr) THEN
6759 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6761 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6762 cd & ' jj=',jj,' kk=',kk
6763 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6764 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6766 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6767 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6770 cd write (iout,*) 'sred_geom=',sred_geom,
6771 cd & ' ekont=',ekont,' fprim=',fprimcont,
6772 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6773 cd write (iout,*) "g_contij",g_contij
6774 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6775 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6776 call calc_eello(i,jp,i+1,jp1,jj,kk)
6777 if (wcorr4.gt.0.0d0)
6778 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6779 if (energy_dec.and.wcorr4.gt.0.0d0)
6780 1 write (iout,'(a6,4i5,0pf7.3)')
6781 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6782 c write (iout,*) "gradcorr5 before eello5"
6784 c write (iout,'(i5,3f10.5)')
6785 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6787 if (wcorr5.gt.0.0d0)
6788 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6789 c write (iout,*) "gradcorr5 after eello5"
6791 c write (iout,'(i5,3f10.5)')
6792 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6794 if (energy_dec.and.wcorr5.gt.0.0d0)
6795 1 write (iout,'(a6,4i5,0pf7.3)')
6796 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6797 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6798 cd write(2,*)'ijkl',i,jp,i+1,jp1
6799 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6800 & .or. wturn6.eq.0.0d0))then
6801 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6802 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6803 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6804 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6805 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6806 cd & 'ecorr6=',ecorr6
6807 cd write (iout,'(4e15.5)') sred_geom,
6808 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6809 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6810 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6811 else if (wturn6.gt.0.0d0
6812 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6813 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6814 eturn6=eturn6+eello_turn6(i,jj,kk)
6815 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6816 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6817 cd write (2,*) 'multibody_eello:eturn6',eturn6
6826 num_cont_hb(i)=num_cont_hb_old(i)
6828 c write (iout,*) "gradcorr5 in eello5"
6830 c write (iout,'(i5,3f10.5)')
6831 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6835 c------------------------------------------------------------------------------
6836 subroutine add_hb_contact_eello(ii,jj,itask)
6837 implicit real*8 (a-h,o-z)
6838 include "DIMENSIONS"
6839 include "COMMON.IOUNITS"
6842 parameter (max_cont=maxconts)
6843 parameter (max_dim=70)
6844 include "COMMON.CONTACTS"
6845 double precision zapas(max_dim,maxconts,max_fg_procs),
6846 & zapas_recv(max_dim,maxconts,max_fg_procs)
6847 common /przechowalnia/ zapas
6848 integer i,j,ii,jj,iproc,itask(4),nn
6849 c write (iout,*) "itask",itask
6852 if (iproc.gt.0) then
6853 do j=1,num_cont_hb(ii)
6855 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6857 ncont_sent(iproc)=ncont_sent(iproc)+1
6858 nn=ncont_sent(iproc)
6859 zapas(1,nn,iproc)=ii
6860 zapas(2,nn,iproc)=jjc
6861 zapas(3,nn,iproc)=d_cont(j,ii)
6865 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6870 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6878 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6890 c------------------------------------------------------------------------------
6891 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6892 implicit real*8 (a-h,o-z)
6893 include 'DIMENSIONS'
6894 include 'COMMON.IOUNITS'
6895 include 'COMMON.DERIV'
6896 include 'COMMON.INTERACT'
6897 include 'COMMON.CONTACTS'
6898 double precision gx(3),gx1(3)
6908 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6909 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6910 C Following 4 lines for diagnostics.
6915 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6916 c & 'Contacts ',i,j,
6917 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6918 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6920 C Calculate the multi-body contribution to energy.
6921 c ecorr=ecorr+ekont*ees
6922 C Calculate multi-body contributions to the gradient.
6923 coeffpees0pij=coeffp*ees0pij
6924 coeffmees0mij=coeffm*ees0mij
6925 coeffpees0pkl=coeffp*ees0pkl
6926 coeffmees0mkl=coeffm*ees0mkl
6928 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6929 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6930 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6931 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6932 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6933 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6934 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6935 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6936 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6937 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6938 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6939 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6940 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6941 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6942 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6943 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6944 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6945 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6946 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6947 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6948 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6949 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6950 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6951 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6952 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6957 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6958 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6959 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6960 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6965 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6966 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6967 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6968 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6971 c write (iout,*) "ehbcorr",ekont*ees
6976 C---------------------------------------------------------------------------
6977 subroutine dipole(i,j,jj)
6978 implicit real*8 (a-h,o-z)
6979 include 'DIMENSIONS'
6980 include 'COMMON.IOUNITS'
6981 include 'COMMON.CHAIN'
6982 include 'COMMON.FFIELD'
6983 include 'COMMON.DERIV'
6984 include 'COMMON.INTERACT'
6985 include 'COMMON.CONTACTS'
6986 include 'COMMON.TORSION'
6987 include 'COMMON.VAR'
6988 include 'COMMON.GEO'
6989 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6991 iti1 = itortyp(itype(i+1))
6992 if (j.lt.nres-1) then
6993 itj1 = itortyp(itype(j+1))
6998 dipi(iii,1)=Ub2(iii,i)
6999 dipderi(iii)=Ub2der(iii,i)
7000 dipi(iii,2)=b1(iii,iti1)
7001 dipj(iii,1)=Ub2(iii,j)
7002 dipderj(iii)=Ub2der(iii,j)
7003 dipj(iii,2)=b1(iii,itj1)
7007 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7010 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7017 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7021 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7026 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7027 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7029 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7031 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7033 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7038 C---------------------------------------------------------------------------
7039 subroutine calc_eello(i,j,k,l,jj,kk)
7041 C This subroutine computes matrices and vectors needed to calculate
7042 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7044 implicit real*8 (a-h,o-z)
7045 include 'DIMENSIONS'
7046 include 'COMMON.IOUNITS'
7047 include 'COMMON.CHAIN'
7048 include 'COMMON.DERIV'
7049 include 'COMMON.INTERACT'
7050 include 'COMMON.CONTACTS'
7051 include 'COMMON.TORSION'
7052 include 'COMMON.VAR'
7053 include 'COMMON.GEO'
7054 include 'COMMON.FFIELD'
7055 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7056 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7059 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7060 cd & ' jj=',jj,' kk=',kk
7061 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7062 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7063 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7066 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7067 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7070 call transpose2(aa1(1,1),aa1t(1,1))
7071 call transpose2(aa2(1,1),aa2t(1,1))
7074 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7075 & aa1tder(1,1,lll,kkk))
7076 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7077 & aa2tder(1,1,lll,kkk))
7081 C parallel orientation of the two CA-CA-CA frames.
7083 iti=itortyp(itype(i))
7087 itk1=itortyp(itype(k+1))
7088 itj=itortyp(itype(j))
7089 if (l.lt.nres-1) then
7090 itl1=itortyp(itype(l+1))
7094 C A1 kernel(j+1) A2T
7096 cd write (iout,'(3f10.5,5x,3f10.5)')
7097 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7099 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7100 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7101 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7102 C Following matrices are needed only for 6-th order cumulants
7103 IF (wcorr6.gt.0.0d0) THEN
7104 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7105 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7106 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7107 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7108 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7109 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7110 & ADtEAderx(1,1,1,1,1,1))
7112 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7113 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7114 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7115 & ADtEA1derx(1,1,1,1,1,1))
7117 C End 6-th order cumulants
7120 cd write (2,*) 'In calc_eello6'
7122 cd write (2,*) 'iii=',iii
7124 cd write (2,*) 'kkk=',kkk
7126 cd write (2,'(3(2f10.5),5x)')
7127 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7132 call transpose2(EUgder(1,1,k),auxmat(1,1))
7133 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7134 call transpose2(EUg(1,1,k),auxmat(1,1))
7135 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7136 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7140 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7141 & EAEAderx(1,1,lll,kkk,iii,1))
7145 C A1T kernel(i+1) A2
7146 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7147 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7148 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7149 C Following matrices are needed only for 6-th order cumulants
7150 IF (wcorr6.gt.0.0d0) THEN
7151 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7152 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7153 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7154 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7155 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7156 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7157 & ADtEAderx(1,1,1,1,1,2))
7158 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7159 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7160 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7161 & ADtEA1derx(1,1,1,1,1,2))
7163 C End 6-th order cumulants
7164 call transpose2(EUgder(1,1,l),auxmat(1,1))
7165 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7166 call transpose2(EUg(1,1,l),auxmat(1,1))
7167 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7168 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7172 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7173 & EAEAderx(1,1,lll,kkk,iii,2))
7178 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7179 C They are needed only when the fifth- or the sixth-order cumulants are
7181 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7182 call transpose2(AEA(1,1,1),auxmat(1,1))
7183 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7184 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7185 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7186 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7187 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7188 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7189 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7190 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7191 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7192 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7193 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7194 call transpose2(AEA(1,1,2),auxmat(1,1))
7195 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7196 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7197 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7198 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7199 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7200 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7201 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7202 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7203 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7204 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7205 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7206 C Calculate the Cartesian derivatives of the vectors.
7210 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7211 call matvec2(auxmat(1,1),b1(1,iti),
7212 & AEAb1derx(1,lll,kkk,iii,1,1))
7213 call matvec2(auxmat(1,1),Ub2(1,i),
7214 & AEAb2derx(1,lll,kkk,iii,1,1))
7215 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7216 & AEAb1derx(1,lll,kkk,iii,2,1))
7217 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7218 & AEAb2derx(1,lll,kkk,iii,2,1))
7219 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7220 call matvec2(auxmat(1,1),b1(1,itj),
7221 & AEAb1derx(1,lll,kkk,iii,1,2))
7222 call matvec2(auxmat(1,1),Ub2(1,j),
7223 & AEAb2derx(1,lll,kkk,iii,1,2))
7224 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7225 & AEAb1derx(1,lll,kkk,iii,2,2))
7226 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7227 & AEAb2derx(1,lll,kkk,iii,2,2))
7234 C Antiparallel orientation of the two CA-CA-CA frames.
7236 iti=itortyp(itype(i))
7240 itk1=itortyp(itype(k+1))
7241 itl=itortyp(itype(l))
7242 itj=itortyp(itype(j))
7243 if (j.lt.nres-1) then
7244 itj1=itortyp(itype(j+1))
7248 C A2 kernel(j-1)T A1T
7249 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7250 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7251 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7252 C Following matrices are needed only for 6-th order cumulants
7253 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7254 & j.eq.i+4 .and. l.eq.i+3)) THEN
7255 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7256 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7257 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7258 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7259 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7260 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7261 & ADtEAderx(1,1,1,1,1,1))
7262 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7263 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7264 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7265 & ADtEA1derx(1,1,1,1,1,1))
7267 C End 6-th order cumulants
7268 call transpose2(EUgder(1,1,k),auxmat(1,1))
7269 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7270 call transpose2(EUg(1,1,k),auxmat(1,1))
7271 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7272 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7276 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7277 & EAEAderx(1,1,lll,kkk,iii,1))
7281 C A2T kernel(i+1)T A1
7282 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7283 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7284 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7285 C Following matrices are needed only for 6-th order cumulants
7286 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7287 & j.eq.i+4 .and. l.eq.i+3)) THEN
7288 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7289 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7290 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7291 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7292 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7293 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7294 & ADtEAderx(1,1,1,1,1,2))
7295 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7296 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7297 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7298 & ADtEA1derx(1,1,1,1,1,2))
7300 C End 6-th order cumulants
7301 call transpose2(EUgder(1,1,j),auxmat(1,1))
7302 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7303 call transpose2(EUg(1,1,j),auxmat(1,1))
7304 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7305 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7309 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7310 & EAEAderx(1,1,lll,kkk,iii,2))
7315 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7316 C They are needed only when the fifth- or the sixth-order cumulants are
7318 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7319 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7320 call transpose2(AEA(1,1,1),auxmat(1,1))
7321 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7322 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7323 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7324 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7325 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7326 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7327 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7328 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7329 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7330 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7331 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7332 call transpose2(AEA(1,1,2),auxmat(1,1))
7333 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7334 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7335 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7336 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7337 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7338 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7339 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7340 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7341 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7342 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7343 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7344 C Calculate the Cartesian derivatives of the vectors.
7348 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7349 call matvec2(auxmat(1,1),b1(1,iti),
7350 & AEAb1derx(1,lll,kkk,iii,1,1))
7351 call matvec2(auxmat(1,1),Ub2(1,i),
7352 & AEAb2derx(1,lll,kkk,iii,1,1))
7353 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7354 & AEAb1derx(1,lll,kkk,iii,2,1))
7355 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7356 & AEAb2derx(1,lll,kkk,iii,2,1))
7357 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7358 call matvec2(auxmat(1,1),b1(1,itl),
7359 & AEAb1derx(1,lll,kkk,iii,1,2))
7360 call matvec2(auxmat(1,1),Ub2(1,l),
7361 & AEAb2derx(1,lll,kkk,iii,1,2))
7362 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7363 & AEAb1derx(1,lll,kkk,iii,2,2))
7364 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7365 & AEAb2derx(1,lll,kkk,iii,2,2))
7374 C---------------------------------------------------------------------------
7375 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7376 & KK,KKderg,AKA,AKAderg,AKAderx)
7380 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7381 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7382 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7387 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7389 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7392 cd if (lprn) write (2,*) 'In kernel'
7394 cd if (lprn) write (2,*) 'kkk=',kkk
7396 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7397 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7399 cd write (2,*) 'lll=',lll
7400 cd write (2,*) 'iii=1'
7402 cd write (2,'(3(2f10.5),5x)')
7403 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7406 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7407 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7409 cd write (2,*) 'lll=',lll
7410 cd write (2,*) 'iii=2'
7412 cd write (2,'(3(2f10.5),5x)')
7413 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7420 C---------------------------------------------------------------------------
7421 double precision function eello4(i,j,k,l,jj,kk)
7422 implicit real*8 (a-h,o-z)
7423 include 'DIMENSIONS'
7424 include 'COMMON.IOUNITS'
7425 include 'COMMON.CHAIN'
7426 include 'COMMON.DERIV'
7427 include 'COMMON.INTERACT'
7428 include 'COMMON.CONTACTS'
7429 include 'COMMON.TORSION'
7430 include 'COMMON.VAR'
7431 include 'COMMON.GEO'
7432 double precision pizda(2,2),ggg1(3),ggg2(3)
7433 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7437 cd print *,'eello4:',i,j,k,l,jj,kk
7438 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7439 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7440 cold eij=facont_hb(jj,i)
7441 cold ekl=facont_hb(kk,k)
7443 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7444 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7445 gcorr_loc(k-1)=gcorr_loc(k-1)
7446 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7448 gcorr_loc(l-1)=gcorr_loc(l-1)
7449 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7451 gcorr_loc(j-1)=gcorr_loc(j-1)
7452 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7457 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7458 & -EAEAderx(2,2,lll,kkk,iii,1)
7459 cd derx(lll,kkk,iii)=0.0d0
7463 cd gcorr_loc(l-1)=0.0d0
7464 cd gcorr_loc(j-1)=0.0d0
7465 cd gcorr_loc(k-1)=0.0d0
7467 cd write (iout,*)'Contacts have occurred for peptide groups',
7468 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7469 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7470 if (j.lt.nres-1) then
7477 if (l.lt.nres-1) then
7485 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7486 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7487 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7488 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7489 cgrad ghalf=0.5d0*ggg1(ll)
7490 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7491 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7492 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7493 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7494 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7495 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7496 cgrad ghalf=0.5d0*ggg2(ll)
7497 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7498 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7499 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7500 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7501 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7502 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7506 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7511 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7516 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7521 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7525 cd write (2,*) iii,gcorr_loc(iii)
7528 cd write (2,*) 'ekont',ekont
7529 cd write (iout,*) 'eello4',ekont*eel4
7532 C---------------------------------------------------------------------------
7533 double precision function eello5(i,j,k,l,jj,kk)
7534 implicit real*8 (a-h,o-z)
7535 include 'DIMENSIONS'
7536 include 'COMMON.IOUNITS'
7537 include 'COMMON.CHAIN'
7538 include 'COMMON.DERIV'
7539 include 'COMMON.INTERACT'
7540 include 'COMMON.CONTACTS'
7541 include 'COMMON.TORSION'
7542 include 'COMMON.VAR'
7543 include 'COMMON.GEO'
7544 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7545 double precision ggg1(3),ggg2(3)
7546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7551 C /l\ / \ \ / \ / \ / C
7552 C / \ / \ \ / \ / \ / C
7553 C j| o |l1 | o | o| o | | o |o C
7554 C \ |/k\| |/ \| / |/ \| |/ \| C
7555 C \i/ \ / \ / / \ / \ C
7557 C (I) (II) (III) (IV) C
7559 C eello5_1 eello5_2 eello5_3 eello5_4 C
7561 C Antiparallel chains C
7564 C /j\ / \ \ / \ / \ / C
7565 C / \ / \ \ / \ / \ / C
7566 C j1| o |l | o | o| o | | o |o C
7567 C \ |/k\| |/ \| / |/ \| |/ \| C
7568 C \i/ \ / \ / / \ / \ C
7570 C (I) (II) (III) (IV) C
7572 C eello5_1 eello5_2 eello5_3 eello5_4 C
7574 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7576 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7577 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7582 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7584 itk=itortyp(itype(k))
7585 itl=itortyp(itype(l))
7586 itj=itortyp(itype(j))
7591 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7592 cd & eel5_3_num,eel5_4_num)
7596 derx(lll,kkk,iii)=0.0d0
7600 cd eij=facont_hb(jj,i)
7601 cd ekl=facont_hb(kk,k)
7603 cd write (iout,*)'Contacts have occurred for peptide groups',
7604 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7606 C Contribution from the graph I.
7607 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7608 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7609 call transpose2(EUg(1,1,k),auxmat(1,1))
7610 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7611 vv(1)=pizda(1,1)-pizda(2,2)
7612 vv(2)=pizda(1,2)+pizda(2,1)
7613 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7614 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7615 C Explicit gradient in virtual-dihedral angles.
7616 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7617 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7618 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7619 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7620 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7621 vv(1)=pizda(1,1)-pizda(2,2)
7622 vv(2)=pizda(1,2)+pizda(2,1)
7623 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7624 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7625 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7626 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)-pizda(2,2)
7628 vv(2)=pizda(1,2)+pizda(2,1)
7630 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7631 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7632 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7634 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7635 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7636 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7638 C Cartesian gradient
7642 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7644 vv(1)=pizda(1,1)-pizda(2,2)
7645 vv(2)=pizda(1,2)+pizda(2,1)
7646 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7647 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7648 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7654 C Contribution from graph II
7655 call transpose2(EE(1,1,itk),auxmat(1,1))
7656 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7657 vv(1)=pizda(1,1)+pizda(2,2)
7658 vv(2)=pizda(2,1)-pizda(1,2)
7659 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7660 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7661 C Explicit gradient in virtual-dihedral angles.
7662 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7663 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7664 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7665 vv(1)=pizda(1,1)+pizda(2,2)
7666 vv(2)=pizda(2,1)-pizda(1,2)
7668 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7669 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7670 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7672 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7673 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7674 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7676 C Cartesian gradient
7680 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7682 vv(1)=pizda(1,1)+pizda(2,2)
7683 vv(2)=pizda(2,1)-pizda(1,2)
7684 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7685 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7686 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7694 C Parallel orientation
7695 C Contribution from graph III
7696 call transpose2(EUg(1,1,l),auxmat(1,1))
7697 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7698 vv(1)=pizda(1,1)-pizda(2,2)
7699 vv(2)=pizda(1,2)+pizda(2,1)
7700 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7701 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7702 C Explicit gradient in virtual-dihedral angles.
7703 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7704 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7705 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7706 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7707 vv(1)=pizda(1,1)-pizda(2,2)
7708 vv(2)=pizda(1,2)+pizda(2,1)
7709 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7710 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7711 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7712 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7713 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7714 vv(1)=pizda(1,1)-pizda(2,2)
7715 vv(2)=pizda(1,2)+pizda(2,1)
7716 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7717 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7718 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7719 C Cartesian gradient
7723 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7725 vv(1)=pizda(1,1)-pizda(2,2)
7726 vv(2)=pizda(1,2)+pizda(2,1)
7727 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7728 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7729 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7734 C Contribution from graph IV
7736 call transpose2(EE(1,1,itl),auxmat(1,1))
7737 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7738 vv(1)=pizda(1,1)+pizda(2,2)
7739 vv(2)=pizda(2,1)-pizda(1,2)
7740 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7741 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7742 C Explicit gradient in virtual-dihedral angles.
7743 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7744 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7745 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7746 vv(1)=pizda(1,1)+pizda(2,2)
7747 vv(2)=pizda(2,1)-pizda(1,2)
7748 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7749 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7750 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7751 C Cartesian gradient
7755 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7757 vv(1)=pizda(1,1)+pizda(2,2)
7758 vv(2)=pizda(2,1)-pizda(1,2)
7759 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7760 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7761 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7766 C Antiparallel orientation
7767 C Contribution from graph III
7769 call transpose2(EUg(1,1,j),auxmat(1,1))
7770 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7771 vv(1)=pizda(1,1)-pizda(2,2)
7772 vv(2)=pizda(1,2)+pizda(2,1)
7773 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7774 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7775 C Explicit gradient in virtual-dihedral angles.
7776 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7777 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7778 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7779 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7780 vv(1)=pizda(1,1)-pizda(2,2)
7781 vv(2)=pizda(1,2)+pizda(2,1)
7782 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7783 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7784 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7785 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7786 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7787 vv(1)=pizda(1,1)-pizda(2,2)
7788 vv(2)=pizda(1,2)+pizda(2,1)
7789 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7790 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7791 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7792 C Cartesian gradient
7796 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7798 vv(1)=pizda(1,1)-pizda(2,2)
7799 vv(2)=pizda(1,2)+pizda(2,1)
7800 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7801 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7802 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7807 C Contribution from graph IV
7809 call transpose2(EE(1,1,itj),auxmat(1,1))
7810 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7811 vv(1)=pizda(1,1)+pizda(2,2)
7812 vv(2)=pizda(2,1)-pizda(1,2)
7813 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7814 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7815 C Explicit gradient in virtual-dihedral angles.
7816 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7817 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7818 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7819 vv(1)=pizda(1,1)+pizda(2,2)
7820 vv(2)=pizda(2,1)-pizda(1,2)
7821 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7822 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7823 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7824 C Cartesian gradient
7828 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7830 vv(1)=pizda(1,1)+pizda(2,2)
7831 vv(2)=pizda(2,1)-pizda(1,2)
7832 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7833 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7834 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7840 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7841 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7842 cd write (2,*) 'ijkl',i,j,k,l
7843 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7844 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7846 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7847 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7848 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7849 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7850 if (j.lt.nres-1) then
7857 if (l.lt.nres-1) then
7867 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7868 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7869 C summed up outside the subrouine as for the other subroutines
7870 C handling long-range interactions. The old code is commented out
7871 C with "cgrad" to keep track of changes.
7873 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7874 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7875 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7876 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7877 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7878 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7879 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7880 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7881 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7882 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7884 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7885 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7886 cgrad ghalf=0.5d0*ggg1(ll)
7888 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7889 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7890 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7891 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7892 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7893 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7894 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7895 cgrad ghalf=0.5d0*ggg2(ll)
7897 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7898 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7899 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7900 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7901 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7902 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7907 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7908 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7913 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7914 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7920 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7925 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7929 cd write (2,*) iii,g_corr5_loc(iii)
7932 cd write (2,*) 'ekont',ekont
7933 cd write (iout,*) 'eello5',ekont*eel5
7936 c--------------------------------------------------------------------------
7937 double precision function eello6(i,j,k,l,jj,kk)
7938 implicit real*8 (a-h,o-z)
7939 include 'DIMENSIONS'
7940 include 'COMMON.IOUNITS'
7941 include 'COMMON.CHAIN'
7942 include 'COMMON.DERIV'
7943 include 'COMMON.INTERACT'
7944 include 'COMMON.CONTACTS'
7945 include 'COMMON.TORSION'
7946 include 'COMMON.VAR'
7947 include 'COMMON.GEO'
7948 include 'COMMON.FFIELD'
7949 double precision ggg1(3),ggg2(3)
7950 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7955 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7963 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7964 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7968 derx(lll,kkk,iii)=0.0d0
7972 cd eij=facont_hb(jj,i)
7973 cd ekl=facont_hb(kk,k)
7979 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7980 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7981 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7982 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7983 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7984 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7986 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7987 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7988 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7989 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7990 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7991 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7995 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7997 C If turn contributions are considered, they will be handled separately.
7998 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7999 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8000 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8001 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8002 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8003 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8004 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8006 if (j.lt.nres-1) then
8013 if (l.lt.nres-1) then
8021 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8022 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8023 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8024 cgrad ghalf=0.5d0*ggg1(ll)
8026 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8027 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8028 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8029 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8030 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8031 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8032 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8033 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8034 cgrad ghalf=0.5d0*ggg2(ll)
8035 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8037 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8038 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8039 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8040 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8041 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8042 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8047 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8048 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8053 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8054 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8060 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8065 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8069 cd write (2,*) iii,g_corr6_loc(iii)
8072 cd write (2,*) 'ekont',ekont
8073 cd write (iout,*) 'eello6',ekont*eel6
8076 c--------------------------------------------------------------------------
8077 double precision function eello6_graph1(i,j,k,l,imat,swap)
8078 implicit real*8 (a-h,o-z)
8079 include 'DIMENSIONS'
8080 include 'COMMON.IOUNITS'
8081 include 'COMMON.CHAIN'
8082 include 'COMMON.DERIV'
8083 include 'COMMON.INTERACT'
8084 include 'COMMON.CONTACTS'
8085 include 'COMMON.TORSION'
8086 include 'COMMON.VAR'
8087 include 'COMMON.GEO'
8088 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8092 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8094 C Parallel Antiparallel
8100 C \ j|/k\| / \ |/k\|l /
8105 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8106 itk=itortyp(itype(k))
8107 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8108 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8109 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8110 call transpose2(EUgC(1,1,k),auxmat(1,1))
8111 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8112 vv1(1)=pizda1(1,1)-pizda1(2,2)
8113 vv1(2)=pizda1(1,2)+pizda1(2,1)
8114 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8115 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8116 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8117 s5=scalar2(vv(1),Dtobr2(1,i))
8118 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8119 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8120 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8121 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8122 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8123 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8124 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8125 & +scalar2(vv(1),Dtobr2der(1,i)))
8126 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8127 vv1(1)=pizda1(1,1)-pizda1(2,2)
8128 vv1(2)=pizda1(1,2)+pizda1(2,1)
8129 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8130 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8132 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8133 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8134 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8135 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8136 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8138 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8139 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8140 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8141 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8142 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8144 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8145 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8146 vv1(1)=pizda1(1,1)-pizda1(2,2)
8147 vv1(2)=pizda1(1,2)+pizda1(2,1)
8148 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8149 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8150 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8151 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8160 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8161 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8162 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8163 call transpose2(EUgC(1,1,k),auxmat(1,1))
8164 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8166 vv1(1)=pizda1(1,1)-pizda1(2,2)
8167 vv1(2)=pizda1(1,2)+pizda1(2,1)
8168 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8169 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8170 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8171 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8172 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8173 s5=scalar2(vv(1),Dtobr2(1,i))
8174 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8180 c----------------------------------------------------------------------------
8181 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8182 implicit real*8 (a-h,o-z)
8183 include 'DIMENSIONS'
8184 include 'COMMON.IOUNITS'
8185 include 'COMMON.CHAIN'
8186 include 'COMMON.DERIV'
8187 include 'COMMON.INTERACT'
8188 include 'COMMON.CONTACTS'
8189 include 'COMMON.TORSION'
8190 include 'COMMON.VAR'
8191 include 'COMMON.GEO'
8193 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8194 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8197 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8199 C Parallel Antiparallel C
8205 C \ j|/k\| \ |/k\|l C
8210 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8211 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8212 C AL 7/4/01 s1 would occur in the sixth-order moment,
8213 C but not in a cluster cumulant
8215 s1=dip(1,jj,i)*dip(1,kk,k)
8217 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8218 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8219 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8220 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8221 call transpose2(EUg(1,1,k),auxmat(1,1))
8222 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8223 vv(1)=pizda(1,1)-pizda(2,2)
8224 vv(2)=pizda(1,2)+pizda(2,1)
8225 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8226 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8228 eello6_graph2=-(s1+s2+s3+s4)
8230 eello6_graph2=-(s2+s3+s4)
8233 C Derivatives in gamma(i-1)
8236 s1=dipderg(1,jj,i)*dip(1,kk,k)
8238 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8239 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8240 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8241 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8243 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8245 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8247 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8249 C Derivatives in gamma(k-1)
8251 s1=dip(1,jj,i)*dipderg(1,kk,k)
8253 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8254 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8255 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8256 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8257 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8258 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8259 vv(1)=pizda(1,1)-pizda(2,2)
8260 vv(2)=pizda(1,2)+pizda(2,1)
8261 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8263 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8265 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8267 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8268 C Derivatives in gamma(j-1) or gamma(l-1)
8271 s1=dipderg(3,jj,i)*dip(1,kk,k)
8273 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8274 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8275 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8276 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8277 vv(1)=pizda(1,1)-pizda(2,2)
8278 vv(2)=pizda(1,2)+pizda(2,1)
8279 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8282 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8284 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8287 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8288 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8290 C Derivatives in gamma(l-1) or gamma(j-1)
8293 s1=dip(1,jj,i)*dipderg(3,kk,k)
8295 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8296 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8297 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8298 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8299 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8300 vv(1)=pizda(1,1)-pizda(2,2)
8301 vv(2)=pizda(1,2)+pizda(2,1)
8302 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8305 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8307 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8310 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8311 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8313 C Cartesian derivatives.
8315 write (2,*) 'In eello6_graph2'
8317 write (2,*) 'iii=',iii
8319 write (2,*) 'kkk=',kkk
8321 write (2,'(3(2f10.5),5x)')
8322 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8332 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8334 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8337 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8339 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8340 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8342 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8343 call transpose2(EUg(1,1,k),auxmat(1,1))
8344 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8346 vv(1)=pizda(1,1)-pizda(2,2)
8347 vv(2)=pizda(1,2)+pizda(2,1)
8348 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8349 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8351 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8353 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8356 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8358 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8365 c----------------------------------------------------------------------------
8366 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8367 implicit real*8 (a-h,o-z)
8368 include 'DIMENSIONS'
8369 include 'COMMON.IOUNITS'
8370 include 'COMMON.CHAIN'
8371 include 'COMMON.DERIV'
8372 include 'COMMON.INTERACT'
8373 include 'COMMON.CONTACTS'
8374 include 'COMMON.TORSION'
8375 include 'COMMON.VAR'
8376 include 'COMMON.GEO'
8377 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8379 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8381 C Parallel Antiparallel C
8387 C j|/k\| / |/k\|l / C
8392 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8394 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8395 C energy moment and not to the cluster cumulant.
8396 iti=itortyp(itype(i))
8397 if (j.lt.nres-1) then
8398 itj1=itortyp(itype(j+1))
8402 itk=itortyp(itype(k))
8403 itk1=itortyp(itype(k+1))
8404 if (l.lt.nres-1) then
8405 itl1=itortyp(itype(l+1))
8410 s1=dip(4,jj,i)*dip(4,kk,k)
8412 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8413 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8414 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8415 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8416 call transpose2(EE(1,1,itk),auxmat(1,1))
8417 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8418 vv(1)=pizda(1,1)+pizda(2,2)
8419 vv(2)=pizda(2,1)-pizda(1,2)
8420 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8421 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8422 cd & "sum",-(s2+s3+s4)
8424 eello6_graph3=-(s1+s2+s3+s4)
8426 eello6_graph3=-(s2+s3+s4)
8429 C Derivatives in gamma(k-1)
8430 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8431 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8432 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8433 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8434 C Derivatives in gamma(l-1)
8435 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8436 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8437 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8438 vv(1)=pizda(1,1)+pizda(2,2)
8439 vv(2)=pizda(2,1)-pizda(1,2)
8440 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8441 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8442 C Cartesian derivatives.
8448 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8450 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8453 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8455 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8456 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8458 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8459 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8461 vv(1)=pizda(1,1)+pizda(2,2)
8462 vv(2)=pizda(2,1)-pizda(1,2)
8463 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8465 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8467 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8470 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8472 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8474 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8480 c----------------------------------------------------------------------------
8481 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8482 implicit real*8 (a-h,o-z)
8483 include 'DIMENSIONS'
8484 include 'COMMON.IOUNITS'
8485 include 'COMMON.CHAIN'
8486 include 'COMMON.DERIV'
8487 include 'COMMON.INTERACT'
8488 include 'COMMON.CONTACTS'
8489 include 'COMMON.TORSION'
8490 include 'COMMON.VAR'
8491 include 'COMMON.GEO'
8492 include 'COMMON.FFIELD'
8493 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8494 & auxvec1(2),auxmat1(2,2)
8496 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8498 C Parallel Antiparallel C
8504 C \ j|/k\| \ |/k\|l C
8509 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8511 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8512 C energy moment and not to the cluster cumulant.
8513 cd write (2,*) 'eello_graph4: wturn6',wturn6
8514 iti=itortyp(itype(i))
8515 itj=itortyp(itype(j))
8516 if (j.lt.nres-1) then
8517 itj1=itortyp(itype(j+1))
8521 itk=itortyp(itype(k))
8522 if (k.lt.nres-1) then
8523 itk1=itortyp(itype(k+1))
8527 itl=itortyp(itype(l))
8528 if (l.lt.nres-1) then
8529 itl1=itortyp(itype(l+1))
8533 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8534 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8535 cd & ' itl',itl,' itl1',itl1
8538 s1=dip(3,jj,i)*dip(3,kk,k)
8540 s1=dip(2,jj,j)*dip(2,kk,l)
8543 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8544 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8546 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8547 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8549 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8550 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8552 call transpose2(EUg(1,1,k),auxmat(1,1))
8553 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8554 vv(1)=pizda(1,1)-pizda(2,2)
8555 vv(2)=pizda(2,1)+pizda(1,2)
8556 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8557 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8559 eello6_graph4=-(s1+s2+s3+s4)
8561 eello6_graph4=-(s2+s3+s4)
8563 C Derivatives in gamma(i-1)
8567 s1=dipderg(2,jj,i)*dip(3,kk,k)
8569 s1=dipderg(4,jj,j)*dip(2,kk,l)
8572 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8574 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8575 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8577 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8578 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8580 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8581 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8582 cd write (2,*) 'turn6 derivatives'
8584 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8586 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8590 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8592 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8596 C Derivatives in gamma(k-1)
8599 s1=dip(3,jj,i)*dipderg(2,kk,k)
8601 s1=dip(2,jj,j)*dipderg(4,kk,l)
8604 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8605 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8607 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8608 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8610 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8611 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8613 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8614 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8615 vv(1)=pizda(1,1)-pizda(2,2)
8616 vv(2)=pizda(2,1)+pizda(1,2)
8617 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8618 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8620 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8622 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8626 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8628 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8631 C Derivatives in gamma(j-1) or gamma(l-1)
8632 if (l.eq.j+1 .and. l.gt.1) then
8633 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8634 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8635 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8636 vv(1)=pizda(1,1)-pizda(2,2)
8637 vv(2)=pizda(2,1)+pizda(1,2)
8638 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8639 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8640 else if (j.gt.1) then
8641 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8642 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8643 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8644 vv(1)=pizda(1,1)-pizda(2,2)
8645 vv(2)=pizda(2,1)+pizda(1,2)
8646 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8647 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8648 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8650 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8653 C Cartesian derivatives.
8660 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8662 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8666 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8668 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8672 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8674 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8676 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8677 & b1(1,itj1),auxvec(1))
8678 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8680 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8681 & b1(1,itl1),auxvec(1))
8682 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8684 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8686 vv(1)=pizda(1,1)-pizda(2,2)
8687 vv(2)=pizda(2,1)+pizda(1,2)
8688 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8690 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8692 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8695 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8698 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8701 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8703 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8705 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8709 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8711 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8714 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8716 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8724 c----------------------------------------------------------------------------
8725 double precision function eello_turn6(i,jj,kk)
8726 implicit real*8 (a-h,o-z)
8727 include 'DIMENSIONS'
8728 include 'COMMON.IOUNITS'
8729 include 'COMMON.CHAIN'
8730 include 'COMMON.DERIV'
8731 include 'COMMON.INTERACT'
8732 include 'COMMON.CONTACTS'
8733 include 'COMMON.TORSION'
8734 include 'COMMON.VAR'
8735 include 'COMMON.GEO'
8736 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8737 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8739 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8740 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8741 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8742 C the respective energy moment and not to the cluster cumulant.
8751 iti=itortyp(itype(i))
8752 itk=itortyp(itype(k))
8753 itk1=itortyp(itype(k+1))
8754 itl=itortyp(itype(l))
8755 itj=itortyp(itype(j))
8756 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8757 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8758 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8763 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8765 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8769 derx_turn(lll,kkk,iii)=0.0d0
8776 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8778 cd write (2,*) 'eello6_5',eello6_5
8780 call transpose2(AEA(1,1,1),auxmat(1,1))
8781 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8782 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8783 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8785 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8786 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8787 s2 = scalar2(b1(1,itk),vtemp1(1))
8789 call transpose2(AEA(1,1,2),atemp(1,1))
8790 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8791 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8792 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8794 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8795 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8796 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8798 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8799 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8800 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8801 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8802 ss13 = scalar2(b1(1,itk),vtemp4(1))
8803 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8805 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8811 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8812 C Derivatives in gamma(i+2)
8816 call transpose2(AEA(1,1,1),auxmatd(1,1))
8817 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8818 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8819 call transpose2(AEAderg(1,1,2),atempd(1,1))
8820 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8821 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8823 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8824 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8825 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8831 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8832 C Derivatives in gamma(i+3)
8834 call transpose2(AEA(1,1,1),auxmatd(1,1))
8835 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8836 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8837 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8839 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8840 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8841 s2d = scalar2(b1(1,itk),vtemp1d(1))
8843 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8844 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8846 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8848 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8849 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8850 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8858 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8859 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8861 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8862 & -0.5d0*ekont*(s2d+s12d)
8864 C Derivatives in gamma(i+4)
8865 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8866 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8867 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8869 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8870 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8871 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8879 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8881 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8883 C Derivatives in gamma(i+5)
8885 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8886 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8887 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8889 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8890 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8891 s2d = scalar2(b1(1,itk),vtemp1d(1))
8893 call transpose2(AEA(1,1,2),atempd(1,1))
8894 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8895 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8897 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8898 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8900 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8901 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8902 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8910 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8911 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8913 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8914 & -0.5d0*ekont*(s2d+s12d)
8916 C Cartesian derivatives
8921 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8922 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8923 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8925 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8926 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8928 s2d = scalar2(b1(1,itk),vtemp1d(1))
8930 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8931 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8932 s8d = -(atempd(1,1)+atempd(2,2))*
8933 & scalar2(cc(1,1,itl),vtemp2(1))
8935 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8937 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8938 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8945 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8948 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8952 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8953 & - 0.5d0*(s8d+s12d)
8955 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8964 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8966 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8967 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8968 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8969 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8970 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8972 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8973 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8974 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8978 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8979 cd & 16*eel_turn6_num
8981 if (j.lt.nres-1) then
8988 if (l.lt.nres-1) then
8996 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8997 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8998 cgrad ghalf=0.5d0*ggg1(ll)
9000 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9001 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9002 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9003 & +ekont*derx_turn(ll,2,1)
9004 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9005 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9006 & +ekont*derx_turn(ll,4,1)
9007 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9008 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9009 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9010 cgrad ghalf=0.5d0*ggg2(ll)
9012 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9013 & +ekont*derx_turn(ll,2,2)
9014 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9015 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9016 & +ekont*derx_turn(ll,4,2)
9017 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9018 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9019 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9024 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9029 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9035 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9040 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9044 cd write (2,*) iii,g_corr6_loc(iii)
9046 eello_turn6=ekont*eel_turn6
9047 cd write (2,*) 'ekont',ekont
9048 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9052 C-----------------------------------------------------------------------------
9053 double precision function scalar(u,v)
9054 !DIR$ INLINEALWAYS scalar
9056 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9059 double precision u(3),v(3)
9060 cd double precision sc
9068 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9071 crc-------------------------------------------------
9072 SUBROUTINE MATVEC2(A1,V1,V2)
9073 !DIR$ INLINEALWAYS MATVEC2
9075 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9077 implicit real*8 (a-h,o-z)
9078 include 'DIMENSIONS'
9079 DIMENSION A1(2,2),V1(2),V2(2)
9083 c 3 VI=VI+A1(I,K)*V1(K)
9087 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9088 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9093 C---------------------------------------
9094 SUBROUTINE MATMAT2(A1,A2,A3)
9096 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9098 implicit real*8 (a-h,o-z)
9099 include 'DIMENSIONS'
9100 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9101 c DIMENSION AI3(2,2)
9105 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9111 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9112 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9113 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9114 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9122 c-------------------------------------------------------------------------
9123 double precision function scalar2(u,v)
9124 !DIR$ INLINEALWAYS scalar2
9126 double precision u(2),v(2)
9129 scalar2=u(1)*v(1)+u(2)*v(2)
9133 C-----------------------------------------------------------------------------
9135 subroutine transpose2(a,at)
9136 !DIR$ INLINEALWAYS transpose2
9138 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9141 double precision a(2,2),at(2,2)
9148 c--------------------------------------------------------------------------
9149 subroutine transpose(n,a,at)
9152 double precision a(n,n),at(n,n)
9160 C---------------------------------------------------------------------------
9161 subroutine prodmat3(a1,a2,kk,transp,prod)
9162 !DIR$ INLINEALWAYS prodmat3
9164 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9168 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9170 crc double precision auxmat(2,2),prod_(2,2)
9173 crc call transpose2(kk(1,1),auxmat(1,1))
9174 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9175 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9177 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9178 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9179 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9180 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9181 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9182 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9183 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9184 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9187 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9188 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9190 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9191 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9192 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9193 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9194 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9195 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9196 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9197 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9200 c call transpose2(a2(1,1),a2t(1,1))
9203 crc print *,((prod_(i,j),i=1,2),j=1,2)
9204 crc print *,((prod(i,j),i=1,2),j=1,2)