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
1140 itypi=iabs(itype(i))
1141 itypi1=iabs(itype(i+1))
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)
1154 itypj=iabs(itype(j))
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
1317 itypi=iabs(itype(i))
1318 itypi1=iabs(itype(i+1))
1323 C Calculate SC interaction energy.
1325 do iint=1,nint_gr(i)
1326 do j=istart(i,iint),iend(i,iint)
1327 itypj=iabs(itype(j))
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
1434 itypi=iabs(itype(i))
1435 itypi1=iabs(itype(i+1))
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)
1450 itypj=iabs(itype(j))
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
1570 itypi=iabs(itype(i))
1571 itypi1=iabs(itype(i+1))
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)
1588 itypj=iabs(itype(j))
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
1729 itypi=iabs(itype(i))
1730 itypi1=iabs(itype(i+1))
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)
1745 itypj=iabs(itype(j))
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
2049 itypi=iabs(itype(i))
2050 itypi1=iabs(itype(i+1))
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)
2061 itypj=iabs(itype(j))
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)
4062 itypj=iabs(itype(j))
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)
4156 itypj=iabs(itype(j))
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. iabs(itype(iii)).eq.1 .and. iabs(itype(jjj
4275 call ssbond_ene(iii,jjj,eij)
4277 cd write (iout,*) "eij",eij
4278 else if (ii.gt.nres .and. jj.gt.nres) then
4279 c Restraints from contact prediction
4281 if (dhpb1(i).gt.0.0d0) then
4282 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4283 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4284 c write (iout,*) "beta nmr",
4285 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4289 C Get the force constant corresponding to this distance.
4291 C Calculate the contribution to energy.
4292 ehpb=ehpb+waga*rdis*rdis
4293 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4295 C Evaluate gradient.
4300 ggg(j)=fac*(c(j,jj)-c(j,ii))
4303 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4304 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4307 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4308 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4311 C Calculate the distance between the two points and its difference from the
4314 if (dhpb1(i).gt.0.0d0) then
4315 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4316 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4317 c write (iout,*) "alph nmr",
4318 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4321 C Get the force constant corresponding to this distance.
4323 C Calculate the contribution to energy.
4324 ehpb=ehpb+waga*rdis*rdis
4325 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4327 C Evaluate gradient.
4331 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4332 cd & ' waga=',waga,' fac=',fac
4334 ggg(j)=fac*(c(j,jj)-c(j,ii))
4336 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4337 C If this is a SC-SC distance, we need to calculate the contributions to the
4338 C Cartesian gradient in the SC vectors (ghpbx).
4341 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4342 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4345 cgrad do j=iii,jjj-1
4347 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4351 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4352 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4359 C--------------------------------------------------------------------------
4360 subroutine ssbond_ene(i,j,eij)
4362 C Calculate the distance and angle dependent SS-bond potential energy
4363 C using a free-energy function derived based on RHF/6-31G** ab initio
4364 C calculations of diethyl disulfide.
4366 C A. Liwo and U. Kozlowska, 11/24/03
4368 implicit real*8 (a-h,o-z)
4369 include 'DIMENSIONS'
4370 include 'COMMON.SBRIDGE'
4371 include 'COMMON.CHAIN'
4372 include 'COMMON.DERIV'
4373 include 'COMMON.LOCAL'
4374 include 'COMMON.INTERACT'
4375 include 'COMMON.VAR'
4376 include 'COMMON.IOUNITS'
4377 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4378 itypi=iabs(itype(i))
4382 dxi=dc_norm(1,nres+i)
4383 dyi=dc_norm(2,nres+i)
4384 dzi=dc_norm(3,nres+i)
4385 c dsci_inv=dsc_inv(itypi)
4386 dsci_inv=vbld_inv(nres+i)
4387 itypj=iabs(itype(j))
4388 c dscj_inv=dsc_inv(itypj)
4389 dscj_inv=vbld_inv(nres+j)
4393 dxj=dc_norm(1,nres+j)
4394 dyj=dc_norm(2,nres+j)
4395 dzj=dc_norm(3,nres+j)
4396 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4401 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4402 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4403 om12=dxi*dxj+dyi*dyj+dzi*dzj
4405 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4406 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4412 deltat12=om2-om1+2.0d0
4414 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4415 & +akct*deltad*deltat12
4416 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4417 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4418 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4419 c & " deltat12",deltat12," eij",eij
4420 ed=2*akcm*deltad+akct*deltat12
4422 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4423 eom1=-2*akth*deltat1-pom1-om2*pom2
4424 eom2= 2*akth*deltat2+pom1-om1*pom2
4427 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4428 ghpbx(k,i)=ghpbx(k,i)-ggk
4429 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4430 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4431 ghpbx(k,j)=ghpbx(k,j)+ggk
4432 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4433 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4434 ghpbc(k,i)=ghpbc(k,i)-ggk
4435 ghpbc(k,j)=ghpbc(k,j)+ggk
4438 C Calculate the components of the gradient in DC and X
4442 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4447 C--------------------------------------------------------------------------
4448 subroutine ebond(estr)
4450 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4452 implicit real*8 (a-h,o-z)
4453 include 'DIMENSIONS'
4454 include 'COMMON.LOCAL'
4455 include 'COMMON.GEO'
4456 include 'COMMON.INTERACT'
4457 include 'COMMON.DERIV'
4458 include 'COMMON.VAR'
4459 include 'COMMON.CHAIN'
4460 include 'COMMON.IOUNITS'
4461 include 'COMMON.NAMES'
4462 include 'COMMON.FFIELD'
4463 include 'COMMON.CONTROL'
4464 include 'COMMON.SETUP'
4465 double precision u(3),ud(3)
4467 do i=ibondp_start,ibondp_end
4468 diff = vbld(i)-vbldp0
4469 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4472 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4474 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4478 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4480 do i=ibond_start,ibond_end
4485 diff=vbld(i+nres)-vbldsc0(1,iti)
4486 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4487 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4488 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4490 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4494 diff=vbld(i+nres)-vbldsc0(j,iti)
4495 ud(j)=aksc(j,iti)*diff
4496 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4510 uprod2=uprod2*u(k)*u(k)
4514 usumsqder=usumsqder+ud(j)*uprod2
4516 estr=estr+uprod/usum
4518 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4526 C--------------------------------------------------------------------------
4527 subroutine ebend(etheta)
4529 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4530 C angles gamma and its derivatives in consecutive thetas and gammas.
4532 implicit real*8 (a-h,o-z)
4533 include 'DIMENSIONS'
4534 include 'COMMON.LOCAL'
4535 include 'COMMON.GEO'
4536 include 'COMMON.INTERACT'
4537 include 'COMMON.DERIV'
4538 include 'COMMON.VAR'
4539 include 'COMMON.CHAIN'
4540 include 'COMMON.IOUNITS'
4541 include 'COMMON.NAMES'
4542 include 'COMMON.FFIELD'
4543 include 'COMMON.CONTROL'
4544 common /calcthet/ term1,term2,termm,diffak,ratak,
4545 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4546 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4547 double precision y(2),z(2)
4549 c time11=dexp(-2*time)
4552 c write (*,'(a,i2)') 'EBEND ICG=',icg
4553 do i=ithet_start,ithet_end
4554 C Zero the energy function and its derivative at 0 or pi.
4555 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4557 ichir1=isign(1,itype(i-2))
4558 ichir2=isign(1,itype(i))
4559 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4560 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4561 if (itype(i-1).eq.10) then
4562 itype1=isign(10,itype(i-2))
4563 ichir11=isign(1,itype(i-2))
4564 ichir12=isign(1,itype(i-2))
4565 itype2=isign(10,itype(i))
4566 ichir21=isign(1,itype(i))
4567 ichir22=isign(1,itype(i))
4572 if (phii.ne.phii) phii=150.0
4585 if (phii1.ne.phii1) phii1=150.0
4597 C Calculate the "mean" value of theta from the part of the distribution
4598 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4599 C In following comments this theta will be referred to as t_c.
4600 thet_pred_mean=0.0d0
4602 athetk=athet(k,it,ichir1,ichir2)
4603 bthetk=bthet(k,it,ichir1,ichir2)
4605 athetk=athet(k,itype1,ichir11,ichir12)
4606 bthetk=bthet(k,itype2,ichir21,ichir22)
4608 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4610 dthett=thet_pred_mean*ssd
4611 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4612 C Derivatives of the "mean" values in gamma1 and gamma2.
4613 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4614 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4615 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4616 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4618 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4619 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4620 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4621 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4623 if (theta(i).gt.pi-delta) then
4624 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4626 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4627 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4628 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4630 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4632 else if (theta(i).lt.delta) then
4633 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4634 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4635 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4637 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4638 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4641 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4644 etheta=etheta+ethetai
4645 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4647 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4648 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4649 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4651 C Ufff.... We've done all this!!!
4654 C---------------------------------------------------------------------------
4655 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4657 implicit real*8 (a-h,o-z)
4658 include 'DIMENSIONS'
4659 include 'COMMON.LOCAL'
4660 include 'COMMON.IOUNITS'
4661 common /calcthet/ term1,term2,termm,diffak,ratak,
4662 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4663 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4664 C Calculate the contributions to both Gaussian lobes.
4665 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4666 C The "polynomial part" of the "standard deviation" of this part of
4670 sig=sig*thet_pred_mean+polthet(j,it)
4672 C Derivative of the "interior part" of the "standard deviation of the"
4673 C gamma-dependent Gaussian lobe in t_c.
4674 sigtc=3*polthet(3,it)
4676 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4679 C Set the parameters of both Gaussian lobes of the distribution.
4680 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4681 fac=sig*sig+sigc0(it)
4684 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4685 sigsqtc=-4.0D0*sigcsq*sigtc
4686 c print *,i,sig,sigtc,sigsqtc
4687 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4688 sigtc=-sigtc/(fac*fac)
4689 C Following variable is sigma(t_c)**(-2)
4690 sigcsq=sigcsq*sigcsq
4692 sig0inv=1.0D0/sig0i**2
4693 delthec=thetai-thet_pred_mean
4694 delthe0=thetai-theta0i
4695 term1=-0.5D0*sigcsq*delthec*delthec
4696 term2=-0.5D0*sig0inv*delthe0*delthe0
4697 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4698 C NaNs in taking the logarithm. We extract the largest exponent which is added
4699 C to the energy (this being the log of the distribution) at the end of energy
4700 C term evaluation for this virtual-bond angle.
4701 if (term1.gt.term2) then
4703 term2=dexp(term2-termm)
4707 term1=dexp(term1-termm)
4710 C The ratio between the gamma-independent and gamma-dependent lobes of
4711 C the distribution is a Gaussian function of thet_pred_mean too.
4712 diffak=gthet(2,it)-thet_pred_mean
4713 ratak=diffak/gthet(3,it)**2
4714 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4715 C Let's differentiate it in thet_pred_mean NOW.
4717 C Now put together the distribution terms to make complete distribution.
4718 termexp=term1+ak*term2
4719 termpre=sigc+ak*sig0i
4720 C Contribution of the bending energy from this theta is just the -log of
4721 C the sum of the contributions from the two lobes and the pre-exponential
4722 C factor. Simple enough, isn't it?
4723 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4724 C NOW the derivatives!!!
4725 C 6/6/97 Take into account the deformation.
4726 E_theta=(delthec*sigcsq*term1
4727 & +ak*delthe0*sig0inv*term2)/termexp
4728 E_tc=((sigtc+aktc*sig0i)/termpre
4729 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4730 & aktc*term2)/termexp)
4733 c-----------------------------------------------------------------------------
4734 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4735 implicit real*8 (a-h,o-z)
4736 include 'DIMENSIONS'
4737 include 'COMMON.LOCAL'
4738 include 'COMMON.IOUNITS'
4739 common /calcthet/ term1,term2,termm,diffak,ratak,
4740 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4741 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4742 delthec=thetai-thet_pred_mean
4743 delthe0=thetai-theta0i
4744 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4745 t3 = thetai-thet_pred_mean
4749 t14 = t12+t6*sigsqtc
4751 t21 = thetai-theta0i
4757 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4758 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4759 & *(-t12*t9-ak*sig0inv*t27)
4763 C--------------------------------------------------------------------------
4764 subroutine ebend(etheta)
4766 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4767 C angles gamma and its derivatives in consecutive thetas and gammas.
4768 C ab initio-derived potentials from
4769 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4771 implicit real*8 (a-h,o-z)
4772 include 'DIMENSIONS'
4773 include 'COMMON.LOCAL'
4774 include 'COMMON.GEO'
4775 include 'COMMON.INTERACT'
4776 include 'COMMON.DERIV'
4777 include 'COMMON.VAR'
4778 include 'COMMON.CHAIN'
4779 include 'COMMON.IOUNITS'
4780 include 'COMMON.NAMES'
4781 include 'COMMON.FFIELD'
4782 include 'COMMON.CONTROL'
4783 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4784 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4785 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4786 & sinph1ph2(maxdouble,maxdouble)
4787 logical lprn /.false./, lprn1 /.false./
4789 do i=ithet_start,ithet_end
4793 theti2=0.5d0*theta(i)
4794 ityp2=ithetyp(iabs(itype(i-1)))
4796 coskt(k)=dcos(k*theti2)
4797 sinkt(k)=dsin(k*theti2)
4802 if (phii.ne.phii) phii=150.0
4806 ityp1=ithetyp(iabs(itype(i-2)))
4808 cosph1(k)=dcos(k*phii)
4809 sinph1(k)=dsin(k*phii)
4822 if (phii1.ne.phii1) phii1=150.0
4827 ityp3=ithetyp(iabs(itype(i)))
4829 cosph2(k)=dcos(k*phii1)
4830 sinph2(k)=dsin(k*phii1)
4840 ethetai=aa0thet(ityp1,ityp2,ityp3)
4843 ccl=cosph1(l)*cosph2(k-l)
4844 ssl=sinph1(l)*sinph2(k-l)
4845 scl=sinph1(l)*cosph2(k-l)
4846 csl=cosph1(l)*sinph2(k-l)
4847 cosph1ph2(l,k)=ccl-ssl
4848 cosph1ph2(k,l)=ccl+ssl
4849 sinph1ph2(l,k)=scl+csl
4850 sinph1ph2(k,l)=scl-csl
4854 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4855 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4856 write (iout,*) "coskt and sinkt"
4858 write (iout,*) k,coskt(k),sinkt(k)
4862 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4863 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4866 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4867 & " ethetai",ethetai
4870 write (iout,*) "cosph and sinph"
4872 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4874 write (iout,*) "cosph1ph2 and sinph2ph2"
4877 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4878 & sinph1ph2(l,k),sinph1ph2(k,l)
4881 write(iout,*) "ethetai",ethetai
4885 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4886 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4887 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4888 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4889 ethetai=ethetai+sinkt(m)*aux
4890 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4891 dephii=dephii+k*sinkt(m)*(
4892 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4893 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4894 dephii1=dephii1+k*sinkt(m)*(
4895 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4896 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4898 & write (iout,*) "m",m," k",k," bbthet",
4899 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4900 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4901 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4902 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4906 & write(iout,*) "ethetai",ethetai
4910 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4911 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4912 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4913 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4914 ethetai=ethetai+sinkt(m)*aux
4915 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4916 dephii=dephii+l*sinkt(m)*(
4917 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4918 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4919 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4920 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4921 dephii1=dephii1+(k-l)*sinkt(m)*(
4922 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4923 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4924 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4925 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4927 write (iout,*) "m",m," k",k," l",l," ffthet",
4928 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4929 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4930 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4931 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4932 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4933 & cosph1ph2(k,l)*sinkt(m),
4934 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4940 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4941 & i,theta(i)*rad2deg,phii*rad2deg,
4942 & phii1*rad2deg,ethetai
4943 etheta=etheta+ethetai
4944 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4945 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4946 gloc(nphi+i-2,icg)=wang*dethetai
4952 c-----------------------------------------------------------------------------
4953 subroutine esc(escloc)
4954 C Calculate the local energy of a side chain and its derivatives in the
4955 C corresponding virtual-bond valence angles THETA and the spherical angles
4957 implicit real*8 (a-h,o-z)
4958 include 'DIMENSIONS'
4959 include 'COMMON.GEO'
4960 include 'COMMON.LOCAL'
4961 include 'COMMON.VAR'
4962 include 'COMMON.INTERACT'
4963 include 'COMMON.DERIV'
4964 include 'COMMON.CHAIN'
4965 include 'COMMON.IOUNITS'
4966 include 'COMMON.NAMES'
4967 include 'COMMON.FFIELD'
4968 include 'COMMON.CONTROL'
4969 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4970 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4971 common /sccalc/ time11,time12,time112,theti,it,nlobit
4974 c write (iout,'(a)') 'ESC'
4975 do i=loc_start,loc_end
4977 if (it.eq.10) goto 1
4978 nlobit=nlob(iabs(it))
4979 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4980 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4981 theti=theta(i+1)-pipol
4986 if (x(2).gt.pi-delta) then
4990 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4992 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4993 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4995 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4996 & ddersc0(1),dersc(1))
4997 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4998 & ddersc0(3),dersc(3))
5000 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5002 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5003 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5004 & dersc0(2),esclocbi,dersc02)
5005 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5007 call splinthet(x(2),0.5d0*delta,ss,ssd)
5012 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5014 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5015 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5017 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5019 c write (iout,*) escloci
5020 else if (x(2).lt.delta) then
5024 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5026 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5027 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5029 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5030 & ddersc0(1),dersc(1))
5031 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5032 & ddersc0(3),dersc(3))
5034 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5036 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5037 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5038 & dersc0(2),esclocbi,dersc02)
5039 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5044 call splinthet(x(2),0.5d0*delta,ss,ssd)
5046 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5048 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5049 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5051 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5052 c write (iout,*) escloci
5054 call enesc(x,escloci,dersc,ddummy,.false.)
5057 escloc=escloc+escloci
5058 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5059 & 'escloc',i,escloci
5060 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5062 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5064 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5065 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5070 C---------------------------------------------------------------------------
5071 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5072 implicit real*8 (a-h,o-z)
5073 include 'DIMENSIONS'
5074 include 'COMMON.GEO'
5075 include 'COMMON.LOCAL'
5076 include 'COMMON.IOUNITS'
5077 common /sccalc/ time11,time12,time112,theti,it,nlobit
5078 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5079 double precision contr(maxlob,-1:1)
5081 c write (iout,*) 'it=',it,' nlobit=',nlobit
5085 if (mixed) ddersc(j)=0.0d0
5089 C Because of periodicity of the dependence of the SC energy in omega we have
5090 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5091 C To avoid underflows, first compute & store the exponents.
5099 z(k)=x(k)-censc(k,j,it)
5104 Axk=Axk+gaussc(l,k,j,it)*z(l)
5110 expfac=expfac+Ax(k,j,iii)*z(k)
5118 C As in the case of ebend, we want to avoid underflows in exponentiation and
5119 C subsequent NaNs and INFs in energy calculation.
5120 C Find the largest exponent
5124 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5128 cd print *,'it=',it,' emin=',emin
5130 C Compute the contribution to SC energy and derivatives
5135 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5136 if(adexp.ne.adexp) adexp=1.0
5139 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5141 cd print *,'j=',j,' expfac=',expfac
5142 escloc_i=escloc_i+expfac
5144 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5148 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5149 & +gaussc(k,2,j,it))*expfac
5156 dersc(1)=dersc(1)/cos(theti)**2
5157 ddersc(1)=ddersc(1)/cos(theti)**2
5160 escloci=-(dlog(escloc_i)-emin)
5162 dersc(j)=dersc(j)/escloc_i
5166 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5171 C------------------------------------------------------------------------------
5172 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5173 implicit real*8 (a-h,o-z)
5174 include 'DIMENSIONS'
5175 include 'COMMON.GEO'
5176 include 'COMMON.LOCAL'
5177 include 'COMMON.IOUNITS'
5178 common /sccalc/ time11,time12,time112,theti,it,nlobit
5179 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5180 double precision contr(maxlob)
5191 z(k)=x(k)-censc(k,j,it)
5197 Axk=Axk+gaussc(l,k,j,it)*z(l)
5203 expfac=expfac+Ax(k,j)*z(k)
5208 C As in the case of ebend, we want to avoid underflows in exponentiation and
5209 C subsequent NaNs and INFs in energy calculation.
5210 C Find the largest exponent
5213 if (emin.gt.contr(j)) emin=contr(j)
5217 C Compute the contribution to SC energy and derivatives
5221 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5222 escloc_i=escloc_i+expfac
5224 dersc(k)=dersc(k)+Ax(k,j)*expfac
5226 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5227 & +gaussc(1,2,j,it))*expfac
5231 dersc(1)=dersc(1)/cos(theti)**2
5232 dersc12=dersc12/cos(theti)**2
5233 escloci=-(dlog(escloc_i)-emin)
5235 dersc(j)=dersc(j)/escloc_i
5237 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5241 c----------------------------------------------------------------------------------
5242 subroutine esc(escloc)
5243 C Calculate the local energy of a side chain and its derivatives in the
5244 C corresponding virtual-bond valence angles THETA and the spherical angles
5245 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5246 C added by Urszula Kozlowska. 07/11/2007
5248 implicit real*8 (a-h,o-z)
5249 include 'DIMENSIONS'
5250 include 'COMMON.GEO'
5251 include 'COMMON.LOCAL'
5252 include 'COMMON.VAR'
5253 include 'COMMON.SCROT'
5254 include 'COMMON.INTERACT'
5255 include 'COMMON.DERIV'
5256 include 'COMMON.CHAIN'
5257 include 'COMMON.IOUNITS'
5258 include 'COMMON.NAMES'
5259 include 'COMMON.FFIELD'
5260 include 'COMMON.CONTROL'
5261 include 'COMMON.VECTORS'
5262 double precision x_prime(3),y_prime(3),z_prime(3)
5263 & , sumene,dsc_i,dp2_i,x(65),
5264 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5265 & de_dxx,de_dyy,de_dzz,de_dt
5266 double precision s1_t,s1_6_t,s2_t,s2_6_t
5268 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5269 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5270 & dt_dCi(3),dt_dCi1(3)
5271 common /sccalc/ time11,time12,time112,theti,it,nlobit
5274 do i=loc_start,loc_end
5275 costtab(i+1) =dcos(theta(i+1))
5276 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5277 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5278 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5279 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5280 cosfac=dsqrt(cosfac2)
5281 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5282 sinfac=dsqrt(sinfac2)
5284 if (it.eq.10) goto 1
5286 C Compute the axes of tghe local cartesian coordinates system; store in
5287 c x_prime, y_prime and z_prime
5294 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5295 C & dc_norm(3,i+nres)
5297 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5298 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5301 z_prime(j) = -uz(j,i-1)
5304 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5305 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5306 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5307 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5308 c & " xy",scalar(x_prime(1),y_prime(1)),
5309 c & " xz",scalar(x_prime(1),z_prime(1)),
5310 c & " yy",scalar(y_prime(1),y_prime(1)),
5311 c & " yz",scalar(y_prime(1),z_prime(1)),
5312 c & " zz",scalar(z_prime(1),z_prime(1))
5314 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5315 C to local coordinate system. Store in xx, yy, zz.
5321 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5322 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5323 zz = zz + dsign(1.0,dfloat(itype(i)))
5324 & *z_prime(j)*dc_norm(j,i+nres)
5331 C Compute the energy of the ith side cbain
5333 c write (2,*) "xx",xx," yy",yy," zz",zz
5336 x(j) = sc_parmin(j,it)
5339 Cc diagnostics - remove later
5341 yy1 = dsin(alph(2))*dcos(omeg(2))
5342 zz1 = -dsign(1.0, dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5343 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5344 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5346 C," --- ", xx_w,yy_w,zz_w
5349 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5350 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5352 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5353 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5355 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5356 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5357 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5358 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5359 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5361 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5362 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5363 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5364 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5365 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5367 dsc_i = 0.743d0+x(61)
5369 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5370 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5371 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5372 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5373 s1=(1+x(63))/(0.1d0 + dscp1)
5374 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5375 s2=(1+x(65))/(0.1d0 + dscp2)
5376 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5377 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5378 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5379 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5381 c & dscp1,dscp2,sumene
5382 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5383 escloc = escloc + sumene
5384 c write (2,*) "i",i," escloc",sumene,escloc
5387 C This section to check the numerical derivatives of the energy of ith side
5388 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5389 C #define DEBUG in the code to turn it on.
5391 write (2,*) "sumene =",sumene
5395 write (2,*) xx,yy,zz
5396 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5397 de_dxx_num=(sumenep-sumene)/aincr
5399 write (2,*) "xx+ sumene from enesc=",sumenep
5402 write (2,*) xx,yy,zz
5403 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5404 de_dyy_num=(sumenep-sumene)/aincr
5406 write (2,*) "yy+ sumene from enesc=",sumenep
5409 write (2,*) xx,yy,zz
5410 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5411 de_dzz_num=(sumenep-sumene)/aincr
5413 write (2,*) "zz+ sumene from enesc=",sumenep
5414 costsave=cost2tab(i+1)
5415 sintsave=sint2tab(i+1)
5416 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5417 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5418 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5419 de_dt_num=(sumenep-sumene)/aincr
5420 write (2,*) " t+ sumene from enesc=",sumenep
5421 cost2tab(i+1)=costsave
5422 sint2tab(i+1)=sintsave
5423 C End of diagnostics section.
5426 C Compute the gradient of esc
5428 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5429 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5430 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5431 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5432 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5433 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5434 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5435 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5436 pom1=(sumene3*sint2tab(i+1)+sumene1)
5437 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5438 pom2=(sumene4*cost2tab(i+1)+sumene2)
5439 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5440 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5441 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5442 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5444 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5445 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5446 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5448 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5449 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5450 & +(pom1+pom2)*pom_dx
5452 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5455 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5456 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5457 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5459 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5460 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5461 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5462 & +x(59)*zz**2 +x(60)*xx*zz
5463 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5464 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5465 & +(pom1-pom2)*pom_dy
5467 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5470 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5471 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5472 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5473 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5474 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5475 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5476 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5477 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5479 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5482 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5483 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5484 & +pom1*pom_dt1+pom2*pom_dt2
5486 write(2,*), "de_dt = ", de_dt,de_dt_num
5490 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5491 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5492 cosfac2xx=cosfac2*xx
5493 sinfac2yy=sinfac2*yy
5495 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5497 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5499 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5500 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5501 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5502 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5503 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5504 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5505 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5506 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5507 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5508 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5512 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5513 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5516 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5517 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5518 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5520 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5521 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5525 dXX_Ctab(k,i)=dXX_Ci(k)
5526 dXX_C1tab(k,i)=dXX_Ci1(k)
5527 dYY_Ctab(k,i)=dYY_Ci(k)
5528 dYY_C1tab(k,i)=dYY_Ci1(k)
5529 dZZ_Ctab(k,i)=dZZ_Ci(k)
5530 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5531 dXX_XYZtab(k,i)=dXX_XYZ(k)
5532 dYY_XYZtab(k,i)=dYY_XYZ(k)
5533 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5537 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5538 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5539 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5540 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5541 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5543 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5544 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5545 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5546 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5547 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5548 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5549 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5550 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5552 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5553 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5555 C to check gradient call subroutine check_grad
5561 c------------------------------------------------------------------------------
5562 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5564 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5565 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5566 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5567 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5569 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5570 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5572 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5573 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5574 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5575 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5576 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5578 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5579 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5580 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5581 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5582 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5584 dsc_i = 0.743d0+x(61)
5586 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5587 & *(xx*cost2+yy*sint2))
5588 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5589 & *(xx*cost2-yy*sint2))
5590 s1=(1+x(63))/(0.1d0 + dscp1)
5591 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5592 s2=(1+x(65))/(0.1d0 + dscp2)
5593 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5594 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5595 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5600 c------------------------------------------------------------------------------
5601 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5603 C This procedure calculates two-body contact function g(rij) and its derivative:
5606 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5609 C where x=(rij-r0ij)/delta
5611 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5614 double precision rij,r0ij,eps0ij,fcont,fprimcont
5615 double precision x,x2,x4,delta
5619 if (x.lt.-1.0D0) then
5622 else if (x.le.1.0D0) then
5625 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5626 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5633 c------------------------------------------------------------------------------
5634 subroutine splinthet(theti,delta,ss,ssder)
5635 implicit real*8 (a-h,o-z)
5636 include 'DIMENSIONS'
5637 include 'COMMON.VAR'
5638 include 'COMMON.GEO'
5641 if (theti.gt.pipol) then
5642 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5644 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5649 c------------------------------------------------------------------------------
5650 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5652 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5653 double precision ksi,ksi2,ksi3,a1,a2,a3
5654 a1=fprim0*delta/(f1-f0)
5660 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5661 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5664 c------------------------------------------------------------------------------
5665 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5667 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5668 double precision ksi,ksi2,ksi3,a1,a2,a3
5673 a2=3*(f1x-f0x)-2*fprim0x*delta
5674 a3=fprim0x*delta-2*(f1x-f0x)
5675 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5678 C-----------------------------------------------------------------------------
5680 C-----------------------------------------------------------------------------
5681 subroutine etor(etors,edihcnstr)
5682 implicit real*8 (a-h,o-z)
5683 include 'DIMENSIONS'
5684 include 'COMMON.VAR'
5685 include 'COMMON.GEO'
5686 include 'COMMON.LOCAL'
5687 include 'COMMON.TORSION'
5688 include 'COMMON.INTERACT'
5689 include 'COMMON.DERIV'
5690 include 'COMMON.CHAIN'
5691 include 'COMMON.NAMES'
5692 include 'COMMON.IOUNITS'
5693 include 'COMMON.FFIELD'
5694 include 'COMMON.TORCNSTR'
5695 include 'COMMON.CONTROL'
5697 C Set lprn=.true. for debugging
5701 do i=iphi_start,iphi_end
5703 itori=itortyp(itype(i-2))
5704 itori1=itortyp(itype(i-1))
5707 C Proline-Proline pair is a special case...
5708 if (itori.eq.3 .and. itori1.eq.3) then
5709 if (phii.gt.-dwapi3) then
5711 fac=1.0D0/(1.0D0-cosphi)
5712 etorsi=v1(1,3,3)*fac
5713 etorsi=etorsi+etorsi
5714 etors=etors+etorsi-v1(1,3,3)
5715 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5716 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5719 v1ij=v1(j+1,itori,itori1)
5720 v2ij=v2(j+1,itori,itori1)
5723 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5724 if (energy_dec) etors_ii=etors_ii+
5725 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5726 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5730 v1ij=v1(j,itori,itori1)
5731 v2ij=v2(j,itori,itori1)
5734 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5735 if (energy_dec) etors_ii=etors_ii+
5736 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5737 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5740 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5743 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5744 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5745 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5746 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5747 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5749 ! 6/20/98 - dihedral angle constraints
5752 itori=idih_constr(i)
5755 if (difi.gt.drange(i)) then
5757 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5758 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5759 else if (difi.lt.-drange(i)) then
5761 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5762 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5764 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5765 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5767 ! write (iout,*) 'edihcnstr',edihcnstr
5770 c------------------------------------------------------------------------------
5771 subroutine etor_d(etors_d)
5775 c----------------------------------------------------------------------------
5777 subroutine etor(etors,edihcnstr)
5778 implicit real*8 (a-h,o-z)
5779 include 'DIMENSIONS'
5780 include 'COMMON.VAR'
5781 include 'COMMON.GEO'
5782 include 'COMMON.LOCAL'
5783 include 'COMMON.TORSION'
5784 include 'COMMON.INTERACT'
5785 include 'COMMON.DERIV'
5786 include 'COMMON.CHAIN'
5787 include 'COMMON.NAMES'
5788 include 'COMMON.IOUNITS'
5789 include 'COMMON.FFIELD'
5790 include 'COMMON.TORCNSTR'
5791 include 'COMMON.CONTROL'
5793 C Set lprn=.true. for debugging
5797 do i=iphi_start,iphi_end
5799 itori=itortyp(itype(i-2))
5800 itori1=itortyp(itype(i-1))
5801 if (iabs(itype(i)).eq.20) then
5808 C Regular cosine and sine terms
5809 do j=1,nterm(itori,itori1,iblock)
5810 v1ij=v1(j,itori,itori1,iblock)
5811 v2ij=v2(j,itori,itori1,iblock)
5814 etors=etors+v1ij*cosphi+v2ij*sinphi
5815 if (energy_dec) etors_ii=etors_ii+
5816 & v1ij*cosphi+v2ij*sinphi
5817 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5821 C E = SUM ----------------------------------- - v1
5822 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5824 cosphi=dcos(0.5d0*phii)
5825 sinphi=dsin(0.5d0*phii)
5826 do j=1,nlor(itori,itori1,iblock)
5827 vl1ij=vlor1(j,itori,itori1)
5828 vl2ij=vlor2(j,itori,itori1)
5829 vl3ij=vlor3(j,itori,itori1)
5830 pom=vl2ij*cosphi+vl3ij*sinphi
5831 pom1=1.0d0/(pom*pom+1.0d0)
5832 etors=etors+vl1ij*pom1
5833 if (energy_dec) etors_ii=etors_ii+
5836 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5838 C Subtract the constant term
5839 etors=etors-v0(itori,itori1,iblock)
5840 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5841 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5843 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5844 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5845 & (v1(j,itori,itori1,iblock),j=1,6),
5846 & (v2(j,itori,itori1,iblock),j=1,6)
5847 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5848 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5850 ! 6/20/98 - dihedral angle constraints
5852 c do i=1,ndih_constr
5853 do i=idihconstr_start,idihconstr_end
5854 itori=idih_constr(i)
5856 difi=pinorm(phii-phi0(i))
5857 if (difi.gt.drange(i)) then
5859 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5860 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5861 else if (difi.lt.-drange(i)) then
5863 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5864 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5868 c write (iout,*) "gloci", gloc(i-3,icg)
5869 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5870 cd & rad2deg*phi0(i), rad2deg*drange(i),
5871 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5873 cd write (iout,*) 'edihcnstr',edihcnstr
5876 c----------------------------------------------------------------------------
5877 subroutine etor_d(etors_d)
5878 C 6/23/01 Compute double torsional energy
5879 implicit real*8 (a-h,o-z)
5880 include 'DIMENSIONS'
5881 include 'COMMON.VAR'
5882 include 'COMMON.GEO'
5883 include 'COMMON.LOCAL'
5884 include 'COMMON.TORSION'
5885 include 'COMMON.INTERACT'
5886 include 'COMMON.DERIV'
5887 include 'COMMON.CHAIN'
5888 include 'COMMON.NAMES'
5889 include 'COMMON.IOUNITS'
5890 include 'COMMON.FFIELD'
5891 include 'COMMON.TORCNSTR'
5893 C Set lprn=.true. for debugging
5897 do i=iphid_start,iphid_end
5898 itori=itortyp(itype(i-2))
5899 itori1=itortyp(itype(i-1))
5900 itori2=itortyp(itype(i))
5902 if (iabs(itype(i+1)).eq.20) iblock=2
5907 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5908 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5909 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5910 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5911 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5912 cosphi1=dcos(j*phii)
5913 sinphi1=dsin(j*phii)
5914 cosphi2=dcos(j*phii1)
5915 sinphi2=dsin(j*phii1)
5916 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5917 & v2cij*cosphi2+v2sij*sinphi2
5918 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5919 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5921 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5923 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5924 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5925 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5926 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5927 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5928 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5929 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5930 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5931 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5932 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5933 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5934 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5935 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5936 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5939 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5940 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5941 c write (iout,*) "gloci", gloc(i-3,icg)
5946 c------------------------------------------------------------------------------
5947 subroutine eback_sc_corr(esccor)
5948 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5949 c conformational states; temporarily implemented as differences
5950 c between UNRES torsional potentials (dependent on three types of
5951 c residues) and the torsional potentials dependent on all 20 types
5952 c of residues computed from AM1 energy surfaces of terminally-blocked
5953 c amino-acid residues.
5954 implicit real*8 (a-h,o-z)
5955 include 'DIMENSIONS'
5956 include 'COMMON.VAR'
5957 include 'COMMON.GEO'
5958 include 'COMMON.LOCAL'
5959 include 'COMMON.TORSION'
5960 include 'COMMON.SCCOR'
5961 include 'COMMON.INTERACT'
5962 include 'COMMON.DERIV'
5963 include 'COMMON.CHAIN'
5964 include 'COMMON.NAMES'
5965 include 'COMMON.IOUNITS'
5966 include 'COMMON.FFIELD'
5967 include 'COMMON.CONTROL'
5969 C Set lprn=.true. for debugging
5972 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5974 do i=itau_start,itau_end
5976 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5977 isccori=isccortyp(itype(i-2))
5978 isccori1=isccortyp(itype(i-1))
5980 cccc Added 9 May 2012
5981 cc Tauangle is torsional engle depending on the value of first digit
5982 c(see comment below)
5983 cc Omicron is flat angle depending on the value of first digit
5984 c(see comment below)
5987 do intertyp=1,3 !intertyp
5988 cc Added 09 May 2012 (Adasko)
5989 cc Intertyp means interaction type of backbone mainchain correlation:
5990 c 1 = SC...Ca...Ca...Ca
5991 c 2 = Ca...Ca...Ca...SC
5992 c 3 = SC...Ca...Ca...SCi
5994 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5995 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5996 & (itype(i-1).eq.ntyp1)))
5997 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5998 & .or.(itype(i-2).eq.ntyp1)))
5999 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6000 & (itype(i-1).eq.ntyp1)))) cycle
6001 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6002 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6004 do j=1,nterm_sccor(isccori,isccori1)
6005 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6006 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6007 cosphi=dcos(j*tauangle(intertyp,i))
6008 sinphi=dsin(j*tauangle(intertyp,i))
6009 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6010 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6012 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6013 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6014 c &gloc_sc(intertyp,i-3,icg)
6016 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6017 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6018 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6019 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6020 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6024 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6028 c----------------------------------------------------------------------------
6029 subroutine multibody(ecorr)
6030 C This subroutine calculates multi-body contributions to energy following
6031 C the idea of Skolnick et al. If side chains I and J make a contact and
6032 C at the same time side chains I+1 and J+1 make a contact, an extra
6033 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6034 implicit real*8 (a-h,o-z)
6035 include 'DIMENSIONS'
6036 include 'COMMON.IOUNITS'
6037 include 'COMMON.DERIV'
6038 include 'COMMON.INTERACT'
6039 include 'COMMON.CONTACTS'
6040 double precision gx(3),gx1(3)
6043 C Set lprn=.true. for debugging
6047 write (iout,'(a)') 'Contact function values:'
6049 write (iout,'(i2,20(1x,i2,f10.5))')
6050 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6065 num_conti=num_cont(i)
6066 num_conti1=num_cont(i1)
6071 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6072 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6073 cd & ' ishift=',ishift
6074 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6075 C The system gains extra energy.
6076 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6077 endif ! j1==j+-ishift
6086 c------------------------------------------------------------------------------
6087 double precision function esccorr(i,j,k,l,jj,kk)
6088 implicit real*8 (a-h,o-z)
6089 include 'DIMENSIONS'
6090 include 'COMMON.IOUNITS'
6091 include 'COMMON.DERIV'
6092 include 'COMMON.INTERACT'
6093 include 'COMMON.CONTACTS'
6094 double precision gx(3),gx1(3)
6099 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6100 C Calculate the multi-body contribution to energy.
6101 C Calculate multi-body contributions to the gradient.
6102 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6103 cd & k,l,(gacont(m,kk,k),m=1,3)
6105 gx(m) =ekl*gacont(m,jj,i)
6106 gx1(m)=eij*gacont(m,kk,k)
6107 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6108 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6109 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6110 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6114 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6119 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6125 c------------------------------------------------------------------------------
6126 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6127 C This subroutine calculates multi-body contributions to hydrogen-bonding
6128 implicit real*8 (a-h,o-z)
6129 include 'DIMENSIONS'
6130 include 'COMMON.IOUNITS'
6133 parameter (max_cont=maxconts)
6134 parameter (max_dim=26)
6135 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6136 double precision zapas(max_dim,maxconts,max_fg_procs),
6137 & zapas_recv(max_dim,maxconts,max_fg_procs)
6138 common /przechowalnia/ zapas
6139 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6140 & status_array(MPI_STATUS_SIZE,maxconts*2)
6142 include 'COMMON.SETUP'
6143 include 'COMMON.FFIELD'
6144 include 'COMMON.DERIV'
6145 include 'COMMON.INTERACT'
6146 include 'COMMON.CONTACTS'
6147 include 'COMMON.CONTROL'
6148 include 'COMMON.LOCAL'
6149 double precision gx(3),gx1(3),time00
6152 C Set lprn=.true. for debugging
6157 if (nfgtasks.le.1) goto 30
6159 write (iout,'(a)') 'Contact function values before RECEIVE:'
6161 write (iout,'(2i3,50(1x,i2,f5.2))')
6162 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6163 & j=1,num_cont_hb(i))
6167 do i=1,ntask_cont_from
6170 do i=1,ntask_cont_to
6173 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6175 C Make the list of contacts to send to send to other procesors
6176 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6178 do i=iturn3_start,iturn3_end
6179 c write (iout,*) "make contact list turn3",i," num_cont",
6181 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6183 do i=iturn4_start,iturn4_end
6184 c write (iout,*) "make contact list turn4",i," num_cont",
6186 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6190 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6192 do j=1,num_cont_hb(i)
6195 iproc=iint_sent_local(k,jjc,ii)
6196 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6197 if (iproc.gt.0) then
6198 ncont_sent(iproc)=ncont_sent(iproc)+1
6199 nn=ncont_sent(iproc)
6201 zapas(2,nn,iproc)=jjc
6202 zapas(3,nn,iproc)=facont_hb(j,i)
6203 zapas(4,nn,iproc)=ees0p(j,i)
6204 zapas(5,nn,iproc)=ees0m(j,i)
6205 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6206 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6207 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6208 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6209 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6210 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6211 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6212 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6213 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6214 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6215 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6216 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6217 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6218 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6219 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6220 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6221 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6222 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6223 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6224 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6225 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6232 & "Numbers of contacts to be sent to other processors",
6233 & (ncont_sent(i),i=1,ntask_cont_to)
6234 write (iout,*) "Contacts sent"
6235 do ii=1,ntask_cont_to
6237 iproc=itask_cont_to(ii)
6238 write (iout,*) nn," contacts to processor",iproc,
6239 & " of CONT_TO_COMM group"
6241 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6249 CorrelID1=nfgtasks+fg_rank+1
6251 C Receive the numbers of needed contacts from other processors
6252 do ii=1,ntask_cont_from
6253 iproc=itask_cont_from(ii)
6255 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6256 & FG_COMM,req(ireq),IERR)
6258 c write (iout,*) "IRECV ended"
6260 C Send the number of contacts needed by other processors
6261 do ii=1,ntask_cont_to
6262 iproc=itask_cont_to(ii)
6264 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6265 & FG_COMM,req(ireq),IERR)
6267 c write (iout,*) "ISEND ended"
6268 c write (iout,*) "number of requests (nn)",ireq
6271 & call MPI_Waitall(ireq,req,status_array,ierr)
6273 c & "Numbers of contacts to be received from other processors",
6274 c & (ncont_recv(i),i=1,ntask_cont_from)
6278 do ii=1,ntask_cont_from
6279 iproc=itask_cont_from(ii)
6281 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6282 c & " of CONT_TO_COMM group"
6286 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6287 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6288 c write (iout,*) "ireq,req",ireq,req(ireq)
6291 C Send the contacts to processors that need them
6292 do ii=1,ntask_cont_to
6293 iproc=itask_cont_to(ii)
6295 c write (iout,*) nn," contacts to processor",iproc,
6296 c & " of CONT_TO_COMM group"
6299 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6300 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6301 c write (iout,*) "ireq,req",ireq,req(ireq)
6303 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6307 c write (iout,*) "number of requests (contacts)",ireq
6308 c write (iout,*) "req",(req(i),i=1,4)
6311 & call MPI_Waitall(ireq,req,status_array,ierr)
6312 do iii=1,ntask_cont_from
6313 iproc=itask_cont_from(iii)
6316 write (iout,*) "Received",nn," contacts from processor",iproc,
6317 & " of CONT_FROM_COMM group"
6320 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6325 ii=zapas_recv(1,i,iii)
6326 c Flag the received contacts to prevent double-counting
6327 jj=-zapas_recv(2,i,iii)
6328 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6330 nnn=num_cont_hb(ii)+1
6333 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6334 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6335 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6336 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6337 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6338 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6339 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6340 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6341 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6342 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6343 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6344 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6345 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6346 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6347 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6348 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6349 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6350 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6351 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6352 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6353 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6354 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6355 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6356 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6361 write (iout,'(a)') 'Contact function values after receive:'
6363 write (iout,'(2i3,50(1x,i3,f5.2))')
6364 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6365 & j=1,num_cont_hb(i))
6372 write (iout,'(a)') 'Contact function values:'
6374 write (iout,'(2i3,50(1x,i3,f5.2))')
6375 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6376 & j=1,num_cont_hb(i))
6380 C Remove the loop below after debugging !!!
6387 C Calculate the local-electrostatic correlation terms
6388 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6390 num_conti=num_cont_hb(i)
6391 num_conti1=num_cont_hb(i+1)
6398 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6399 c & ' jj=',jj,' kk=',kk
6400 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6401 & .or. j.lt.0 .and. j1.gt.0) .and.
6402 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6403 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6404 C The system gains extra energy.
6405 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6406 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6407 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6409 else if (j1.eq.j) then
6410 C Contacts I-J and I-(J+1) occur simultaneously.
6411 C The system loses extra energy.
6412 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6417 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6418 c & ' jj=',jj,' kk=',kk
6420 C Contacts I-J and (I+1)-J occur simultaneously.
6421 C The system loses extra energy.
6422 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6429 c------------------------------------------------------------------------------
6430 subroutine add_hb_contact(ii,jj,itask)
6431 implicit real*8 (a-h,o-z)
6432 include "DIMENSIONS"
6433 include "COMMON.IOUNITS"
6436 parameter (max_cont=maxconts)
6437 parameter (max_dim=26)
6438 include "COMMON.CONTACTS"
6439 double precision zapas(max_dim,maxconts,max_fg_procs),
6440 & zapas_recv(max_dim,maxconts,max_fg_procs)
6441 common /przechowalnia/ zapas
6442 integer i,j,ii,jj,iproc,itask(4),nn
6443 c write (iout,*) "itask",itask
6446 if (iproc.gt.0) then
6447 do j=1,num_cont_hb(ii)
6449 c write (iout,*) "i",ii," j",jj," jjc",jjc
6451 ncont_sent(iproc)=ncont_sent(iproc)+1
6452 nn=ncont_sent(iproc)
6453 zapas(1,nn,iproc)=ii
6454 zapas(2,nn,iproc)=jjc
6455 zapas(3,nn,iproc)=facont_hb(j,ii)
6456 zapas(4,nn,iproc)=ees0p(j,ii)
6457 zapas(5,nn,iproc)=ees0m(j,ii)
6458 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6459 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6460 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6461 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6462 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6463 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6464 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6465 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6466 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6467 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6468 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6469 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6470 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6471 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6472 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6473 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6474 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6475 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6476 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6477 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6478 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6486 c------------------------------------------------------------------------------
6487 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6489 C This subroutine calculates multi-body contributions to hydrogen-bonding
6490 implicit real*8 (a-h,o-z)
6491 include 'DIMENSIONS'
6492 include 'COMMON.IOUNITS'
6495 parameter (max_cont=maxconts)
6496 parameter (max_dim=70)
6497 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6498 double precision zapas(max_dim,maxconts,max_fg_procs),
6499 & zapas_recv(max_dim,maxconts,max_fg_procs)
6500 common /przechowalnia/ zapas
6501 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6502 & status_array(MPI_STATUS_SIZE,maxconts*2)
6504 include 'COMMON.SETUP'
6505 include 'COMMON.FFIELD'
6506 include 'COMMON.DERIV'
6507 include 'COMMON.LOCAL'
6508 include 'COMMON.INTERACT'
6509 include 'COMMON.CONTACTS'
6510 include 'COMMON.CHAIN'
6511 include 'COMMON.CONTROL'
6512 double precision gx(3),gx1(3)
6513 integer num_cont_hb_old(maxres)
6515 double precision eello4,eello5,eelo6,eello_turn6
6516 external eello4,eello5,eello6,eello_turn6
6517 C Set lprn=.true. for debugging
6522 num_cont_hb_old(i)=num_cont_hb(i)
6526 if (nfgtasks.le.1) goto 30
6528 write (iout,'(a)') 'Contact function values before RECEIVE:'
6530 write (iout,'(2i3,50(1x,i2,f5.2))')
6531 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6532 & j=1,num_cont_hb(i))
6536 do i=1,ntask_cont_from
6539 do i=1,ntask_cont_to
6542 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6544 C Make the list of contacts to send to send to other procesors
6545 do i=iturn3_start,iturn3_end
6546 c write (iout,*) "make contact list turn3",i," num_cont",
6548 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6550 do i=iturn4_start,iturn4_end
6551 c write (iout,*) "make contact list turn4",i," num_cont",
6553 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6557 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6559 do j=1,num_cont_hb(i)
6562 iproc=iint_sent_local(k,jjc,ii)
6563 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6564 if (iproc.ne.0) then
6565 ncont_sent(iproc)=ncont_sent(iproc)+1
6566 nn=ncont_sent(iproc)
6568 zapas(2,nn,iproc)=jjc
6569 zapas(3,nn,iproc)=d_cont(j,i)
6573 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6578 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6586 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6597 & "Numbers of contacts to be sent to other processors",
6598 & (ncont_sent(i),i=1,ntask_cont_to)
6599 write (iout,*) "Contacts sent"
6600 do ii=1,ntask_cont_to
6602 iproc=itask_cont_to(ii)
6603 write (iout,*) nn," contacts to processor",iproc,
6604 & " of CONT_TO_COMM group"
6606 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6614 CorrelID1=nfgtasks+fg_rank+1
6616 C Receive the numbers of needed contacts from other processors
6617 do ii=1,ntask_cont_from
6618 iproc=itask_cont_from(ii)
6620 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6621 & FG_COMM,req(ireq),IERR)
6623 c write (iout,*) "IRECV ended"
6625 C Send the number of contacts needed by other processors
6626 do ii=1,ntask_cont_to
6627 iproc=itask_cont_to(ii)
6629 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6630 & FG_COMM,req(ireq),IERR)
6632 c write (iout,*) "ISEND ended"
6633 c write (iout,*) "number of requests (nn)",ireq
6636 & call MPI_Waitall(ireq,req,status_array,ierr)
6638 c & "Numbers of contacts to be received from other processors",
6639 c & (ncont_recv(i),i=1,ntask_cont_from)
6643 do ii=1,ntask_cont_from
6644 iproc=itask_cont_from(ii)
6646 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6647 c & " of CONT_TO_COMM group"
6651 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6652 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6653 c write (iout,*) "ireq,req",ireq,req(ireq)
6656 C Send the contacts to processors that need them
6657 do ii=1,ntask_cont_to
6658 iproc=itask_cont_to(ii)
6660 c write (iout,*) nn," contacts to processor",iproc,
6661 c & " of CONT_TO_COMM group"
6664 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6665 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6666 c write (iout,*) "ireq,req",ireq,req(ireq)
6668 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6672 c write (iout,*) "number of requests (contacts)",ireq
6673 c write (iout,*) "req",(req(i),i=1,4)
6676 & call MPI_Waitall(ireq,req,status_array,ierr)
6677 do iii=1,ntask_cont_from
6678 iproc=itask_cont_from(iii)
6681 write (iout,*) "Received",nn," contacts from processor",iproc,
6682 & " of CONT_FROM_COMM group"
6685 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6690 ii=zapas_recv(1,i,iii)
6691 c Flag the received contacts to prevent double-counting
6692 jj=-zapas_recv(2,i,iii)
6693 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6695 nnn=num_cont_hb(ii)+1
6698 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6702 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6707 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6715 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6724 write (iout,'(a)') 'Contact function values after receive:'
6726 write (iout,'(2i3,50(1x,i3,5f6.3))')
6727 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6728 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6735 write (iout,'(a)') 'Contact function values:'
6737 write (iout,'(2i3,50(1x,i2,5f6.3))')
6738 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6739 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6745 C Remove the loop below after debugging !!!
6752 C Calculate the dipole-dipole interaction energies
6753 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6754 do i=iatel_s,iatel_e+1
6755 num_conti=num_cont_hb(i)
6764 C Calculate the local-electrostatic correlation terms
6765 c write (iout,*) "gradcorr5 in eello5 before loop"
6767 c write (iout,'(i5,3f10.5)')
6768 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6770 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6771 c write (iout,*) "corr loop i",i
6773 num_conti=num_cont_hb(i)
6774 num_conti1=num_cont_hb(i+1)
6781 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6782 c & ' jj=',jj,' kk=',kk
6783 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6784 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6785 & .or. j.lt.0 .and. j1.gt.0) .and.
6786 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6787 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6788 C The system gains extra energy.
6790 sqd1=dsqrt(d_cont(jj,i))
6791 sqd2=dsqrt(d_cont(kk,i1))
6792 sred_geom = sqd1*sqd2
6793 IF (sred_geom.lt.cutoff_corr) THEN
6794 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6796 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6797 cd & ' jj=',jj,' kk=',kk
6798 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6799 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6801 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6802 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6805 cd write (iout,*) 'sred_geom=',sred_geom,
6806 cd & ' ekont=',ekont,' fprim=',fprimcont,
6807 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6808 cd write (iout,*) "g_contij",g_contij
6809 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6810 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6811 call calc_eello(i,jp,i+1,jp1,jj,kk)
6812 if (wcorr4.gt.0.0d0)
6813 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6814 if (energy_dec.and.wcorr4.gt.0.0d0)
6815 1 write (iout,'(a6,4i5,0pf7.3)')
6816 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6817 c write (iout,*) "gradcorr5 before eello5"
6819 c write (iout,'(i5,3f10.5)')
6820 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6822 if (wcorr5.gt.0.0d0)
6823 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6824 c write (iout,*) "gradcorr5 after eello5"
6826 c write (iout,'(i5,3f10.5)')
6827 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6829 if (energy_dec.and.wcorr5.gt.0.0d0)
6830 1 write (iout,'(a6,4i5,0pf7.3)')
6831 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6832 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6833 cd write(2,*)'ijkl',i,jp,i+1,jp1
6834 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6835 & .or. wturn6.eq.0.0d0))then
6836 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6837 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6838 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6839 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6840 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6841 cd & 'ecorr6=',ecorr6
6842 cd write (iout,'(4e15.5)') sred_geom,
6843 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6844 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6845 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6846 else if (wturn6.gt.0.0d0
6847 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6848 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6849 eturn6=eturn6+eello_turn6(i,jj,kk)
6850 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6851 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6852 cd write (2,*) 'multibody_eello:eturn6',eturn6
6861 num_cont_hb(i)=num_cont_hb_old(i)
6863 c write (iout,*) "gradcorr5 in eello5"
6865 c write (iout,'(i5,3f10.5)')
6866 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6870 c------------------------------------------------------------------------------
6871 subroutine add_hb_contact_eello(ii,jj,itask)
6872 implicit real*8 (a-h,o-z)
6873 include "DIMENSIONS"
6874 include "COMMON.IOUNITS"
6877 parameter (max_cont=maxconts)
6878 parameter (max_dim=70)
6879 include "COMMON.CONTACTS"
6880 double precision zapas(max_dim,maxconts,max_fg_procs),
6881 & zapas_recv(max_dim,maxconts,max_fg_procs)
6882 common /przechowalnia/ zapas
6883 integer i,j,ii,jj,iproc,itask(4),nn
6884 c write (iout,*) "itask",itask
6887 if (iproc.gt.0) then
6888 do j=1,num_cont_hb(ii)
6890 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6892 ncont_sent(iproc)=ncont_sent(iproc)+1
6893 nn=ncont_sent(iproc)
6894 zapas(1,nn,iproc)=ii
6895 zapas(2,nn,iproc)=jjc
6896 zapas(3,nn,iproc)=d_cont(j,ii)
6900 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6905 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6913 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6925 c------------------------------------------------------------------------------
6926 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6927 implicit real*8 (a-h,o-z)
6928 include 'DIMENSIONS'
6929 include 'COMMON.IOUNITS'
6930 include 'COMMON.DERIV'
6931 include 'COMMON.INTERACT'
6932 include 'COMMON.CONTACTS'
6933 double precision gx(3),gx1(3)
6943 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6944 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6945 C Following 4 lines for diagnostics.
6950 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6951 c & 'Contacts ',i,j,
6952 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6953 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6955 C Calculate the multi-body contribution to energy.
6956 c ecorr=ecorr+ekont*ees
6957 C Calculate multi-body contributions to the gradient.
6958 coeffpees0pij=coeffp*ees0pij
6959 coeffmees0mij=coeffm*ees0mij
6960 coeffpees0pkl=coeffp*ees0pkl
6961 coeffmees0mkl=coeffm*ees0mkl
6963 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6964 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6965 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6966 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6967 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6968 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6969 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6970 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6971 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6972 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6973 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6974 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6975 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6976 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6977 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6978 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6979 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6980 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6981 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6982 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6983 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6984 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6985 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6986 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6987 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6992 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6993 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6994 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6995 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7000 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7001 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7002 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7003 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7006 c write (iout,*) "ehbcorr",ekont*ees
7011 C---------------------------------------------------------------------------
7012 subroutine dipole(i,j,jj)
7013 implicit real*8 (a-h,o-z)
7014 include 'DIMENSIONS'
7015 include 'COMMON.IOUNITS'
7016 include 'COMMON.CHAIN'
7017 include 'COMMON.FFIELD'
7018 include 'COMMON.DERIV'
7019 include 'COMMON.INTERACT'
7020 include 'COMMON.CONTACTS'
7021 include 'COMMON.TORSION'
7022 include 'COMMON.VAR'
7023 include 'COMMON.GEO'
7024 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7026 iti1 = itortyp(itype(i+1))
7027 if (j.lt.nres-1) then
7028 itj1 = itortyp(itype(j+1))
7033 dipi(iii,1)=Ub2(iii,i)
7034 dipderi(iii)=Ub2der(iii,i)
7035 dipi(iii,2)=b1(iii,iti1)
7036 dipj(iii,1)=Ub2(iii,j)
7037 dipderj(iii)=Ub2der(iii,j)
7038 dipj(iii,2)=b1(iii,itj1)
7042 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7045 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7052 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7056 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7061 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7062 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7064 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7066 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7068 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7073 C---------------------------------------------------------------------------
7074 subroutine calc_eello(i,j,k,l,jj,kk)
7076 C This subroutine computes matrices and vectors needed to calculate
7077 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7079 implicit real*8 (a-h,o-z)
7080 include 'DIMENSIONS'
7081 include 'COMMON.IOUNITS'
7082 include 'COMMON.CHAIN'
7083 include 'COMMON.DERIV'
7084 include 'COMMON.INTERACT'
7085 include 'COMMON.CONTACTS'
7086 include 'COMMON.TORSION'
7087 include 'COMMON.VAR'
7088 include 'COMMON.GEO'
7089 include 'COMMON.FFIELD'
7090 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7091 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7094 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7095 cd & ' jj=',jj,' kk=',kk
7096 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7097 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7098 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7101 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7102 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7105 call transpose2(aa1(1,1),aa1t(1,1))
7106 call transpose2(aa2(1,1),aa2t(1,1))
7109 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7110 & aa1tder(1,1,lll,kkk))
7111 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7112 & aa2tder(1,1,lll,kkk))
7116 C parallel orientation of the two CA-CA-CA frames.
7118 iti=itortyp(itype(i))
7122 itk1=itortyp(itype(k+1))
7123 itj=itortyp(itype(j))
7124 if (l.lt.nres-1) then
7125 itl1=itortyp(itype(l+1))
7129 C A1 kernel(j+1) A2T
7131 cd write (iout,'(3f10.5,5x,3f10.5)')
7132 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7134 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7135 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7136 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7137 C Following matrices are needed only for 6-th order cumulants
7138 IF (wcorr6.gt.0.0d0) THEN
7139 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7140 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7141 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7142 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7143 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7144 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7145 & ADtEAderx(1,1,1,1,1,1))
7147 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7148 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7149 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7150 & ADtEA1derx(1,1,1,1,1,1))
7152 C End 6-th order cumulants
7155 cd write (2,*) 'In calc_eello6'
7157 cd write (2,*) 'iii=',iii
7159 cd write (2,*) 'kkk=',kkk
7161 cd write (2,'(3(2f10.5),5x)')
7162 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7167 call transpose2(EUgder(1,1,k),auxmat(1,1))
7168 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7169 call transpose2(EUg(1,1,k),auxmat(1,1))
7170 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7171 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7175 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7176 & EAEAderx(1,1,lll,kkk,iii,1))
7180 C A1T kernel(i+1) A2
7181 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7182 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7183 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7184 C Following matrices are needed only for 6-th order cumulants
7185 IF (wcorr6.gt.0.0d0) THEN
7186 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7187 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7188 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7189 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7190 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7191 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7192 & ADtEAderx(1,1,1,1,1,2))
7193 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7194 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7195 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7196 & ADtEA1derx(1,1,1,1,1,2))
7198 C End 6-th order cumulants
7199 call transpose2(EUgder(1,1,l),auxmat(1,1))
7200 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7201 call transpose2(EUg(1,1,l),auxmat(1,1))
7202 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7203 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7207 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7208 & EAEAderx(1,1,lll,kkk,iii,2))
7213 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7214 C They are needed only when the fifth- or the sixth-order cumulants are
7216 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7217 call transpose2(AEA(1,1,1),auxmat(1,1))
7218 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7219 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7220 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7221 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7222 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7223 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7224 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7225 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7226 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7227 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7228 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7229 call transpose2(AEA(1,1,2),auxmat(1,1))
7230 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7231 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7232 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7233 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7234 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7235 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7236 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7237 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7238 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7239 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7240 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7241 C Calculate the Cartesian derivatives of the vectors.
7245 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7246 call matvec2(auxmat(1,1),b1(1,iti),
7247 & AEAb1derx(1,lll,kkk,iii,1,1))
7248 call matvec2(auxmat(1,1),Ub2(1,i),
7249 & AEAb2derx(1,lll,kkk,iii,1,1))
7250 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7251 & AEAb1derx(1,lll,kkk,iii,2,1))
7252 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7253 & AEAb2derx(1,lll,kkk,iii,2,1))
7254 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7255 call matvec2(auxmat(1,1),b1(1,itj),
7256 & AEAb1derx(1,lll,kkk,iii,1,2))
7257 call matvec2(auxmat(1,1),Ub2(1,j),
7258 & AEAb2derx(1,lll,kkk,iii,1,2))
7259 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7260 & AEAb1derx(1,lll,kkk,iii,2,2))
7261 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7262 & AEAb2derx(1,lll,kkk,iii,2,2))
7269 C Antiparallel orientation of the two CA-CA-CA frames.
7271 iti=itortyp(itype(i))
7275 itk1=itortyp(itype(k+1))
7276 itl=itortyp(itype(l))
7277 itj=itortyp(itype(j))
7278 if (j.lt.nres-1) then
7279 itj1=itortyp(itype(j+1))
7283 C A2 kernel(j-1)T A1T
7284 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7285 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7286 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7287 C Following matrices are needed only for 6-th order cumulants
7288 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7289 & j.eq.i+4 .and. l.eq.i+3)) THEN
7290 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7291 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7292 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7293 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7294 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7295 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7296 & ADtEAderx(1,1,1,1,1,1))
7297 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7298 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7299 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7300 & ADtEA1derx(1,1,1,1,1,1))
7302 C End 6-th order cumulants
7303 call transpose2(EUgder(1,1,k),auxmat(1,1))
7304 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7305 call transpose2(EUg(1,1,k),auxmat(1,1))
7306 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7307 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7311 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7312 & EAEAderx(1,1,lll,kkk,iii,1))
7316 C A2T kernel(i+1)T A1
7317 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7318 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7319 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7320 C Following matrices are needed only for 6-th order cumulants
7321 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7322 & j.eq.i+4 .and. l.eq.i+3)) THEN
7323 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7324 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7325 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7326 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7327 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7328 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7329 & ADtEAderx(1,1,1,1,1,2))
7330 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7331 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7332 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7333 & ADtEA1derx(1,1,1,1,1,2))
7335 C End 6-th order cumulants
7336 call transpose2(EUgder(1,1,j),auxmat(1,1))
7337 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7338 call transpose2(EUg(1,1,j),auxmat(1,1))
7339 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7340 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7344 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7345 & EAEAderx(1,1,lll,kkk,iii,2))
7350 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7351 C They are needed only when the fifth- or the sixth-order cumulants are
7353 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7354 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7355 call transpose2(AEA(1,1,1),auxmat(1,1))
7356 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7357 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7358 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7359 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7360 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7361 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7362 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7363 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7364 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7365 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7366 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7367 call transpose2(AEA(1,1,2),auxmat(1,1))
7368 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7369 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7370 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7371 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7372 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7373 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7374 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7375 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7376 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7377 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7378 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7379 C Calculate the Cartesian derivatives of the vectors.
7383 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7384 call matvec2(auxmat(1,1),b1(1,iti),
7385 & AEAb1derx(1,lll,kkk,iii,1,1))
7386 call matvec2(auxmat(1,1),Ub2(1,i),
7387 & AEAb2derx(1,lll,kkk,iii,1,1))
7388 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7389 & AEAb1derx(1,lll,kkk,iii,2,1))
7390 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7391 & AEAb2derx(1,lll,kkk,iii,2,1))
7392 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7393 call matvec2(auxmat(1,1),b1(1,itl),
7394 & AEAb1derx(1,lll,kkk,iii,1,2))
7395 call matvec2(auxmat(1,1),Ub2(1,l),
7396 & AEAb2derx(1,lll,kkk,iii,1,2))
7397 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7398 & AEAb1derx(1,lll,kkk,iii,2,2))
7399 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7400 & AEAb2derx(1,lll,kkk,iii,2,2))
7409 C---------------------------------------------------------------------------
7410 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7411 & KK,KKderg,AKA,AKAderg,AKAderx)
7415 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7416 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7417 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7422 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7424 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7427 cd if (lprn) write (2,*) 'In kernel'
7429 cd if (lprn) write (2,*) 'kkk=',kkk
7431 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7432 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7434 cd write (2,*) 'lll=',lll
7435 cd write (2,*) 'iii=1'
7437 cd write (2,'(3(2f10.5),5x)')
7438 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7441 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7442 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7444 cd write (2,*) 'lll=',lll
7445 cd write (2,*) 'iii=2'
7447 cd write (2,'(3(2f10.5),5x)')
7448 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7455 C---------------------------------------------------------------------------
7456 double precision function eello4(i,j,k,l,jj,kk)
7457 implicit real*8 (a-h,o-z)
7458 include 'DIMENSIONS'
7459 include 'COMMON.IOUNITS'
7460 include 'COMMON.CHAIN'
7461 include 'COMMON.DERIV'
7462 include 'COMMON.INTERACT'
7463 include 'COMMON.CONTACTS'
7464 include 'COMMON.TORSION'
7465 include 'COMMON.VAR'
7466 include 'COMMON.GEO'
7467 double precision pizda(2,2),ggg1(3),ggg2(3)
7468 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7472 cd print *,'eello4:',i,j,k,l,jj,kk
7473 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7474 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7475 cold eij=facont_hb(jj,i)
7476 cold ekl=facont_hb(kk,k)
7478 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7479 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7480 gcorr_loc(k-1)=gcorr_loc(k-1)
7481 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7483 gcorr_loc(l-1)=gcorr_loc(l-1)
7484 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7486 gcorr_loc(j-1)=gcorr_loc(j-1)
7487 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7492 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7493 & -EAEAderx(2,2,lll,kkk,iii,1)
7494 cd derx(lll,kkk,iii)=0.0d0
7498 cd gcorr_loc(l-1)=0.0d0
7499 cd gcorr_loc(j-1)=0.0d0
7500 cd gcorr_loc(k-1)=0.0d0
7502 cd write (iout,*)'Contacts have occurred for peptide groups',
7503 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7504 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7505 if (j.lt.nres-1) then
7512 if (l.lt.nres-1) then
7520 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7521 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7522 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7523 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7524 cgrad ghalf=0.5d0*ggg1(ll)
7525 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7526 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7527 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7528 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7529 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7530 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7531 cgrad ghalf=0.5d0*ggg2(ll)
7532 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7533 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7534 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7535 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7536 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7537 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7541 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7546 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7551 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7556 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7560 cd write (2,*) iii,gcorr_loc(iii)
7563 cd write (2,*) 'ekont',ekont
7564 cd write (iout,*) 'eello4',ekont*eel4
7567 C---------------------------------------------------------------------------
7568 double precision function eello5(i,j,k,l,jj,kk)
7569 implicit real*8 (a-h,o-z)
7570 include 'DIMENSIONS'
7571 include 'COMMON.IOUNITS'
7572 include 'COMMON.CHAIN'
7573 include 'COMMON.DERIV'
7574 include 'COMMON.INTERACT'
7575 include 'COMMON.CONTACTS'
7576 include 'COMMON.TORSION'
7577 include 'COMMON.VAR'
7578 include 'COMMON.GEO'
7579 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7580 double precision ggg1(3),ggg2(3)
7581 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7586 C /l\ / \ \ / \ / \ / C
7587 C / \ / \ \ / \ / \ / C
7588 C j| o |l1 | o | o| o | | o |o C
7589 C \ |/k\| |/ \| / |/ \| |/ \| C
7590 C \i/ \ / \ / / \ / \ C
7592 C (I) (II) (III) (IV) C
7594 C eello5_1 eello5_2 eello5_3 eello5_4 C
7596 C Antiparallel chains C
7599 C /j\ / \ \ / \ / \ / C
7600 C / \ / \ \ / \ / \ / C
7601 C j1| o |l | o | o| o | | o |o C
7602 C \ |/k\| |/ \| / |/ \| |/ \| C
7603 C \i/ \ / \ / / \ / \ C
7605 C (I) (II) (III) (IV) C
7607 C eello5_1 eello5_2 eello5_3 eello5_4 C
7609 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7611 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7612 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7617 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7619 itk=itortyp(itype(k))
7620 itl=itortyp(itype(l))
7621 itj=itortyp(itype(j))
7626 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7627 cd & eel5_3_num,eel5_4_num)
7631 derx(lll,kkk,iii)=0.0d0
7635 cd eij=facont_hb(jj,i)
7636 cd ekl=facont_hb(kk,k)
7638 cd write (iout,*)'Contacts have occurred for peptide groups',
7639 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7641 C Contribution from the graph I.
7642 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7643 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7644 call transpose2(EUg(1,1,k),auxmat(1,1))
7645 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(1,2)+pizda(2,1)
7648 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7649 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7650 C Explicit gradient in virtual-dihedral angles.
7651 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7652 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7653 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7654 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7655 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7656 vv(1)=pizda(1,1)-pizda(2,2)
7657 vv(2)=pizda(1,2)+pizda(2,1)
7658 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7659 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7661 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7662 vv(1)=pizda(1,1)-pizda(2,2)
7663 vv(2)=pizda(1,2)+pizda(2,1)
7665 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7666 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7667 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7669 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7670 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7671 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7673 C Cartesian gradient
7677 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7679 vv(1)=pizda(1,1)-pizda(2,2)
7680 vv(2)=pizda(1,2)+pizda(2,1)
7681 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7682 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7683 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7689 C Contribution from graph II
7690 call transpose2(EE(1,1,itk),auxmat(1,1))
7691 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7692 vv(1)=pizda(1,1)+pizda(2,2)
7693 vv(2)=pizda(2,1)-pizda(1,2)
7694 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7695 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7696 C Explicit gradient in virtual-dihedral angles.
7697 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7698 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7699 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7700 vv(1)=pizda(1,1)+pizda(2,2)
7701 vv(2)=pizda(2,1)-pizda(1,2)
7703 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7704 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7705 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7707 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7708 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7709 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7711 C Cartesian gradient
7715 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7717 vv(1)=pizda(1,1)+pizda(2,2)
7718 vv(2)=pizda(2,1)-pizda(1,2)
7719 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7720 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7721 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7729 C Parallel orientation
7730 C Contribution from graph III
7731 call transpose2(EUg(1,1,l),auxmat(1,1))
7732 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7733 vv(1)=pizda(1,1)-pizda(2,2)
7734 vv(2)=pizda(1,2)+pizda(2,1)
7735 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7736 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7737 C Explicit gradient in virtual-dihedral angles.
7738 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7739 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7740 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7741 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7742 vv(1)=pizda(1,1)-pizda(2,2)
7743 vv(2)=pizda(1,2)+pizda(2,1)
7744 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7745 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7746 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7747 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7748 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7749 vv(1)=pizda(1,1)-pizda(2,2)
7750 vv(2)=pizda(1,2)+pizda(2,1)
7751 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7752 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7753 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7754 C Cartesian gradient
7758 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7760 vv(1)=pizda(1,1)-pizda(2,2)
7761 vv(2)=pizda(1,2)+pizda(2,1)
7762 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7763 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7764 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7769 C Contribution from graph IV
7771 call transpose2(EE(1,1,itl),auxmat(1,1))
7772 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7773 vv(1)=pizda(1,1)+pizda(2,2)
7774 vv(2)=pizda(2,1)-pizda(1,2)
7775 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7776 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7777 C Explicit gradient in virtual-dihedral angles.
7778 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7779 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7780 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7781 vv(1)=pizda(1,1)+pizda(2,2)
7782 vv(2)=pizda(2,1)-pizda(1,2)
7783 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7784 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7785 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7786 C Cartesian gradient
7790 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7792 vv(1)=pizda(1,1)+pizda(2,2)
7793 vv(2)=pizda(2,1)-pizda(1,2)
7794 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7795 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7796 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7801 C Antiparallel orientation
7802 C Contribution from graph III
7804 call transpose2(EUg(1,1,j),auxmat(1,1))
7805 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7806 vv(1)=pizda(1,1)-pizda(2,2)
7807 vv(2)=pizda(1,2)+pizda(2,1)
7808 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7809 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7810 C Explicit gradient in virtual-dihedral angles.
7811 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7812 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7813 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7814 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7815 vv(1)=pizda(1,1)-pizda(2,2)
7816 vv(2)=pizda(1,2)+pizda(2,1)
7817 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7818 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7819 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7820 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7821 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7822 vv(1)=pizda(1,1)-pizda(2,2)
7823 vv(2)=pizda(1,2)+pizda(2,1)
7824 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7825 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7826 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7827 C Cartesian gradient
7831 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7833 vv(1)=pizda(1,1)-pizda(2,2)
7834 vv(2)=pizda(1,2)+pizda(2,1)
7835 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7836 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7837 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7842 C Contribution from graph IV
7844 call transpose2(EE(1,1,itj),auxmat(1,1))
7845 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7846 vv(1)=pizda(1,1)+pizda(2,2)
7847 vv(2)=pizda(2,1)-pizda(1,2)
7848 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7849 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7850 C Explicit gradient in virtual-dihedral angles.
7851 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7852 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7853 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7854 vv(1)=pizda(1,1)+pizda(2,2)
7855 vv(2)=pizda(2,1)-pizda(1,2)
7856 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7857 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7858 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7859 C Cartesian gradient
7863 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7865 vv(1)=pizda(1,1)+pizda(2,2)
7866 vv(2)=pizda(2,1)-pizda(1,2)
7867 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7868 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7869 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7875 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7876 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7877 cd write (2,*) 'ijkl',i,j,k,l
7878 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7879 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7881 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7882 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7883 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7884 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7885 if (j.lt.nres-1) then
7892 if (l.lt.nres-1) then
7902 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7903 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7904 C summed up outside the subrouine as for the other subroutines
7905 C handling long-range interactions. The old code is commented out
7906 C with "cgrad" to keep track of changes.
7908 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7909 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7910 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7911 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7912 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7913 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7914 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7915 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7916 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7917 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7919 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7920 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7921 cgrad ghalf=0.5d0*ggg1(ll)
7923 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7924 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7925 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7926 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7927 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7928 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7929 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7930 cgrad ghalf=0.5d0*ggg2(ll)
7932 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7933 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7934 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7935 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7936 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7937 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7942 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7943 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7948 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7949 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7955 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7960 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7964 cd write (2,*) iii,g_corr5_loc(iii)
7967 cd write (2,*) 'ekont',ekont
7968 cd write (iout,*) 'eello5',ekont*eel5
7971 c--------------------------------------------------------------------------
7972 double precision function eello6(i,j,k,l,jj,kk)
7973 implicit real*8 (a-h,o-z)
7974 include 'DIMENSIONS'
7975 include 'COMMON.IOUNITS'
7976 include 'COMMON.CHAIN'
7977 include 'COMMON.DERIV'
7978 include 'COMMON.INTERACT'
7979 include 'COMMON.CONTACTS'
7980 include 'COMMON.TORSION'
7981 include 'COMMON.VAR'
7982 include 'COMMON.GEO'
7983 include 'COMMON.FFIELD'
7984 double precision ggg1(3),ggg2(3)
7985 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7990 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7998 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7999 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8003 derx(lll,kkk,iii)=0.0d0
8007 cd eij=facont_hb(jj,i)
8008 cd ekl=facont_hb(kk,k)
8014 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8015 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8016 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8017 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8018 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8019 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8021 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8022 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8023 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8024 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8025 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8026 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8030 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8032 C If turn contributions are considered, they will be handled separately.
8033 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8034 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8035 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8036 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8037 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8038 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8039 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8041 if (j.lt.nres-1) then
8048 if (l.lt.nres-1) then
8056 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8057 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8058 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8059 cgrad ghalf=0.5d0*ggg1(ll)
8061 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8062 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8063 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8064 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8065 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8066 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8067 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8068 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8069 cgrad ghalf=0.5d0*ggg2(ll)
8070 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8072 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8073 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8074 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8075 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8076 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8077 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8082 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8083 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8088 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8089 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8095 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8100 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8104 cd write (2,*) iii,g_corr6_loc(iii)
8107 cd write (2,*) 'ekont',ekont
8108 cd write (iout,*) 'eello6',ekont*eel6
8111 c--------------------------------------------------------------------------
8112 double precision function eello6_graph1(i,j,k,l,imat,swap)
8113 implicit real*8 (a-h,o-z)
8114 include 'DIMENSIONS'
8115 include 'COMMON.IOUNITS'
8116 include 'COMMON.CHAIN'
8117 include 'COMMON.DERIV'
8118 include 'COMMON.INTERACT'
8119 include 'COMMON.CONTACTS'
8120 include 'COMMON.TORSION'
8121 include 'COMMON.VAR'
8122 include 'COMMON.GEO'
8123 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8127 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8129 C Parallel Antiparallel
8135 C \ j|/k\| / \ |/k\|l /
8140 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8141 itk=itortyp(itype(k))
8142 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8143 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8144 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8145 call transpose2(EUgC(1,1,k),auxmat(1,1))
8146 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8147 vv1(1)=pizda1(1,1)-pizda1(2,2)
8148 vv1(2)=pizda1(1,2)+pizda1(2,1)
8149 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8150 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8151 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8152 s5=scalar2(vv(1),Dtobr2(1,i))
8153 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8154 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8155 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8156 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8157 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8158 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8159 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8160 & +scalar2(vv(1),Dtobr2der(1,i)))
8161 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8162 vv1(1)=pizda1(1,1)-pizda1(2,2)
8163 vv1(2)=pizda1(1,2)+pizda1(2,1)
8164 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8165 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8167 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8168 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8169 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8170 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8171 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8173 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8174 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8175 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8176 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8177 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8179 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8180 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8181 vv1(1)=pizda1(1,1)-pizda1(2,2)
8182 vv1(2)=pizda1(1,2)+pizda1(2,1)
8183 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8184 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8185 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8186 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8195 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8196 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8197 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8198 call transpose2(EUgC(1,1,k),auxmat(1,1))
8199 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8201 vv1(1)=pizda1(1,1)-pizda1(2,2)
8202 vv1(2)=pizda1(1,2)+pizda1(2,1)
8203 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8204 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8205 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8206 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8207 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8208 s5=scalar2(vv(1),Dtobr2(1,i))
8209 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8215 c----------------------------------------------------------------------------
8216 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8217 implicit real*8 (a-h,o-z)
8218 include 'DIMENSIONS'
8219 include 'COMMON.IOUNITS'
8220 include 'COMMON.CHAIN'
8221 include 'COMMON.DERIV'
8222 include 'COMMON.INTERACT'
8223 include 'COMMON.CONTACTS'
8224 include 'COMMON.TORSION'
8225 include 'COMMON.VAR'
8226 include 'COMMON.GEO'
8228 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8229 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8232 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8234 C Parallel Antiparallel C
8240 C \ j|/k\| \ |/k\|l C
8245 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8246 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8247 C AL 7/4/01 s1 would occur in the sixth-order moment,
8248 C but not in a cluster cumulant
8250 s1=dip(1,jj,i)*dip(1,kk,k)
8252 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8253 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8254 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8255 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8256 call transpose2(EUg(1,1,k),auxmat(1,1))
8257 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8258 vv(1)=pizda(1,1)-pizda(2,2)
8259 vv(2)=pizda(1,2)+pizda(2,1)
8260 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8261 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8263 eello6_graph2=-(s1+s2+s3+s4)
8265 eello6_graph2=-(s2+s3+s4)
8268 C Derivatives in gamma(i-1)
8271 s1=dipderg(1,jj,i)*dip(1,kk,k)
8273 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8274 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8275 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8276 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8278 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8280 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8282 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8284 C Derivatives in gamma(k-1)
8286 s1=dip(1,jj,i)*dipderg(1,kk,k)
8288 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8289 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8290 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8291 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8292 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8293 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8294 vv(1)=pizda(1,1)-pizda(2,2)
8295 vv(2)=pizda(1,2)+pizda(2,1)
8296 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8298 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8300 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8302 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8303 C Derivatives in gamma(j-1) or gamma(l-1)
8306 s1=dipderg(3,jj,i)*dip(1,kk,k)
8308 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8309 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8310 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8311 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8312 vv(1)=pizda(1,1)-pizda(2,2)
8313 vv(2)=pizda(1,2)+pizda(2,1)
8314 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8317 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8319 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8322 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8323 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8325 C Derivatives in gamma(l-1) or gamma(j-1)
8328 s1=dip(1,jj,i)*dipderg(3,kk,k)
8330 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8331 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8332 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8333 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8334 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8335 vv(1)=pizda(1,1)-pizda(2,2)
8336 vv(2)=pizda(1,2)+pizda(2,1)
8337 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8340 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8342 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8345 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8346 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8348 C Cartesian derivatives.
8350 write (2,*) 'In eello6_graph2'
8352 write (2,*) 'iii=',iii
8354 write (2,*) 'kkk=',kkk
8356 write (2,'(3(2f10.5),5x)')
8357 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8367 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8369 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8372 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8374 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8375 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8377 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8378 call transpose2(EUg(1,1,k),auxmat(1,1))
8379 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8381 vv(1)=pizda(1,1)-pizda(2,2)
8382 vv(2)=pizda(1,2)+pizda(2,1)
8383 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8384 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8386 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8388 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8391 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8393 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8400 c----------------------------------------------------------------------------
8401 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8402 implicit real*8 (a-h,o-z)
8403 include 'DIMENSIONS'
8404 include 'COMMON.IOUNITS'
8405 include 'COMMON.CHAIN'
8406 include 'COMMON.DERIV'
8407 include 'COMMON.INTERACT'
8408 include 'COMMON.CONTACTS'
8409 include 'COMMON.TORSION'
8410 include 'COMMON.VAR'
8411 include 'COMMON.GEO'
8412 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8414 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8416 C Parallel Antiparallel C
8422 C j|/k\| / |/k\|l / C
8427 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8429 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8430 C energy moment and not to the cluster cumulant.
8431 iti=itortyp(itype(i))
8432 if (j.lt.nres-1) then
8433 itj1=itortyp(itype(j+1))
8437 itk=itortyp(itype(k))
8438 itk1=itortyp(itype(k+1))
8439 if (l.lt.nres-1) then
8440 itl1=itortyp(itype(l+1))
8445 s1=dip(4,jj,i)*dip(4,kk,k)
8447 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8448 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8449 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8450 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8451 call transpose2(EE(1,1,itk),auxmat(1,1))
8452 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8453 vv(1)=pizda(1,1)+pizda(2,2)
8454 vv(2)=pizda(2,1)-pizda(1,2)
8455 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8456 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8457 cd & "sum",-(s2+s3+s4)
8459 eello6_graph3=-(s1+s2+s3+s4)
8461 eello6_graph3=-(s2+s3+s4)
8464 C Derivatives in gamma(k-1)
8465 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8466 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8467 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8468 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8469 C Derivatives in gamma(l-1)
8470 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8471 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8472 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8473 vv(1)=pizda(1,1)+pizda(2,2)
8474 vv(2)=pizda(2,1)-pizda(1,2)
8475 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8476 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8477 C Cartesian derivatives.
8483 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8485 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8488 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8490 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8491 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8493 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8494 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8496 vv(1)=pizda(1,1)+pizda(2,2)
8497 vv(2)=pizda(2,1)-pizda(1,2)
8498 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8500 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8502 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8505 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8507 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8509 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8515 c----------------------------------------------------------------------------
8516 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8517 implicit real*8 (a-h,o-z)
8518 include 'DIMENSIONS'
8519 include 'COMMON.IOUNITS'
8520 include 'COMMON.CHAIN'
8521 include 'COMMON.DERIV'
8522 include 'COMMON.INTERACT'
8523 include 'COMMON.CONTACTS'
8524 include 'COMMON.TORSION'
8525 include 'COMMON.VAR'
8526 include 'COMMON.GEO'
8527 include 'COMMON.FFIELD'
8528 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8529 & auxvec1(2),auxmat1(2,2)
8531 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8533 C Parallel Antiparallel C
8539 C \ j|/k\| \ |/k\|l C
8544 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8546 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8547 C energy moment and not to the cluster cumulant.
8548 cd write (2,*) 'eello_graph4: wturn6',wturn6
8549 iti=itortyp(itype(i))
8550 itj=itortyp(itype(j))
8551 if (j.lt.nres-1) then
8552 itj1=itortyp(itype(j+1))
8556 itk=itortyp(itype(k))
8557 if (k.lt.nres-1) then
8558 itk1=itortyp(itype(k+1))
8562 itl=itortyp(itype(l))
8563 if (l.lt.nres-1) then
8564 itl1=itortyp(itype(l+1))
8568 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8569 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8570 cd & ' itl',itl,' itl1',itl1
8573 s1=dip(3,jj,i)*dip(3,kk,k)
8575 s1=dip(2,jj,j)*dip(2,kk,l)
8578 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8579 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8581 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8582 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8584 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8585 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8587 call transpose2(EUg(1,1,k),auxmat(1,1))
8588 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8589 vv(1)=pizda(1,1)-pizda(2,2)
8590 vv(2)=pizda(2,1)+pizda(1,2)
8591 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8592 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8594 eello6_graph4=-(s1+s2+s3+s4)
8596 eello6_graph4=-(s2+s3+s4)
8598 C Derivatives in gamma(i-1)
8602 s1=dipderg(2,jj,i)*dip(3,kk,k)
8604 s1=dipderg(4,jj,j)*dip(2,kk,l)
8607 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8609 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8610 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8612 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8613 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8615 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8616 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8617 cd write (2,*) 'turn6 derivatives'
8619 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8621 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8625 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8627 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8631 C Derivatives in gamma(k-1)
8634 s1=dip(3,jj,i)*dipderg(2,kk,k)
8636 s1=dip(2,jj,j)*dipderg(4,kk,l)
8639 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8640 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8642 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8643 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8645 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8646 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8648 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8649 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8650 vv(1)=pizda(1,1)-pizda(2,2)
8651 vv(2)=pizda(2,1)+pizda(1,2)
8652 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8653 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8655 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8657 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8661 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8663 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8666 C Derivatives in gamma(j-1) or gamma(l-1)
8667 if (l.eq.j+1 .and. l.gt.1) then
8668 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8669 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8670 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8671 vv(1)=pizda(1,1)-pizda(2,2)
8672 vv(2)=pizda(2,1)+pizda(1,2)
8673 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8674 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8675 else if (j.gt.1) then
8676 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8677 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8678 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8679 vv(1)=pizda(1,1)-pizda(2,2)
8680 vv(2)=pizda(2,1)+pizda(1,2)
8681 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8682 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8683 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8685 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8688 C Cartesian derivatives.
8695 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8697 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8701 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8703 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8707 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8709 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8711 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8712 & b1(1,itj1),auxvec(1))
8713 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8715 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8716 & b1(1,itl1),auxvec(1))
8717 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8719 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8721 vv(1)=pizda(1,1)-pizda(2,2)
8722 vv(2)=pizda(2,1)+pizda(1,2)
8723 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8725 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8727 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8730 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8733 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8736 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8738 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8740 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8744 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8746 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8749 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8751 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8759 c----------------------------------------------------------------------------
8760 double precision function eello_turn6(i,jj,kk)
8761 implicit real*8 (a-h,o-z)
8762 include 'DIMENSIONS'
8763 include 'COMMON.IOUNITS'
8764 include 'COMMON.CHAIN'
8765 include 'COMMON.DERIV'
8766 include 'COMMON.INTERACT'
8767 include 'COMMON.CONTACTS'
8768 include 'COMMON.TORSION'
8769 include 'COMMON.VAR'
8770 include 'COMMON.GEO'
8771 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8772 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8774 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8775 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8776 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8777 C the respective energy moment and not to the cluster cumulant.
8786 iti=itortyp(itype(i))
8787 itk=itortyp(itype(k))
8788 itk1=itortyp(itype(k+1))
8789 itl=itortyp(itype(l))
8790 itj=itortyp(itype(j))
8791 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8792 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8793 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8798 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8800 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8804 derx_turn(lll,kkk,iii)=0.0d0
8811 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8813 cd write (2,*) 'eello6_5',eello6_5
8815 call transpose2(AEA(1,1,1),auxmat(1,1))
8816 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8817 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8818 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8820 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8821 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8822 s2 = scalar2(b1(1,itk),vtemp1(1))
8824 call transpose2(AEA(1,1,2),atemp(1,1))
8825 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8826 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8827 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8829 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8830 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8831 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8833 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8834 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8835 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8836 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8837 ss13 = scalar2(b1(1,itk),vtemp4(1))
8838 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8840 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8846 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8847 C Derivatives in gamma(i+2)
8851 call transpose2(AEA(1,1,1),auxmatd(1,1))
8852 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8853 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8854 call transpose2(AEAderg(1,1,2),atempd(1,1))
8855 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8856 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8858 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8859 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8860 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8866 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8867 C Derivatives in gamma(i+3)
8869 call transpose2(AEA(1,1,1),auxmatd(1,1))
8870 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8871 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8872 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8874 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8875 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8876 s2d = scalar2(b1(1,itk),vtemp1d(1))
8878 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8879 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8881 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8883 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8884 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8885 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8893 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8894 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8896 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8897 & -0.5d0*ekont*(s2d+s12d)
8899 C Derivatives in gamma(i+4)
8900 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8901 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8902 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8904 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8905 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8906 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8914 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8916 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8918 C Derivatives in gamma(i+5)
8920 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8921 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8922 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8924 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8925 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8926 s2d = scalar2(b1(1,itk),vtemp1d(1))
8928 call transpose2(AEA(1,1,2),atempd(1,1))
8929 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8930 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8932 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8933 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8935 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8936 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8937 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8945 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8946 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8948 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8949 & -0.5d0*ekont*(s2d+s12d)
8951 C Cartesian derivatives
8956 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8957 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8958 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8960 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8961 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8963 s2d = scalar2(b1(1,itk),vtemp1d(1))
8965 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8966 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8967 s8d = -(atempd(1,1)+atempd(2,2))*
8968 & scalar2(cc(1,1,itl),vtemp2(1))
8970 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8972 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8973 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8980 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8983 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8987 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8988 & - 0.5d0*(s8d+s12d)
8990 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8999 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9001 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9002 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9003 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9004 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9005 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9007 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9008 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9009 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9013 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9014 cd & 16*eel_turn6_num
9016 if (j.lt.nres-1) then
9023 if (l.lt.nres-1) then
9031 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9032 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9033 cgrad ghalf=0.5d0*ggg1(ll)
9035 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9036 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9037 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9038 & +ekont*derx_turn(ll,2,1)
9039 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9040 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9041 & +ekont*derx_turn(ll,4,1)
9042 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9043 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9044 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9045 cgrad ghalf=0.5d0*ggg2(ll)
9047 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9048 & +ekont*derx_turn(ll,2,2)
9049 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9050 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9051 & +ekont*derx_turn(ll,4,2)
9052 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9053 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9054 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9059 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9064 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9070 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9075 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9079 cd write (2,*) iii,g_corr6_loc(iii)
9081 eello_turn6=ekont*eel_turn6
9082 cd write (2,*) 'ekont',ekont
9083 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9087 C-----------------------------------------------------------------------------
9088 double precision function scalar(u,v)
9089 !DIR$ INLINEALWAYS scalar
9091 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9094 double precision u(3),v(3)
9095 cd double precision sc
9103 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9106 crc-------------------------------------------------
9107 SUBROUTINE MATVEC2(A1,V1,V2)
9108 !DIR$ INLINEALWAYS MATVEC2
9110 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9112 implicit real*8 (a-h,o-z)
9113 include 'DIMENSIONS'
9114 DIMENSION A1(2,2),V1(2),V2(2)
9118 c 3 VI=VI+A1(I,K)*V1(K)
9122 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9123 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9128 C---------------------------------------
9129 SUBROUTINE MATMAT2(A1,A2,A3)
9131 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9133 implicit real*8 (a-h,o-z)
9134 include 'DIMENSIONS'
9135 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9136 c DIMENSION AI3(2,2)
9140 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9146 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9147 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9148 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9149 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9157 c-------------------------------------------------------------------------
9158 double precision function scalar2(u,v)
9159 !DIR$ INLINEALWAYS scalar2
9161 double precision u(2),v(2)
9164 scalar2=u(1)*v(1)+u(2)*v(2)
9168 C-----------------------------------------------------------------------------
9170 subroutine transpose2(a,at)
9171 !DIR$ INLINEALWAYS transpose2
9173 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9176 double precision a(2,2),at(2,2)
9183 c--------------------------------------------------------------------------
9184 subroutine transpose(n,a,at)
9187 double precision a(n,n),at(n,n)
9195 C---------------------------------------------------------------------------
9196 subroutine prodmat3(a1,a2,kk,transp,prod)
9197 !DIR$ INLINEALWAYS prodmat3
9199 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9203 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9205 crc double precision auxmat(2,2),prod_(2,2)
9208 crc call transpose2(kk(1,1),auxmat(1,1))
9209 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9210 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9212 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9213 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9214 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9215 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9216 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9217 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9218 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9219 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9222 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9223 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9225 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9226 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9227 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9228 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9229 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9230 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9231 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9232 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9235 c call transpose2(a2(1,1),a2t(1,1))
9238 crc print *,((prod_(i,j),i=1,2),j=1,2)
9239 crc print *,((prod(i,j),i=1,2),j=1,2)