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)
778 write (iout,*) "gloc_sc before reduce"
781 write (iout,*) i,j,gloc_sc(j,i,icg)
787 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
791 call MPI_Barrier(FG_COMM,IERR)
792 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
794 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
795 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
796 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
797 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
798 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
799 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
800 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
801 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
802 time_reduce=time_reduce+MPI_Wtime()-time00
804 write (iout,*) "gloc_sc after reduce"
807 write (iout,*) i,j,gloc_sc(j,i,icg)
812 write (iout,*) "gloc after reduce"
814 write (iout,*) i,gloc(i,icg)
819 if (gnorm_check) then
821 c Compute the maximum elements of the gradient
831 gcorr3_turn_max=0.0d0
832 gcorr4_turn_max=0.0d0
835 gcorr6_turn_max=0.0d0
845 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
846 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
848 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
849 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
851 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
852 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
853 & gvdwc_scp_max=gvdwc_scp_norm
854 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
855 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
856 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
857 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
858 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
859 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
860 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
861 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
862 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
863 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
864 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
865 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
866 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
868 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
869 & gcorr3_turn_max=gcorr3_turn_norm
870 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
872 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
873 & gcorr4_turn_max=gcorr4_turn_norm
874 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
875 if (gradcorr5_norm.gt.gradcorr5_max)
876 & gradcorr5_max=gradcorr5_norm
877 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
878 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
879 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
881 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
882 & gcorr6_turn_max=gcorr6_turn_norm
883 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
884 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
885 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
886 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
887 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
888 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
890 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
891 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
893 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
894 if (gradx_scp_norm.gt.gradx_scp_max)
895 & gradx_scp_max=gradx_scp_norm
896 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
897 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
898 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
899 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
900 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
901 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
902 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
903 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
907 open(istat,file=statname,position="append")
909 open(istat,file=statname,access="append")
911 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
912 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
913 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
914 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
915 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
916 & gsccorx_max,gsclocx_max
918 if (gvdwc_max.gt.1.0d4) then
919 write (iout,*) "gvdwc gvdwx gradb gradbx"
921 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
922 & gradb(j,i),gradbx(j,i),j=1,3)
924 call pdbout(0.0d0,'cipiszcze',iout)
930 write (iout,*) "gradc gradx gloc"
932 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
933 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
938 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
940 time_sumgradient=time_sumgradient+tcpu()-time01
945 c-------------------------------------------------------------------------------
946 subroutine rescale_weights(t_bath)
947 implicit real*8 (a-h,o-z)
949 include 'COMMON.IOUNITS'
950 include 'COMMON.FFIELD'
951 include 'COMMON.SBRIDGE'
952 double precision kfac /2.4d0/
953 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
955 c facT=2*temp0/(t_bath+temp0)
956 if (rescale_mode.eq.0) then
962 else if (rescale_mode.eq.1) then
963 facT=kfac/(kfac-1.0d0+t_bath/temp0)
964 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
965 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
966 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
967 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
968 else if (rescale_mode.eq.2) then
974 facT=licznik/dlog(dexp(x)+dexp(-x))
975 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
976 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
977 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
978 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
980 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
981 write (*,*) "Wrong RESCALE_MODE",rescale_mode
983 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
987 welec=weights(3)*fact
988 wcorr=weights(4)*fact3
989 wcorr5=weights(5)*fact4
990 wcorr6=weights(6)*fact5
991 wel_loc=weights(7)*fact2
992 wturn3=weights(8)*fact2
993 wturn4=weights(9)*fact3
994 wturn6=weights(10)*fact5
995 wtor=weights(13)*fact
996 wtor_d=weights(14)*fact2
997 wsccor=weights(21)*fact
1000 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1004 C------------------------------------------------------------------------
1005 subroutine enerprint(energia)
1006 implicit real*8 (a-h,o-z)
1007 include 'DIMENSIONS'
1008 include 'COMMON.IOUNITS'
1009 include 'COMMON.FFIELD'
1010 include 'COMMON.SBRIDGE'
1012 double precision energia(0:n_ene)
1015 evdw=energia(22)+wsct*energia(23)
1021 evdw2=energia(2)+energia(18)
1033 eello_turn3=energia(8)
1034 eello_turn4=energia(9)
1035 eello_turn6=energia(10)
1041 edihcnstr=energia(19)
1046 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1047 & estr,wbond,ebe,wang,
1048 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1050 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1051 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1052 & edihcnstr,ebr*nss,
1054 10 format (/'Virtual-chain energies:'//
1055 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1056 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1057 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1058 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1059 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1060 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1061 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1062 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1063 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1064 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1065 & ' (SS bridges & dist. cnstr.)'/
1066 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1067 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1068 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1069 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1070 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1071 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1072 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1073 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1074 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1075 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1076 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1077 & 'ETOT= ',1pE16.6,' (total)')
1079 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1080 & estr,wbond,ebe,wang,
1081 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1083 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1084 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1085 & ebr*nss,Uconst,etot
1086 10 format (/'Virtual-chain energies:'//
1087 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1088 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1089 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1090 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1091 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1092 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1093 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1094 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1095 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1096 & ' (SS bridges & dist. cnstr.)'/
1097 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1098 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1099 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1100 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1101 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1102 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1103 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1104 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1105 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1106 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1107 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1108 & 'ETOT= ',1pE16.6,' (total)')
1112 C-----------------------------------------------------------------------
1113 subroutine elj(evdw,evdw_p,evdw_m)
1115 C This subroutine calculates the interaction energy of nonbonded side chains
1116 C assuming the LJ potential of interaction.
1118 implicit real*8 (a-h,o-z)
1119 include 'DIMENSIONS'
1120 parameter (accur=1.0d-10)
1121 include 'COMMON.GEO'
1122 include 'COMMON.VAR'
1123 include 'COMMON.LOCAL'
1124 include 'COMMON.CHAIN'
1125 include 'COMMON.DERIV'
1126 include 'COMMON.INTERACT'
1127 include 'COMMON.TORSION'
1128 include 'COMMON.SBRIDGE'
1129 include 'COMMON.NAMES'
1130 include 'COMMON.IOUNITS'
1131 include 'COMMON.CONTACTS'
1133 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1135 do i=iatsc_s,iatsc_e
1144 C Calculate SC interaction energy.
1146 do iint=1,nint_gr(i)
1147 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1148 cd & 'iend=',iend(i,iint)
1149 do j=istart(i,iint),iend(i,iint)
1154 C Change 12/1/95 to calculate four-body interactions
1155 rij=xj*xj+yj*yj+zj*zj
1157 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1158 eps0ij=eps(itypi,itypj)
1160 e1=fac*fac*aa(itypi,itypj)
1161 e2=fac*bb(itypi,itypj)
1163 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1164 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1165 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1166 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1167 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1168 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1170 if (bb(itypi,itypj).gt.0) then
1171 evdw_p=evdw_p+evdwij
1173 evdw_m=evdw_m+evdwij
1179 C Calculate the components of the gradient in DC and X
1181 fac=-rrij*(e1+evdwij)
1186 if (bb(itypi,itypj).gt.0.0d0) then
1188 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1189 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1190 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1191 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1195 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1196 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1197 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1198 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1203 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1204 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1205 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1206 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1211 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1215 C 12/1/95, revised on 5/20/97
1217 C Calculate the contact function. The ith column of the array JCONT will
1218 C contain the numbers of atoms that make contacts with the atom I (of numbers
1219 C greater than I). The arrays FACONT and GACONT will contain the values of
1220 C the contact function and its derivative.
1222 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1223 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1224 C Uncomment next line, if the correlation interactions are contact function only
1225 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1227 sigij=sigma(itypi,itypj)
1228 r0ij=rs0(itypi,itypj)
1230 C Check whether the SC's are not too far to make a contact.
1233 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1234 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1236 if (fcont.gt.0.0D0) then
1237 C If the SC-SC distance if close to sigma, apply spline.
1238 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1239 cAdam & fcont1,fprimcont1)
1240 cAdam fcont1=1.0d0-fcont1
1241 cAdam if (fcont1.gt.0.0d0) then
1242 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1243 cAdam fcont=fcont*fcont1
1245 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1246 cga eps0ij=1.0d0/dsqrt(eps0ij)
1248 cga gg(k)=gg(k)*eps0ij
1250 cga eps0ij=-evdwij*eps0ij
1251 C Uncomment for AL's type of SC correlation interactions.
1252 cadam eps0ij=-evdwij
1253 num_conti=num_conti+1
1254 jcont(num_conti,i)=j
1255 facont(num_conti,i)=fcont*eps0ij
1256 fprimcont=eps0ij*fprimcont/rij
1258 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1259 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1260 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1261 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1262 gacont(1,num_conti,i)=-fprimcont*xj
1263 gacont(2,num_conti,i)=-fprimcont*yj
1264 gacont(3,num_conti,i)=-fprimcont*zj
1265 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1266 cd write (iout,'(2i3,3f10.5)')
1267 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1273 num_cont(i)=num_conti
1277 gvdwc(j,i)=expon*gvdwc(j,i)
1278 gvdwx(j,i)=expon*gvdwx(j,i)
1281 C******************************************************************************
1285 C To save time, the factor of EXPON has been extracted from ALL components
1286 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1289 C******************************************************************************
1292 C-----------------------------------------------------------------------------
1293 subroutine eljk(evdw,evdw_p,evdw_m)
1295 C This subroutine calculates the interaction energy of nonbonded side chains
1296 C assuming the LJK potential of interaction.
1298 implicit real*8 (a-h,o-z)
1299 include 'DIMENSIONS'
1300 include 'COMMON.GEO'
1301 include 'COMMON.VAR'
1302 include 'COMMON.LOCAL'
1303 include 'COMMON.CHAIN'
1304 include 'COMMON.DERIV'
1305 include 'COMMON.INTERACT'
1306 include 'COMMON.IOUNITS'
1307 include 'COMMON.NAMES'
1310 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1312 do i=iatsc_s,iatsc_e
1319 C Calculate SC interaction energy.
1321 do iint=1,nint_gr(i)
1322 do j=istart(i,iint),iend(i,iint)
1327 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1328 fac_augm=rrij**expon
1329 e_augm=augm(itypi,itypj)*fac_augm
1330 r_inv_ij=dsqrt(rrij)
1332 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1333 fac=r_shift_inv**expon
1334 e1=fac*fac*aa(itypi,itypj)
1335 e2=fac*bb(itypi,itypj)
1337 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1338 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1339 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1340 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1341 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1342 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1343 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1345 if (bb(itypi,itypj).gt.0) then
1346 evdw_p=evdw_p+evdwij
1348 evdw_m=evdw_m+evdwij
1354 C Calculate the components of the gradient in DC and X
1356 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1361 if (bb(itypi,itypj).gt.0.0d0) then
1363 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1364 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1365 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1366 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1370 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1371 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1372 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1373 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1378 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1379 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1380 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1381 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1386 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1394 gvdwc(j,i)=expon*gvdwc(j,i)
1395 gvdwx(j,i)=expon*gvdwx(j,i)
1400 C-----------------------------------------------------------------------------
1401 subroutine ebp(evdw,evdw_p,evdw_m)
1403 C This subroutine calculates the interaction energy of nonbonded side chains
1404 C assuming the Berne-Pechukas potential of interaction.
1406 implicit real*8 (a-h,o-z)
1407 include 'DIMENSIONS'
1408 include 'COMMON.GEO'
1409 include 'COMMON.VAR'
1410 include 'COMMON.LOCAL'
1411 include 'COMMON.CHAIN'
1412 include 'COMMON.DERIV'
1413 include 'COMMON.NAMES'
1414 include 'COMMON.INTERACT'
1415 include 'COMMON.IOUNITS'
1416 include 'COMMON.CALC'
1417 common /srutu/ icall
1418 c double precision rrsave(maxdim)
1421 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1423 c if (icall.eq.0) then
1429 do i=iatsc_s,iatsc_e
1435 dxi=dc_norm(1,nres+i)
1436 dyi=dc_norm(2,nres+i)
1437 dzi=dc_norm(3,nres+i)
1438 c dsci_inv=dsc_inv(itypi)
1439 dsci_inv=vbld_inv(i+nres)
1441 C Calculate SC interaction energy.
1443 do iint=1,nint_gr(i)
1444 do j=istart(i,iint),iend(i,iint)
1447 c dscj_inv=dsc_inv(itypj)
1448 dscj_inv=vbld_inv(j+nres)
1449 chi1=chi(itypi,itypj)
1450 chi2=chi(itypj,itypi)
1457 alf12=0.5D0*(alf1+alf2)
1458 C For diagnostics only!!!
1471 dxj=dc_norm(1,nres+j)
1472 dyj=dc_norm(2,nres+j)
1473 dzj=dc_norm(3,nres+j)
1474 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1475 cd if (icall.eq.0) then
1481 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1483 C Calculate whole angle-dependent part of epsilon and contributions
1484 C to its derivatives
1485 fac=(rrij*sigsq)**expon2
1486 e1=fac*fac*aa(itypi,itypj)
1487 e2=fac*bb(itypi,itypj)
1488 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1489 eps2der=evdwij*eps3rt
1490 eps3der=evdwij*eps2rt
1491 evdwij=evdwij*eps2rt*eps3rt
1493 if (bb(itypi,itypj).gt.0) then
1494 evdw_p=evdw_p+evdwij
1496 evdw_m=evdw_m+evdwij
1502 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1503 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1504 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1505 cd & restyp(itypi),i,restyp(itypj),j,
1506 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1507 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1508 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1511 C Calculate gradient components.
1512 e1=e1*eps1*eps2rt**2*eps3rt**2
1513 fac=-expon*(e1+evdwij)
1516 C Calculate radial part of the gradient
1520 C Calculate the angular part of the gradient and sum add the contributions
1521 C to the appropriate components of the Cartesian gradient.
1523 if (bb(itypi,itypj).gt.0) then
1537 C-----------------------------------------------------------------------------
1538 subroutine egb(evdw,evdw_p,evdw_m)
1540 C This subroutine calculates the interaction energy of nonbonded side chains
1541 C assuming the Gay-Berne potential of interaction.
1543 implicit real*8 (a-h,o-z)
1544 include 'DIMENSIONS'
1545 include 'COMMON.GEO'
1546 include 'COMMON.VAR'
1547 include 'COMMON.LOCAL'
1548 include 'COMMON.CHAIN'
1549 include 'COMMON.DERIV'
1550 include 'COMMON.NAMES'
1551 include 'COMMON.INTERACT'
1552 include 'COMMON.IOUNITS'
1553 include 'COMMON.CALC'
1554 include 'COMMON.CONTROL'
1557 ccccc energy_dec=.false.
1558 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1563 c if (icall.eq.0) lprn=.false.
1565 do i=iatsc_s,iatsc_e
1571 dxi=dc_norm(1,nres+i)
1572 dyi=dc_norm(2,nres+i)
1573 dzi=dc_norm(3,nres+i)
1574 c dsci_inv=dsc_inv(itypi)
1575 dsci_inv=vbld_inv(i+nres)
1576 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1577 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1579 C Calculate SC interaction energy.
1581 do iint=1,nint_gr(i)
1582 do j=istart(i,iint),iend(i,iint)
1585 c dscj_inv=dsc_inv(itypj)
1586 dscj_inv=vbld_inv(j+nres)
1587 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1588 c & 1.0d0/vbld(j+nres)
1589 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1590 sig0ij=sigma(itypi,itypj)
1591 chi1=chi(itypi,itypj)
1592 chi2=chi(itypj,itypi)
1599 alf12=0.5D0*(alf1+alf2)
1600 C For diagnostics only!!!
1613 dxj=dc_norm(1,nres+j)
1614 dyj=dc_norm(2,nres+j)
1615 dzj=dc_norm(3,nres+j)
1616 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1617 c write (iout,*) "j",j," dc_norm",
1618 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1619 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1621 C Calculate angle-dependent terms of energy and contributions to their
1625 sig=sig0ij*dsqrt(sigsq)
1626 rij_shift=1.0D0/rij-sig+sig0ij
1627 c for diagnostics; uncomment
1628 c rij_shift=1.2*sig0ij
1629 C I hate to put IF's in the loops, but here don't have another choice!!!!
1630 if (rij_shift.le.0.0D0) then
1632 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1633 cd & restyp(itypi),i,restyp(itypj),j,
1634 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1638 c---------------------------------------------------------------
1639 rij_shift=1.0D0/rij_shift
1640 fac=rij_shift**expon
1641 e1=fac*fac*aa(itypi,itypj)
1642 e2=fac*bb(itypi,itypj)
1643 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1644 eps2der=evdwij*eps3rt
1645 eps3der=evdwij*eps2rt
1646 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1647 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1648 evdwij=evdwij*eps2rt*eps3rt
1650 if (bb(itypi,itypj).gt.0) then
1651 evdw_p=evdw_p+evdwij
1653 evdw_m=evdw_m+evdwij
1659 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1660 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1661 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1662 & restyp(itypi),i,restyp(itypj),j,
1663 & epsi,sigm,chi1,chi2,chip1,chip2,
1664 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1665 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1669 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1672 C Calculate gradient components.
1673 e1=e1*eps1*eps2rt**2*eps3rt**2
1674 fac=-expon*(e1+evdwij)*rij_shift
1678 C Calculate the radial part of the gradient
1682 C Calculate angular part of the gradient.
1684 if (bb(itypi,itypj).gt.0) then
1695 c write (iout,*) "Number of loop steps in EGB:",ind
1696 cccc energy_dec=.false.
1699 C-----------------------------------------------------------------------------
1700 subroutine egbv(evdw,evdw_p,evdw_m)
1702 C This subroutine calculates the interaction energy of nonbonded side chains
1703 C assuming the Gay-Berne-Vorobjev potential of interaction.
1705 implicit real*8 (a-h,o-z)
1706 include 'DIMENSIONS'
1707 include 'COMMON.GEO'
1708 include 'COMMON.VAR'
1709 include 'COMMON.LOCAL'
1710 include 'COMMON.CHAIN'
1711 include 'COMMON.DERIV'
1712 include 'COMMON.NAMES'
1713 include 'COMMON.INTERACT'
1714 include 'COMMON.IOUNITS'
1715 include 'COMMON.CALC'
1716 common /srutu/ icall
1719 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1722 c if (icall.eq.0) lprn=.true.
1724 do i=iatsc_s,iatsc_e
1730 dxi=dc_norm(1,nres+i)
1731 dyi=dc_norm(2,nres+i)
1732 dzi=dc_norm(3,nres+i)
1733 c dsci_inv=dsc_inv(itypi)
1734 dsci_inv=vbld_inv(i+nres)
1736 C Calculate SC interaction energy.
1738 do iint=1,nint_gr(i)
1739 do j=istart(i,iint),iend(i,iint)
1742 c dscj_inv=dsc_inv(itypj)
1743 dscj_inv=vbld_inv(j+nres)
1744 sig0ij=sigma(itypi,itypj)
1745 r0ij=r0(itypi,itypj)
1746 chi1=chi(itypi,itypj)
1747 chi2=chi(itypj,itypi)
1754 alf12=0.5D0*(alf1+alf2)
1755 C For diagnostics only!!!
1768 dxj=dc_norm(1,nres+j)
1769 dyj=dc_norm(2,nres+j)
1770 dzj=dc_norm(3,nres+j)
1771 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1773 C Calculate angle-dependent terms of energy and contributions to their
1777 sig=sig0ij*dsqrt(sigsq)
1778 rij_shift=1.0D0/rij-sig+r0ij
1779 C I hate to put IF's in the loops, but here don't have another choice!!!!
1780 if (rij_shift.le.0.0D0) then
1785 c---------------------------------------------------------------
1786 rij_shift=1.0D0/rij_shift
1787 fac=rij_shift**expon
1788 e1=fac*fac*aa(itypi,itypj)
1789 e2=fac*bb(itypi,itypj)
1790 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1791 eps2der=evdwij*eps3rt
1792 eps3der=evdwij*eps2rt
1793 fac_augm=rrij**expon
1794 e_augm=augm(itypi,itypj)*fac_augm
1795 evdwij=evdwij*eps2rt*eps3rt
1797 if (bb(itypi,itypj).gt.0) then
1798 evdw_p=evdw_p+evdwij+e_augm
1800 evdw_m=evdw_m+evdwij+e_augm
1803 evdw=evdw+evdwij+e_augm
1806 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1807 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1808 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1809 & restyp(itypi),i,restyp(itypj),j,
1810 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1811 & chi1,chi2,chip1,chip2,
1812 & eps1,eps2rt**2,eps3rt**2,
1813 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1816 C Calculate gradient components.
1817 e1=e1*eps1*eps2rt**2*eps3rt**2
1818 fac=-expon*(e1+evdwij)*rij_shift
1820 fac=rij*fac-2*expon*rrij*e_augm
1821 C Calculate the radial part of the gradient
1825 C Calculate angular part of the gradient.
1827 if (bb(itypi,itypj).gt.0) then
1839 C-----------------------------------------------------------------------------
1840 subroutine sc_angular
1841 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1842 C om12. Called by ebp, egb, and egbv.
1844 include 'COMMON.CALC'
1845 include 'COMMON.IOUNITS'
1849 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1850 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1851 om12=dxi*dxj+dyi*dyj+dzi*dzj
1853 C Calculate eps1(om12) and its derivative in om12
1854 faceps1=1.0D0-om12*chiom12
1855 faceps1_inv=1.0D0/faceps1
1856 eps1=dsqrt(faceps1_inv)
1857 C Following variable is eps1*deps1/dom12
1858 eps1_om12=faceps1_inv*chiom12
1863 c write (iout,*) "om12",om12," eps1",eps1
1864 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1869 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1870 sigsq=1.0D0-facsig*faceps1_inv
1871 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1872 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1873 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1879 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1880 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1882 C Calculate eps2 and its derivatives in om1, om2, and om12.
1885 chipom12=chip12*om12
1886 facp=1.0D0-om12*chipom12
1888 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1889 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1890 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1891 C Following variable is the square root of eps2
1892 eps2rt=1.0D0-facp1*facp_inv
1893 C Following three variables are the derivatives of the square root of eps
1894 C in om1, om2, and om12.
1895 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1896 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1897 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1898 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1899 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1900 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1901 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1902 c & " eps2rt_om12",eps2rt_om12
1903 C Calculate whole angle-dependent part of epsilon and contributions
1904 C to its derivatives
1908 C----------------------------------------------------------------------------
1909 subroutine sc_grad_T
1910 implicit real*8 (a-h,o-z)
1911 include 'DIMENSIONS'
1912 include 'COMMON.CHAIN'
1913 include 'COMMON.DERIV'
1914 include 'COMMON.CALC'
1915 include 'COMMON.IOUNITS'
1916 double precision dcosom1(3),dcosom2(3)
1917 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1918 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1919 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1920 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1924 c eom12=evdwij*eps1_om12
1926 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1927 c & " sigder",sigder
1928 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1929 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1931 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1932 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1935 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1937 c write (iout,*) "gg",(gg(k),k=1,3)
1939 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1940 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1941 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1942 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1943 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1944 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1945 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1946 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1947 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1948 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1951 C Calculate the components of the gradient in DC and X
1955 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1959 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1960 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1965 C----------------------------------------------------------------------------
1967 implicit real*8 (a-h,o-z)
1968 include 'DIMENSIONS'
1969 include 'COMMON.CHAIN'
1970 include 'COMMON.DERIV'
1971 include 'COMMON.CALC'
1972 include 'COMMON.IOUNITS'
1973 double precision dcosom1(3),dcosom2(3)
1974 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1975 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1976 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1977 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1981 c eom12=evdwij*eps1_om12
1983 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1984 c & " sigder",sigder
1985 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1986 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1988 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1989 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1992 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1994 c write (iout,*) "gg",(gg(k),k=1,3)
1996 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1997 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1998 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1999 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2000 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2001 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2002 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2003 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2004 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2005 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2008 C Calculate the components of the gradient in DC and X
2012 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2016 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2017 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2021 C-----------------------------------------------------------------------
2022 subroutine e_softsphere(evdw)
2024 C This subroutine calculates the interaction energy of nonbonded side chains
2025 C assuming the LJ potential of interaction.
2027 implicit real*8 (a-h,o-z)
2028 include 'DIMENSIONS'
2029 parameter (accur=1.0d-10)
2030 include 'COMMON.GEO'
2031 include 'COMMON.VAR'
2032 include 'COMMON.LOCAL'
2033 include 'COMMON.CHAIN'
2034 include 'COMMON.DERIV'
2035 include 'COMMON.INTERACT'
2036 include 'COMMON.TORSION'
2037 include 'COMMON.SBRIDGE'
2038 include 'COMMON.NAMES'
2039 include 'COMMON.IOUNITS'
2040 include 'COMMON.CONTACTS'
2042 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2044 do i=iatsc_s,iatsc_e
2051 C Calculate SC interaction energy.
2053 do iint=1,nint_gr(i)
2054 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2055 cd & 'iend=',iend(i,iint)
2056 do j=istart(i,iint),iend(i,iint)
2061 rij=xj*xj+yj*yj+zj*zj
2062 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2063 r0ij=r0(itypi,itypj)
2065 c print *,i,j,r0ij,dsqrt(rij)
2066 if (rij.lt.r0ijsq) then
2067 evdwij=0.25d0*(rij-r0ijsq)**2
2075 C Calculate the components of the gradient in DC and X
2081 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2082 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2083 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2084 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2088 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2096 C--------------------------------------------------------------------------
2097 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2100 C Soft-sphere potential of p-p interaction
2102 implicit real*8 (a-h,o-z)
2103 include 'DIMENSIONS'
2104 include 'COMMON.CONTROL'
2105 include 'COMMON.IOUNITS'
2106 include 'COMMON.GEO'
2107 include 'COMMON.VAR'
2108 include 'COMMON.LOCAL'
2109 include 'COMMON.CHAIN'
2110 include 'COMMON.DERIV'
2111 include 'COMMON.INTERACT'
2112 include 'COMMON.CONTACTS'
2113 include 'COMMON.TORSION'
2114 include 'COMMON.VECTORS'
2115 include 'COMMON.FFIELD'
2117 cd write(iout,*) 'In EELEC_soft_sphere'
2124 do i=iatel_s,iatel_e
2128 xmedi=c(1,i)+0.5d0*dxi
2129 ymedi=c(2,i)+0.5d0*dyi
2130 zmedi=c(3,i)+0.5d0*dzi
2132 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2133 do j=ielstart(i),ielend(i)
2137 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2138 r0ij=rpp(iteli,itelj)
2143 xj=c(1,j)+0.5D0*dxj-xmedi
2144 yj=c(2,j)+0.5D0*dyj-ymedi
2145 zj=c(3,j)+0.5D0*dzj-zmedi
2146 rij=xj*xj+yj*yj+zj*zj
2147 if (rij.lt.r0ijsq) then
2148 evdw1ij=0.25d0*(rij-r0ijsq)**2
2156 C Calculate contributions to the Cartesian gradient.
2162 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2163 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2166 * Loop over residues i+1 thru j-1.
2170 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2175 cgrad do i=nnt,nct-1
2177 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2179 cgrad do j=i+1,nct-1
2181 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2187 c------------------------------------------------------------------------------
2188 subroutine vec_and_deriv
2189 implicit real*8 (a-h,o-z)
2190 include 'DIMENSIONS'
2194 include 'COMMON.IOUNITS'
2195 include 'COMMON.GEO'
2196 include 'COMMON.VAR'
2197 include 'COMMON.LOCAL'
2198 include 'COMMON.CHAIN'
2199 include 'COMMON.VECTORS'
2200 include 'COMMON.SETUP'
2201 include 'COMMON.TIME1'
2202 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2203 C Compute the local reference systems. For reference system (i), the
2204 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2205 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2207 do i=ivec_start,ivec_end
2211 if (i.eq.nres-1) then
2212 C Case of the last full residue
2213 C Compute the Z-axis
2214 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2215 costh=dcos(pi-theta(nres))
2216 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2220 C Compute the derivatives of uz
2222 uzder(2,1,1)=-dc_norm(3,i-1)
2223 uzder(3,1,1)= dc_norm(2,i-1)
2224 uzder(1,2,1)= dc_norm(3,i-1)
2226 uzder(3,2,1)=-dc_norm(1,i-1)
2227 uzder(1,3,1)=-dc_norm(2,i-1)
2228 uzder(2,3,1)= dc_norm(1,i-1)
2231 uzder(2,1,2)= dc_norm(3,i)
2232 uzder(3,1,2)=-dc_norm(2,i)
2233 uzder(1,2,2)=-dc_norm(3,i)
2235 uzder(3,2,2)= dc_norm(1,i)
2236 uzder(1,3,2)= dc_norm(2,i)
2237 uzder(2,3,2)=-dc_norm(1,i)
2239 C Compute the Y-axis
2242 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2244 C Compute the derivatives of uy
2247 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2248 & -dc_norm(k,i)*dc_norm(j,i-1)
2249 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2251 uyder(j,j,1)=uyder(j,j,1)-costh
2252 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2257 uygrad(l,k,j,i)=uyder(l,k,j)
2258 uzgrad(l,k,j,i)=uzder(l,k,j)
2262 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2263 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2264 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2265 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2268 C Compute the Z-axis
2269 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2270 costh=dcos(pi-theta(i+2))
2271 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2275 C Compute the derivatives of uz
2277 uzder(2,1,1)=-dc_norm(3,i+1)
2278 uzder(3,1,1)= dc_norm(2,i+1)
2279 uzder(1,2,1)= dc_norm(3,i+1)
2281 uzder(3,2,1)=-dc_norm(1,i+1)
2282 uzder(1,3,1)=-dc_norm(2,i+1)
2283 uzder(2,3,1)= dc_norm(1,i+1)
2286 uzder(2,1,2)= dc_norm(3,i)
2287 uzder(3,1,2)=-dc_norm(2,i)
2288 uzder(1,2,2)=-dc_norm(3,i)
2290 uzder(3,2,2)= dc_norm(1,i)
2291 uzder(1,3,2)= dc_norm(2,i)
2292 uzder(2,3,2)=-dc_norm(1,i)
2294 C Compute the Y-axis
2297 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2299 C Compute the derivatives of uy
2302 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2303 & -dc_norm(k,i)*dc_norm(j,i+1)
2304 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2306 uyder(j,j,1)=uyder(j,j,1)-costh
2307 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2312 uygrad(l,k,j,i)=uyder(l,k,j)
2313 uzgrad(l,k,j,i)=uzder(l,k,j)
2317 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2318 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2319 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2320 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2324 vbld_inv_temp(1)=vbld_inv(i+1)
2325 if (i.lt.nres-1) then
2326 vbld_inv_temp(2)=vbld_inv(i+2)
2328 vbld_inv_temp(2)=vbld_inv(i)
2333 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2334 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2339 #if defined(PARVEC) && defined(MPI)
2340 if (nfgtasks1.gt.1) then
2342 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2343 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2344 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2345 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2346 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2348 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2349 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2351 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2352 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2353 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2354 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2355 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2356 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2357 time_gather=time_gather+MPI_Wtime()-time00
2359 c if (fg_rank.eq.0) then
2360 c write (iout,*) "Arrays UY and UZ"
2362 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2369 C-----------------------------------------------------------------------------
2370 subroutine check_vecgrad
2371 implicit real*8 (a-h,o-z)
2372 include 'DIMENSIONS'
2373 include 'COMMON.IOUNITS'
2374 include 'COMMON.GEO'
2375 include 'COMMON.VAR'
2376 include 'COMMON.LOCAL'
2377 include 'COMMON.CHAIN'
2378 include 'COMMON.VECTORS'
2379 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2380 dimension uyt(3,maxres),uzt(3,maxres)
2381 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2382 double precision delta /1.0d-7/
2385 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2386 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2387 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2388 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2389 cd & (dc_norm(if90,i),if90=1,3)
2390 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2391 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2392 cd write(iout,'(a)')
2398 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2399 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2412 cd write (iout,*) 'i=',i
2414 erij(k)=dc_norm(k,i)
2418 dc_norm(k,i)=erij(k)
2420 dc_norm(j,i)=dc_norm(j,i)+delta
2421 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2423 c dc_norm(k,i)=dc_norm(k,i)/fac
2425 c write (iout,*) (dc_norm(k,i),k=1,3)
2426 c write (iout,*) (erij(k),k=1,3)
2429 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2430 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2431 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2432 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2434 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2435 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2436 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2439 dc_norm(k,i)=erij(k)
2442 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2443 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2444 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2445 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2446 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2447 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2448 cd write (iout,'(a)')
2453 C--------------------------------------------------------------------------
2454 subroutine set_matrices
2455 implicit real*8 (a-h,o-z)
2456 include 'DIMENSIONS'
2459 include "COMMON.SETUP"
2461 integer status(MPI_STATUS_SIZE)
2463 include 'COMMON.IOUNITS'
2464 include 'COMMON.GEO'
2465 include 'COMMON.VAR'
2466 include 'COMMON.LOCAL'
2467 include 'COMMON.CHAIN'
2468 include 'COMMON.DERIV'
2469 include 'COMMON.INTERACT'
2470 include 'COMMON.CONTACTS'
2471 include 'COMMON.TORSION'
2472 include 'COMMON.VECTORS'
2473 include 'COMMON.FFIELD'
2474 double precision auxvec(2),auxmat(2,2)
2476 C Compute the virtual-bond-torsional-angle dependent quantities needed
2477 C to calculate the el-loc multibody terms of various order.
2480 do i=ivec_start+2,ivec_end+2
2484 if (i .lt. nres+1) then
2521 if (i .gt. 3 .and. i .lt. nres+1) then
2522 obrot_der(1,i-2)=-sin1
2523 obrot_der(2,i-2)= cos1
2524 Ugder(1,1,i-2)= sin1
2525 Ugder(1,2,i-2)=-cos1
2526 Ugder(2,1,i-2)=-cos1
2527 Ugder(2,2,i-2)=-sin1
2530 obrot2_der(1,i-2)=-dwasin2
2531 obrot2_der(2,i-2)= dwacos2
2532 Ug2der(1,1,i-2)= dwasin2
2533 Ug2der(1,2,i-2)=-dwacos2
2534 Ug2der(2,1,i-2)=-dwacos2
2535 Ug2der(2,2,i-2)=-dwasin2
2537 obrot_der(1,i-2)=0.0d0
2538 obrot_der(2,i-2)=0.0d0
2539 Ugder(1,1,i-2)=0.0d0
2540 Ugder(1,2,i-2)=0.0d0
2541 Ugder(2,1,i-2)=0.0d0
2542 Ugder(2,2,i-2)=0.0d0
2543 obrot2_der(1,i-2)=0.0d0
2544 obrot2_der(2,i-2)=0.0d0
2545 Ug2der(1,1,i-2)=0.0d0
2546 Ug2der(1,2,i-2)=0.0d0
2547 Ug2der(2,1,i-2)=0.0d0
2548 Ug2der(2,2,i-2)=0.0d0
2550 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2551 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2552 iti = itortyp(itype(i-2))
2556 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2557 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2558 iti1 = itortyp(itype(i-1))
2562 cd write (iout,*) '*******i',i,' iti1',iti
2563 cd write (iout,*) 'b1',b1(:,iti)
2564 cd write (iout,*) 'b2',b2(:,iti)
2565 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2566 c if (i .gt. iatel_s+2) then
2567 if (i .gt. nnt+2) then
2568 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2569 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2570 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2572 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2573 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2574 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2575 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2576 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2587 DtUg2(l,k,i-2)=0.0d0
2591 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2592 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2594 muder(k,i-2)=Ub2der(k,i-2)
2596 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2597 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2598 iti1 = itortyp(itype(i-1))
2603 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2605 cd write (iout,*) 'mu ',mu(:,i-2)
2606 cd write (iout,*) 'mu1',mu1(:,i-2)
2607 cd write (iout,*) 'mu2',mu2(:,i-2)
2608 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2610 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2611 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2612 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2613 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2614 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2615 C Vectors and matrices dependent on a single virtual-bond dihedral.
2616 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2617 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2618 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2619 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2620 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2621 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2622 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2623 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2624 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2627 C Matrices dependent on two consecutive virtual-bond dihedrals.
2628 C The order of matrices is from left to right.
2629 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2631 c do i=max0(ivec_start,2),ivec_end
2633 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2634 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2635 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2636 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2637 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2638 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2639 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2640 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2643 #if defined(MPI) && defined(PARMAT)
2645 c if (fg_rank.eq.0) then
2646 write (iout,*) "Arrays UG and UGDER before GATHER"
2648 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2649 & ((ug(l,k,i),l=1,2),k=1,2),
2650 & ((ugder(l,k,i),l=1,2),k=1,2)
2652 write (iout,*) "Arrays UG2 and UG2DER"
2654 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2655 & ((ug2(l,k,i),l=1,2),k=1,2),
2656 & ((ug2der(l,k,i),l=1,2),k=1,2)
2658 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2660 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2661 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2662 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2664 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2666 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2667 & costab(i),sintab(i),costab2(i),sintab2(i)
2669 write (iout,*) "Array MUDER"
2671 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2675 if (nfgtasks.gt.1) then
2677 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2678 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2679 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2681 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2682 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2684 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2694 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2696 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2697 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2699 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2700 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2701 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2702 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2703 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2704 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2705 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2706 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2707 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2708 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2709 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2710 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2711 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2713 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2714 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2716 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2717 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2719 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2722 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2725 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2728 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2729 & ivec_count(fg_rank1),
2730 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2732 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2733 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2735 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2736 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2738 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2739 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2741 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2742 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2744 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2745 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2747 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2748 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2750 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2751 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2753 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2754 & ivec_count(fg_rank1),
2755 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2757 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2758 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2760 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2761 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2763 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2764 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2766 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2767 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2769 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2770 & ivec_count(fg_rank1),
2771 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2773 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2774 & ivec_count(fg_rank1),
2775 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2777 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2778 & ivec_count(fg_rank1),
2779 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2780 & MPI_MAT2,FG_COMM1,IERR)
2781 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2782 & ivec_count(fg_rank1),
2783 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2784 & MPI_MAT2,FG_COMM1,IERR)
2787 c Passes matrix info through the ring
2790 if (irecv.lt.0) irecv=nfgtasks1-1
2793 if (inext.ge.nfgtasks1) inext=0
2795 c write (iout,*) "isend",isend," irecv",irecv
2797 lensend=lentyp(isend)
2798 lenrecv=lentyp(irecv)
2799 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2800 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2801 c & MPI_ROTAT1(lensend),inext,2200+isend,
2802 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2803 c & iprev,2200+irecv,FG_COMM,status,IERR)
2804 c write (iout,*) "Gather ROTAT1"
2806 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2807 c & MPI_ROTAT2(lensend),inext,3300+isend,
2808 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2809 c & iprev,3300+irecv,FG_COMM,status,IERR)
2810 c write (iout,*) "Gather ROTAT2"
2812 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2813 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2814 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2815 & iprev,4400+irecv,FG_COMM,status,IERR)
2816 c write (iout,*) "Gather ROTAT_OLD"
2818 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2819 & MPI_PRECOMP11(lensend),inext,5500+isend,
2820 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2821 & iprev,5500+irecv,FG_COMM,status,IERR)
2822 c write (iout,*) "Gather PRECOMP11"
2824 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2825 & MPI_PRECOMP12(lensend),inext,6600+isend,
2826 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2827 & iprev,6600+irecv,FG_COMM,status,IERR)
2828 c write (iout,*) "Gather PRECOMP12"
2830 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2832 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2833 & MPI_ROTAT2(lensend),inext,7700+isend,
2834 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2835 & iprev,7700+irecv,FG_COMM,status,IERR)
2836 c write (iout,*) "Gather PRECOMP21"
2838 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2839 & MPI_PRECOMP22(lensend),inext,8800+isend,
2840 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2841 & iprev,8800+irecv,FG_COMM,status,IERR)
2842 c write (iout,*) "Gather PRECOMP22"
2844 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2845 & MPI_PRECOMP23(lensend),inext,9900+isend,
2846 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2847 & MPI_PRECOMP23(lenrecv),
2848 & iprev,9900+irecv,FG_COMM,status,IERR)
2849 c write (iout,*) "Gather PRECOMP23"
2854 if (irecv.lt.0) irecv=nfgtasks1-1
2857 time_gather=time_gather+MPI_Wtime()-time00
2860 c if (fg_rank.eq.0) then
2861 write (iout,*) "Arrays UG and UGDER"
2863 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2864 & ((ug(l,k,i),l=1,2),k=1,2),
2865 & ((ugder(l,k,i),l=1,2),k=1,2)
2867 write (iout,*) "Arrays UG2 and UG2DER"
2869 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2870 & ((ug2(l,k,i),l=1,2),k=1,2),
2871 & ((ug2der(l,k,i),l=1,2),k=1,2)
2873 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2875 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2876 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2877 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2879 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2881 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2882 & costab(i),sintab(i),costab2(i),sintab2(i)
2884 write (iout,*) "Array MUDER"
2886 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2892 cd iti = itortyp(itype(i))
2895 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2896 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2901 C--------------------------------------------------------------------------
2902 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2904 C This subroutine calculates the average interaction energy and its gradient
2905 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2906 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2907 C The potential depends both on the distance of peptide-group centers and on
2908 C the orientation of the CA-CA virtual bonds.
2910 implicit real*8 (a-h,o-z)
2914 include 'DIMENSIONS'
2915 include 'COMMON.CONTROL'
2916 include 'COMMON.SETUP'
2917 include 'COMMON.IOUNITS'
2918 include 'COMMON.GEO'
2919 include 'COMMON.VAR'
2920 include 'COMMON.LOCAL'
2921 include 'COMMON.CHAIN'
2922 include 'COMMON.DERIV'
2923 include 'COMMON.INTERACT'
2924 include 'COMMON.CONTACTS'
2925 include 'COMMON.TORSION'
2926 include 'COMMON.VECTORS'
2927 include 'COMMON.FFIELD'
2928 include 'COMMON.TIME1'
2929 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2930 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2931 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2932 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2933 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2934 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2936 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2938 double precision scal_el /1.0d0/
2940 double precision scal_el /0.5d0/
2943 C 13-go grudnia roku pamietnego...
2944 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2945 & 0.0d0,1.0d0,0.0d0,
2946 & 0.0d0,0.0d0,1.0d0/
2947 cd write(iout,*) 'In EELEC'
2949 cd write(iout,*) 'Type',i
2950 cd write(iout,*) 'B1',B1(:,i)
2951 cd write(iout,*) 'B2',B2(:,i)
2952 cd write(iout,*) 'CC',CC(:,:,i)
2953 cd write(iout,*) 'DD',DD(:,:,i)
2954 cd write(iout,*) 'EE',EE(:,:,i)
2956 cd call check_vecgrad
2958 if (icheckgrad.eq.1) then
2960 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2962 dc_norm(k,i)=dc(k,i)*fac
2964 c write (iout,*) 'i',i,' fac',fac
2967 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2968 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2969 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2970 c call vec_and_deriv
2976 time_mat=time_mat+MPI_Wtime()-time01
2980 cd write (iout,*) 'i=',i
2982 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2985 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2986 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2999 cd print '(a)','Enter EELEC'
3000 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3002 gel_loc_loc(i)=0.0d0
3007 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3009 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3011 do i=iturn3_start,iturn3_end
3015 dx_normi=dc_norm(1,i)
3016 dy_normi=dc_norm(2,i)
3017 dz_normi=dc_norm(3,i)
3018 xmedi=c(1,i)+0.5d0*dxi
3019 ymedi=c(2,i)+0.5d0*dyi
3020 zmedi=c(3,i)+0.5d0*dzi
3022 call eelecij(i,i+2,ees,evdw1,eel_loc)
3023 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3024 num_cont_hb(i)=num_conti
3026 do i=iturn4_start,iturn4_end
3030 dx_normi=dc_norm(1,i)
3031 dy_normi=dc_norm(2,i)
3032 dz_normi=dc_norm(3,i)
3033 xmedi=c(1,i)+0.5d0*dxi
3034 ymedi=c(2,i)+0.5d0*dyi
3035 zmedi=c(3,i)+0.5d0*dzi
3036 num_conti=num_cont_hb(i)
3037 call eelecij(i,i+3,ees,evdw1,eel_loc)
3038 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3039 num_cont_hb(i)=num_conti
3042 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3044 do i=iatel_s,iatel_e
3048 dx_normi=dc_norm(1,i)
3049 dy_normi=dc_norm(2,i)
3050 dz_normi=dc_norm(3,i)
3051 xmedi=c(1,i)+0.5d0*dxi
3052 ymedi=c(2,i)+0.5d0*dyi
3053 zmedi=c(3,i)+0.5d0*dzi
3054 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3055 num_conti=num_cont_hb(i)
3056 do j=ielstart(i),ielend(i)
3057 call eelecij(i,j,ees,evdw1,eel_loc)
3059 num_cont_hb(i)=num_conti
3061 c write (iout,*) "Number of loop steps in EELEC:",ind
3063 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3064 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3066 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3067 ccc eel_loc=eel_loc+eello_turn3
3068 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3071 C-------------------------------------------------------------------------------
3072 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3073 implicit real*8 (a-h,o-z)
3074 include 'DIMENSIONS'
3078 include 'COMMON.CONTROL'
3079 include 'COMMON.IOUNITS'
3080 include 'COMMON.GEO'
3081 include 'COMMON.VAR'
3082 include 'COMMON.LOCAL'
3083 include 'COMMON.CHAIN'
3084 include 'COMMON.DERIV'
3085 include 'COMMON.INTERACT'
3086 include 'COMMON.CONTACTS'
3087 include 'COMMON.TORSION'
3088 include 'COMMON.VECTORS'
3089 include 'COMMON.FFIELD'
3090 include 'COMMON.TIME1'
3091 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3092 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3093 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3094 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3095 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3096 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3098 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3100 double precision scal_el /1.0d0/
3102 double precision scal_el /0.5d0/
3105 C 13-go grudnia roku pamietnego...
3106 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3107 & 0.0d0,1.0d0,0.0d0,
3108 & 0.0d0,0.0d0,1.0d0/
3109 c time00=MPI_Wtime()
3110 cd write (iout,*) "eelecij",i,j
3114 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3115 aaa=app(iteli,itelj)
3116 bbb=bpp(iteli,itelj)
3117 ael6i=ael6(iteli,itelj)
3118 ael3i=ael3(iteli,itelj)
3122 dx_normj=dc_norm(1,j)
3123 dy_normj=dc_norm(2,j)
3124 dz_normj=dc_norm(3,j)
3125 xj=c(1,j)+0.5D0*dxj-xmedi
3126 yj=c(2,j)+0.5D0*dyj-ymedi
3127 zj=c(3,j)+0.5D0*dzj-zmedi
3128 rij=xj*xj+yj*yj+zj*zj
3134 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3135 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3136 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3137 fac=cosa-3.0D0*cosb*cosg
3139 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3140 if (j.eq.i+2) ev1=scal_el*ev1
3145 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3148 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3149 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3152 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3153 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3154 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3155 cd & xmedi,ymedi,zmedi,xj,yj,zj
3157 if (energy_dec) then
3158 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3159 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3163 C Calculate contributions to the Cartesian gradient.
3166 facvdw=-6*rrmij*(ev1+evdwij)
3167 facel=-3*rrmij*(el1+eesij)
3173 * Radial derivatives. First process both termini of the fragment (i,j)
3179 c ghalf=0.5D0*ggg(k)
3180 c gelc(k,i)=gelc(k,i)+ghalf
3181 c gelc(k,j)=gelc(k,j)+ghalf
3183 c 9/28/08 AL Gradient compotents will be summed only at the end
3185 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3186 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3189 * Loop over residues i+1 thru j-1.
3193 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3200 c ghalf=0.5D0*ggg(k)
3201 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3202 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3204 c 9/28/08 AL Gradient compotents will be summed only at the end
3206 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3207 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3210 * Loop over residues i+1 thru j-1.
3214 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3221 fac=-3*rrmij*(facvdw+facvdw+facel)
3226 * Radial derivatives. First process both termini of the fragment (i,j)
3232 c ghalf=0.5D0*ggg(k)
3233 c gelc(k,i)=gelc(k,i)+ghalf
3234 c gelc(k,j)=gelc(k,j)+ghalf
3236 c 9/28/08 AL Gradient compotents will be summed only at the end
3238 gelc_long(k,j)=gelc(k,j)+ggg(k)
3239 gelc_long(k,i)=gelc(k,i)-ggg(k)
3242 * Loop over residues i+1 thru j-1.
3246 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3249 c 9/28/08 AL Gradient compotents will be summed only at the end
3254 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3255 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3261 ecosa=2.0D0*fac3*fac1+fac4
3264 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3265 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3267 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3268 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3270 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3271 cd & (dcosg(k),k=1,3)
3273 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3276 c ghalf=0.5D0*ggg(k)
3277 c gelc(k,i)=gelc(k,i)+ghalf
3278 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3279 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3280 c gelc(k,j)=gelc(k,j)+ghalf
3281 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3282 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3286 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3291 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3292 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3294 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3295 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3296 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3297 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3299 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3300 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3301 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3303 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3304 C energy of a peptide unit is assumed in the form of a second-order
3305 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3306 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3307 C are computed for EVERY pair of non-contiguous peptide groups.
3309 if (j.lt.nres-1) then
3320 muij(kkk)=mu(k,i)*mu(l,j)
3323 cd write (iout,*) 'EELEC: i',i,' j',j
3324 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3325 cd write(iout,*) 'muij',muij
3326 ury=scalar(uy(1,i),erij)
3327 urz=scalar(uz(1,i),erij)
3328 vry=scalar(uy(1,j),erij)
3329 vrz=scalar(uz(1,j),erij)
3330 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3331 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3332 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3333 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3334 fac=dsqrt(-ael6i)*r3ij
3339 cd write (iout,'(4i5,4f10.5)')
3340 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3341 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3342 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3343 cd & uy(:,j),uz(:,j)
3344 cd write (iout,'(4f10.5)')
3345 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3346 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3347 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3348 cd write (iout,'(9f10.5/)')
3349 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3350 C Derivatives of the elements of A in virtual-bond vectors
3351 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3353 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3354 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3355 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3356 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3357 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3358 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3359 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3360 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3361 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3362 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3363 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3364 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3366 C Compute radial contributions to the gradient
3384 C Add the contributions coming from er
3387 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3388 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3389 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3390 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3393 C Derivatives in DC(i)
3394 cgrad ghalf1=0.5d0*agg(k,1)
3395 cgrad ghalf2=0.5d0*agg(k,2)
3396 cgrad ghalf3=0.5d0*agg(k,3)
3397 cgrad ghalf4=0.5d0*agg(k,4)
3398 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3399 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3400 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3401 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3402 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3403 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3404 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3405 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3406 C Derivatives in DC(i+1)
3407 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3408 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3409 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3410 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3411 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3412 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3413 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3414 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3415 C Derivatives in DC(j)
3416 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3417 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3418 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3419 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3420 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3421 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3422 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3423 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3424 C Derivatives in DC(j+1) or DC(nres-1)
3425 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3426 & -3.0d0*vryg(k,3)*ury)
3427 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3428 & -3.0d0*vrzg(k,3)*ury)
3429 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3430 & -3.0d0*vryg(k,3)*urz)
3431 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3432 & -3.0d0*vrzg(k,3)*urz)
3433 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3435 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3448 aggi(k,l)=-aggi(k,l)
3449 aggi1(k,l)=-aggi1(k,l)
3450 aggj(k,l)=-aggj(k,l)
3451 aggj1(k,l)=-aggj1(k,l)
3454 if (j.lt.nres-1) then
3460 aggi(k,l)=-aggi(k,l)
3461 aggi1(k,l)=-aggi1(k,l)
3462 aggj(k,l)=-aggj(k,l)
3463 aggj1(k,l)=-aggj1(k,l)
3474 aggi(k,l)=-aggi(k,l)
3475 aggi1(k,l)=-aggi1(k,l)
3476 aggj(k,l)=-aggj(k,l)
3477 aggj1(k,l)=-aggj1(k,l)
3482 IF (wel_loc.gt.0.0d0) THEN
3483 C Contribution to the local-electrostatic energy coming from the i-j pair
3484 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3486 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3488 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3489 & 'eelloc',i,j,eel_loc_ij
3491 eel_loc=eel_loc+eel_loc_ij
3492 C Partial derivatives in virtual-bond dihedral angles gamma
3494 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3495 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3496 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3497 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3498 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3499 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3500 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3502 ggg(l)=agg(l,1)*muij(1)+
3503 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3504 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3505 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3506 cgrad ghalf=0.5d0*ggg(l)
3507 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3508 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3512 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3515 C Remaining derivatives of eello
3517 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3518 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3519 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3520 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3521 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3522 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3523 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3524 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3527 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3528 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3529 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3530 & .and. num_conti.le.maxconts) then
3531 c write (iout,*) i,j," entered corr"
3533 C Calculate the contact function. The ith column of the array JCONT will
3534 C contain the numbers of atoms that make contacts with the atom I (of numbers
3535 C greater than I). The arrays FACONT and GACONT will contain the values of
3536 C the contact function and its derivative.
3537 c r0ij=1.02D0*rpp(iteli,itelj)
3538 c r0ij=1.11D0*rpp(iteli,itelj)
3539 r0ij=2.20D0*rpp(iteli,itelj)
3540 c r0ij=1.55D0*rpp(iteli,itelj)
3541 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3542 if (fcont.gt.0.0D0) then
3543 num_conti=num_conti+1
3544 if (num_conti.gt.maxconts) then
3545 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3546 & ' will skip next contacts for this conf.'
3548 jcont_hb(num_conti,i)=j
3549 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3550 cd & " jcont_hb",jcont_hb(num_conti,i)
3551 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3552 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3553 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3555 d_cont(num_conti,i)=rij
3556 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3557 C --- Electrostatic-interaction matrix ---
3558 a_chuj(1,1,num_conti,i)=a22
3559 a_chuj(1,2,num_conti,i)=a23
3560 a_chuj(2,1,num_conti,i)=a32
3561 a_chuj(2,2,num_conti,i)=a33
3562 C --- Gradient of rij
3564 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3571 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3572 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3573 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3574 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3575 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3580 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3581 C Calculate contact energies
3583 wij=cosa-3.0D0*cosb*cosg
3586 c fac3=dsqrt(-ael6i)/r0ij**3
3587 fac3=dsqrt(-ael6i)*r3ij
3588 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3589 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3590 if (ees0tmp.gt.0) then
3591 ees0pij=dsqrt(ees0tmp)
3595 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3596 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3597 if (ees0tmp.gt.0) then
3598 ees0mij=dsqrt(ees0tmp)
3603 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3604 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3605 C Diagnostics. Comment out or remove after debugging!
3606 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3607 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3608 c ees0m(num_conti,i)=0.0D0
3610 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3611 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3612 C Angular derivatives of the contact function
3613 ees0pij1=fac3/ees0pij
3614 ees0mij1=fac3/ees0mij
3615 fac3p=-3.0D0*fac3*rrmij
3616 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3617 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3619 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3620 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3621 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3622 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3623 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3624 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3625 ecosap=ecosa1+ecosa2
3626 ecosbp=ecosb1+ecosb2
3627 ecosgp=ecosg1+ecosg2
3628 ecosam=ecosa1-ecosa2
3629 ecosbm=ecosb1-ecosb2
3630 ecosgm=ecosg1-ecosg2
3639 facont_hb(num_conti,i)=fcont
3640 fprimcont=fprimcont/rij
3641 cd facont_hb(num_conti,i)=1.0D0
3642 C Following line is for diagnostics.
3645 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3646 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3649 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3650 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3652 gggp(1)=gggp(1)+ees0pijp*xj
3653 gggp(2)=gggp(2)+ees0pijp*yj
3654 gggp(3)=gggp(3)+ees0pijp*zj
3655 gggm(1)=gggm(1)+ees0mijp*xj
3656 gggm(2)=gggm(2)+ees0mijp*yj
3657 gggm(3)=gggm(3)+ees0mijp*zj
3658 C Derivatives due to the contact function
3659 gacont_hbr(1,num_conti,i)=fprimcont*xj
3660 gacont_hbr(2,num_conti,i)=fprimcont*yj
3661 gacont_hbr(3,num_conti,i)=fprimcont*zj
3664 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3665 c following the change of gradient-summation algorithm.
3667 cgrad ghalfp=0.5D0*gggp(k)
3668 cgrad ghalfm=0.5D0*gggm(k)
3669 gacontp_hb1(k,num_conti,i)=!ghalfp
3670 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3671 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3672 gacontp_hb2(k,num_conti,i)=!ghalfp
3673 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3674 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3675 gacontp_hb3(k,num_conti,i)=gggp(k)
3676 gacontm_hb1(k,num_conti,i)=!ghalfm
3677 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3678 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3679 gacontm_hb2(k,num_conti,i)=!ghalfm
3680 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3681 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3682 gacontm_hb3(k,num_conti,i)=gggm(k)
3684 C Diagnostics. Comment out or remove after debugging!
3686 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3687 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3688 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3689 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3690 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3691 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3694 endif ! num_conti.le.maxconts
3697 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3700 ghalf=0.5d0*agg(l,k)
3701 aggi(l,k)=aggi(l,k)+ghalf
3702 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3703 aggj(l,k)=aggj(l,k)+ghalf
3706 if (j.eq.nres-1 .and. i.lt.j-2) then
3709 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3714 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3717 C-----------------------------------------------------------------------------
3718 subroutine eturn3(i,eello_turn3)
3719 C Third- and fourth-order contributions from turns
3720 implicit real*8 (a-h,o-z)
3721 include 'DIMENSIONS'
3722 include 'COMMON.IOUNITS'
3723 include 'COMMON.GEO'
3724 include 'COMMON.VAR'
3725 include 'COMMON.LOCAL'
3726 include 'COMMON.CHAIN'
3727 include 'COMMON.DERIV'
3728 include 'COMMON.INTERACT'
3729 include 'COMMON.CONTACTS'
3730 include 'COMMON.TORSION'
3731 include 'COMMON.VECTORS'
3732 include 'COMMON.FFIELD'
3733 include 'COMMON.CONTROL'
3735 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3736 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3737 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3738 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3739 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3740 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3741 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3744 c write (iout,*) "eturn3",i,j,j1,j2
3749 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3751 C Third-order contributions
3758 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3759 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3760 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3761 call transpose2(auxmat(1,1),auxmat1(1,1))
3762 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3763 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3764 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3765 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3766 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3767 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3768 cd & ' eello_turn3_num',4*eello_turn3_num
3769 C Derivatives in gamma(i)
3770 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3771 call transpose2(auxmat2(1,1),auxmat3(1,1))
3772 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3773 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3774 C Derivatives in gamma(i+1)
3775 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3776 call transpose2(auxmat2(1,1),auxmat3(1,1))
3777 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3778 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3779 & +0.5d0*(pizda(1,1)+pizda(2,2))
3780 C Cartesian derivatives
3782 c ghalf1=0.5d0*agg(l,1)
3783 c ghalf2=0.5d0*agg(l,2)
3784 c ghalf3=0.5d0*agg(l,3)
3785 c ghalf4=0.5d0*agg(l,4)
3786 a_temp(1,1)=aggi(l,1)!+ghalf1
3787 a_temp(1,2)=aggi(l,2)!+ghalf2
3788 a_temp(2,1)=aggi(l,3)!+ghalf3
3789 a_temp(2,2)=aggi(l,4)!+ghalf4
3790 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3791 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3792 & +0.5d0*(pizda(1,1)+pizda(2,2))
3793 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3794 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3795 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3796 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3797 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3798 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3799 & +0.5d0*(pizda(1,1)+pizda(2,2))
3800 a_temp(1,1)=aggj(l,1)!+ghalf1
3801 a_temp(1,2)=aggj(l,2)!+ghalf2
3802 a_temp(2,1)=aggj(l,3)!+ghalf3
3803 a_temp(2,2)=aggj(l,4)!+ghalf4
3804 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3805 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3806 & +0.5d0*(pizda(1,1)+pizda(2,2))
3807 a_temp(1,1)=aggj1(l,1)
3808 a_temp(1,2)=aggj1(l,2)
3809 a_temp(2,1)=aggj1(l,3)
3810 a_temp(2,2)=aggj1(l,4)
3811 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3812 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3813 & +0.5d0*(pizda(1,1)+pizda(2,2))
3817 C-------------------------------------------------------------------------------
3818 subroutine eturn4(i,eello_turn4)
3819 C Third- and fourth-order contributions from turns
3820 implicit real*8 (a-h,o-z)
3821 include 'DIMENSIONS'
3822 include 'COMMON.IOUNITS'
3823 include 'COMMON.GEO'
3824 include 'COMMON.VAR'
3825 include 'COMMON.LOCAL'
3826 include 'COMMON.CHAIN'
3827 include 'COMMON.DERIV'
3828 include 'COMMON.INTERACT'
3829 include 'COMMON.CONTACTS'
3830 include 'COMMON.TORSION'
3831 include 'COMMON.VECTORS'
3832 include 'COMMON.FFIELD'
3833 include 'COMMON.CONTROL'
3835 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3836 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3837 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3838 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3839 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3840 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3841 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3844 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3846 C Fourth-order contributions
3854 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3855 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3856 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3861 iti1=itortyp(itype(i+1))
3862 iti2=itortyp(itype(i+2))
3863 iti3=itortyp(itype(i+3))
3864 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3865 call transpose2(EUg(1,1,i+1),e1t(1,1))
3866 call transpose2(Eug(1,1,i+2),e2t(1,1))
3867 call transpose2(Eug(1,1,i+3),e3t(1,1))
3868 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3869 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3870 s1=scalar2(b1(1,iti2),auxvec(1))
3871 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3872 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3873 s2=scalar2(b1(1,iti1),auxvec(1))
3874 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3875 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3876 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3877 eello_turn4=eello_turn4-(s1+s2+s3)
3878 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3879 & 'eturn4',i,j,-(s1+s2+s3)
3880 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3881 cd & ' eello_turn4_num',8*eello_turn4_num
3882 C Derivatives in gamma(i)
3883 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3884 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3885 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3886 s1=scalar2(b1(1,iti2),auxvec(1))
3887 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3888 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3889 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3890 C Derivatives in gamma(i+1)
3891 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3892 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3893 s2=scalar2(b1(1,iti1),auxvec(1))
3894 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3895 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3896 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3897 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3898 C Derivatives in gamma(i+2)
3899 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3900 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3901 s1=scalar2(b1(1,iti2),auxvec(1))
3902 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3903 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3904 s2=scalar2(b1(1,iti1),auxvec(1))
3905 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3906 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3907 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3908 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3909 C Cartesian derivatives
3910 C Derivatives of this turn contributions in DC(i+2)
3911 if (j.lt.nres-1) then
3913 a_temp(1,1)=agg(l,1)
3914 a_temp(1,2)=agg(l,2)
3915 a_temp(2,1)=agg(l,3)
3916 a_temp(2,2)=agg(l,4)
3917 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3918 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3919 s1=scalar2(b1(1,iti2),auxvec(1))
3920 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3921 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3922 s2=scalar2(b1(1,iti1),auxvec(1))
3923 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3924 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3925 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3927 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3930 C Remaining derivatives of this turn contribution
3932 a_temp(1,1)=aggi(l,1)
3933 a_temp(1,2)=aggi(l,2)
3934 a_temp(2,1)=aggi(l,3)
3935 a_temp(2,2)=aggi(l,4)
3936 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3937 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3938 s1=scalar2(b1(1,iti2),auxvec(1))
3939 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3940 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3941 s2=scalar2(b1(1,iti1),auxvec(1))
3942 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3943 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3944 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3945 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3946 a_temp(1,1)=aggi1(l,1)
3947 a_temp(1,2)=aggi1(l,2)
3948 a_temp(2,1)=aggi1(l,3)
3949 a_temp(2,2)=aggi1(l,4)
3950 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3951 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3952 s1=scalar2(b1(1,iti2),auxvec(1))
3953 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3954 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3955 s2=scalar2(b1(1,iti1),auxvec(1))
3956 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3957 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3958 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3959 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3960 a_temp(1,1)=aggj(l,1)
3961 a_temp(1,2)=aggj(l,2)
3962 a_temp(2,1)=aggj(l,3)
3963 a_temp(2,2)=aggj(l,4)
3964 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3965 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3966 s1=scalar2(b1(1,iti2),auxvec(1))
3967 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3968 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3969 s2=scalar2(b1(1,iti1),auxvec(1))
3970 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3971 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3972 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3973 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3974 a_temp(1,1)=aggj1(l,1)
3975 a_temp(1,2)=aggj1(l,2)
3976 a_temp(2,1)=aggj1(l,3)
3977 a_temp(2,2)=aggj1(l,4)
3978 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3979 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3980 s1=scalar2(b1(1,iti2),auxvec(1))
3981 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3982 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3983 s2=scalar2(b1(1,iti1),auxvec(1))
3984 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3985 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3986 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3987 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3988 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3992 C-----------------------------------------------------------------------------
3993 subroutine vecpr(u,v,w)
3994 implicit real*8(a-h,o-z)
3995 dimension u(3),v(3),w(3)
3996 w(1)=u(2)*v(3)-u(3)*v(2)
3997 w(2)=-u(1)*v(3)+u(3)*v(1)
3998 w(3)=u(1)*v(2)-u(2)*v(1)
4001 C-----------------------------------------------------------------------------
4002 subroutine unormderiv(u,ugrad,unorm,ungrad)
4003 C This subroutine computes the derivatives of a normalized vector u, given
4004 C the derivatives computed without normalization conditions, ugrad. Returns
4007 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4008 double precision vec(3)
4009 double precision scalar
4011 c write (2,*) 'ugrad',ugrad
4014 vec(i)=scalar(ugrad(1,i),u(1))
4016 c write (2,*) 'vec',vec
4019 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4022 c write (2,*) 'ungrad',ungrad
4025 C-----------------------------------------------------------------------------
4026 subroutine escp_soft_sphere(evdw2,evdw2_14)
4028 C This subroutine calculates the excluded-volume interaction energy between
4029 C peptide-group centers and side chains and its gradient in virtual-bond and
4030 C side-chain vectors.
4032 implicit real*8 (a-h,o-z)
4033 include 'DIMENSIONS'
4034 include 'COMMON.GEO'
4035 include 'COMMON.VAR'
4036 include 'COMMON.LOCAL'
4037 include 'COMMON.CHAIN'
4038 include 'COMMON.DERIV'
4039 include 'COMMON.INTERACT'
4040 include 'COMMON.FFIELD'
4041 include 'COMMON.IOUNITS'
4042 include 'COMMON.CONTROL'
4047 cd print '(a)','Enter ESCP'
4048 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4049 do i=iatscp_s,iatscp_e
4051 xi=0.5D0*(c(1,i)+c(1,i+1))
4052 yi=0.5D0*(c(2,i)+c(2,i+1))
4053 zi=0.5D0*(c(3,i)+c(3,i+1))
4055 do iint=1,nscp_gr(i)
4057 do j=iscpstart(i,iint),iscpend(i,iint)
4059 C Uncomment following three lines for SC-p interactions
4063 C Uncomment following three lines for Ca-p interactions
4067 rij=xj*xj+yj*yj+zj*zj
4070 if (rij.lt.r0ijsq) then
4071 evdwij=0.25d0*(rij-r0ijsq)**2
4079 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4084 cgrad if (j.lt.i) then
4085 cd write (iout,*) 'j<i'
4086 C Uncomment following three lines for SC-p interactions
4088 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4091 cd write (iout,*) 'j>i'
4093 cgrad ggg(k)=-ggg(k)
4094 C Uncomment following line for SC-p interactions
4095 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4099 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4101 cgrad kstart=min0(i+1,j)
4102 cgrad kend=max0(i-1,j-1)
4103 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4104 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4105 cgrad do k=kstart,kend
4107 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4111 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4112 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4120 C-----------------------------------------------------------------------------
4121 subroutine escp(evdw2,evdw2_14)
4123 C This subroutine calculates the excluded-volume interaction energy between
4124 C peptide-group centers and side chains and its gradient in virtual-bond and
4125 C side-chain vectors.
4127 implicit real*8 (a-h,o-z)
4128 include 'DIMENSIONS'
4129 include 'COMMON.GEO'
4130 include 'COMMON.VAR'
4131 include 'COMMON.LOCAL'
4132 include 'COMMON.CHAIN'
4133 include 'COMMON.DERIV'
4134 include 'COMMON.INTERACT'
4135 include 'COMMON.FFIELD'
4136 include 'COMMON.IOUNITS'
4137 include 'COMMON.CONTROL'
4141 cd print '(a)','Enter ESCP'
4142 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4143 do i=iatscp_s,iatscp_e
4145 xi=0.5D0*(c(1,i)+c(1,i+1))
4146 yi=0.5D0*(c(2,i)+c(2,i+1))
4147 zi=0.5D0*(c(3,i)+c(3,i+1))
4149 do iint=1,nscp_gr(i)
4151 do j=iscpstart(i,iint),iscpend(i,iint)
4153 C Uncomment following three lines for SC-p interactions
4157 C Uncomment following three lines for Ca-p interactions
4161 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4163 e1=fac*fac*aad(itypj,iteli)
4164 e2=fac*bad(itypj,iteli)
4165 if (iabs(j-i) .le. 2) then
4168 evdw2_14=evdw2_14+e1+e2
4172 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4173 & 'evdw2',i,j,evdwij
4175 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4177 fac=-(evdwij+e1)*rrij
4181 cgrad if (j.lt.i) then
4182 cd write (iout,*) 'j<i'
4183 C Uncomment following three lines for SC-p interactions
4185 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4188 cd write (iout,*) 'j>i'
4190 cgrad ggg(k)=-ggg(k)
4191 C Uncomment following line for SC-p interactions
4192 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4193 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4197 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4199 cgrad kstart=min0(i+1,j)
4200 cgrad kend=max0(i-1,j-1)
4201 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4202 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4203 cgrad do k=kstart,kend
4205 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4209 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4210 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4218 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4219 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4220 gradx_scp(j,i)=expon*gradx_scp(j,i)
4223 C******************************************************************************
4227 C To save time the factor EXPON has been extracted from ALL components
4228 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4231 C******************************************************************************
4234 C--------------------------------------------------------------------------
4235 subroutine edis(ehpb)
4237 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4239 implicit real*8 (a-h,o-z)
4240 include 'DIMENSIONS'
4241 include 'COMMON.SBRIDGE'
4242 include 'COMMON.CHAIN'
4243 include 'COMMON.DERIV'
4244 include 'COMMON.VAR'
4245 include 'COMMON.INTERACT'
4246 include 'COMMON.IOUNITS'
4249 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4250 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4251 if (link_end.eq.0) return
4252 do i=link_start,link_end
4253 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4254 C CA-CA distance used in regularization of structure.
4257 C iii and jjj point to the residues for which the distance is assigned.
4258 if (ii.gt.nres) then
4265 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4266 c & dhpb(i),dhpb1(i),forcon(i)
4267 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4268 C distance and angle dependent SS bond potential.
4269 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4270 call ssbond_ene(iii,jjj,eij)
4272 cd write (iout,*) "eij",eij
4273 else if (ii.gt.nres .and. jj.gt.nres) then
4274 c Restraints from contact prediction
4276 if (dhpb1(i).gt.0.0d0) then
4277 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4278 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4279 c write (iout,*) "beta nmr",
4280 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4284 C Get the force constant corresponding to this distance.
4286 C Calculate the contribution to energy.
4287 ehpb=ehpb+waga*rdis*rdis
4288 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4290 C Evaluate gradient.
4295 ggg(j)=fac*(c(j,jj)-c(j,ii))
4298 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4299 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4302 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4303 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4306 C Calculate the distance between the two points and its difference from the
4309 if (dhpb1(i).gt.0.0d0) then
4310 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4311 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4312 c write (iout,*) "alph nmr",
4313 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4316 C Get the force constant corresponding to this distance.
4318 C Calculate the contribution to energy.
4319 ehpb=ehpb+waga*rdis*rdis
4320 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4322 C Evaluate gradient.
4326 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4327 cd & ' waga=',waga,' fac=',fac
4329 ggg(j)=fac*(c(j,jj)-c(j,ii))
4331 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4332 C If this is a SC-SC distance, we need to calculate the contributions to the
4333 C Cartesian gradient in the SC vectors (ghpbx).
4336 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4337 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4340 cgrad do j=iii,jjj-1
4342 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4346 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4347 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4354 C--------------------------------------------------------------------------
4355 subroutine ssbond_ene(i,j,eij)
4357 C Calculate the distance and angle dependent SS-bond potential energy
4358 C using a free-energy function derived based on RHF/6-31G** ab initio
4359 C calculations of diethyl disulfide.
4361 C A. Liwo and U. Kozlowska, 11/24/03
4363 implicit real*8 (a-h,o-z)
4364 include 'DIMENSIONS'
4365 include 'COMMON.SBRIDGE'
4366 include 'COMMON.CHAIN'
4367 include 'COMMON.DERIV'
4368 include 'COMMON.LOCAL'
4369 include 'COMMON.INTERACT'
4370 include 'COMMON.VAR'
4371 include 'COMMON.IOUNITS'
4372 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4377 dxi=dc_norm(1,nres+i)
4378 dyi=dc_norm(2,nres+i)
4379 dzi=dc_norm(3,nres+i)
4380 c dsci_inv=dsc_inv(itypi)
4381 dsci_inv=vbld_inv(nres+i)
4383 c dscj_inv=dsc_inv(itypj)
4384 dscj_inv=vbld_inv(nres+j)
4388 dxj=dc_norm(1,nres+j)
4389 dyj=dc_norm(2,nres+j)
4390 dzj=dc_norm(3,nres+j)
4391 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4396 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4397 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4398 om12=dxi*dxj+dyi*dyj+dzi*dzj
4400 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4401 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4407 deltat12=om2-om1+2.0d0
4409 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4410 & +akct*deltad*deltat12
4411 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4412 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4413 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4414 c & " deltat12",deltat12," eij",eij
4415 ed=2*akcm*deltad+akct*deltat12
4417 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4418 eom1=-2*akth*deltat1-pom1-om2*pom2
4419 eom2= 2*akth*deltat2+pom1-om1*pom2
4422 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4423 ghpbx(k,i)=ghpbx(k,i)-ggk
4424 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4425 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4426 ghpbx(k,j)=ghpbx(k,j)+ggk
4427 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4428 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4429 ghpbc(k,i)=ghpbc(k,i)-ggk
4430 ghpbc(k,j)=ghpbc(k,j)+ggk
4433 C Calculate the components of the gradient in DC and X
4437 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4442 C--------------------------------------------------------------------------
4443 subroutine ebond(estr)
4445 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4447 implicit real*8 (a-h,o-z)
4448 include 'DIMENSIONS'
4449 include 'COMMON.LOCAL'
4450 include 'COMMON.GEO'
4451 include 'COMMON.INTERACT'
4452 include 'COMMON.DERIV'
4453 include 'COMMON.VAR'
4454 include 'COMMON.CHAIN'
4455 include 'COMMON.IOUNITS'
4456 include 'COMMON.NAMES'
4457 include 'COMMON.FFIELD'
4458 include 'COMMON.CONTROL'
4459 include 'COMMON.SETUP'
4460 double precision u(3),ud(3)
4462 do i=ibondp_start,ibondp_end
4463 diff = vbld(i)-vbldp0
4464 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4467 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4469 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4473 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4475 do i=ibond_start,ibond_end
4480 diff=vbld(i+nres)-vbldsc0(1,iti)
4481 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4482 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4483 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4485 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4489 diff=vbld(i+nres)-vbldsc0(j,iti)
4490 ud(j)=aksc(j,iti)*diff
4491 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4505 uprod2=uprod2*u(k)*u(k)
4509 usumsqder=usumsqder+ud(j)*uprod2
4511 estr=estr+uprod/usum
4513 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4521 C--------------------------------------------------------------------------
4522 subroutine ebend(etheta)
4524 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4525 C angles gamma and its derivatives in consecutive thetas and gammas.
4527 implicit real*8 (a-h,o-z)
4528 include 'DIMENSIONS'
4529 include 'COMMON.LOCAL'
4530 include 'COMMON.GEO'
4531 include 'COMMON.INTERACT'
4532 include 'COMMON.DERIV'
4533 include 'COMMON.VAR'
4534 include 'COMMON.CHAIN'
4535 include 'COMMON.IOUNITS'
4536 include 'COMMON.NAMES'
4537 include 'COMMON.FFIELD'
4538 include 'COMMON.CONTROL'
4539 common /calcthet/ term1,term2,termm,diffak,ratak,
4540 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4541 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4542 double precision y(2),z(2)
4544 c time11=dexp(-2*time)
4547 c write (*,'(a,i2)') 'EBEND ICG=',icg
4548 do i=ithet_start,ithet_end
4549 C Zero the energy function and its derivative at 0 or pi.
4550 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4555 if (phii.ne.phii) phii=150.0
4568 if (phii1.ne.phii1) phii1=150.0
4580 C Calculate the "mean" value of theta from the part of the distribution
4581 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4582 C In following comments this theta will be referred to as t_c.
4583 thet_pred_mean=0.0d0
4587 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4589 dthett=thet_pred_mean*ssd
4590 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4591 C Derivatives of the "mean" values in gamma1 and gamma2.
4592 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4593 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4594 if (theta(i).gt.pi-delta) then
4595 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4597 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4598 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4599 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4601 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4603 else if (theta(i).lt.delta) then
4604 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4605 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4606 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4608 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4609 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4612 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4615 etheta=etheta+ethetai
4616 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4618 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4619 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4620 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4622 C Ufff.... We've done all this!!!
4625 C---------------------------------------------------------------------------
4626 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4628 implicit real*8 (a-h,o-z)
4629 include 'DIMENSIONS'
4630 include 'COMMON.LOCAL'
4631 include 'COMMON.IOUNITS'
4632 common /calcthet/ term1,term2,termm,diffak,ratak,
4633 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4634 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4635 C Calculate the contributions to both Gaussian lobes.
4636 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4637 C The "polynomial part" of the "standard deviation" of this part of
4641 sig=sig*thet_pred_mean+polthet(j,it)
4643 C Derivative of the "interior part" of the "standard deviation of the"
4644 C gamma-dependent Gaussian lobe in t_c.
4645 sigtc=3*polthet(3,it)
4647 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4650 C Set the parameters of both Gaussian lobes of the distribution.
4651 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4652 fac=sig*sig+sigc0(it)
4655 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4656 sigsqtc=-4.0D0*sigcsq*sigtc
4657 c print *,i,sig,sigtc,sigsqtc
4658 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4659 sigtc=-sigtc/(fac*fac)
4660 C Following variable is sigma(t_c)**(-2)
4661 sigcsq=sigcsq*sigcsq
4663 sig0inv=1.0D0/sig0i**2
4664 delthec=thetai-thet_pred_mean
4665 delthe0=thetai-theta0i
4666 term1=-0.5D0*sigcsq*delthec*delthec
4667 term2=-0.5D0*sig0inv*delthe0*delthe0
4668 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4669 C NaNs in taking the logarithm. We extract the largest exponent which is added
4670 C to the energy (this being the log of the distribution) at the end of energy
4671 C term evaluation for this virtual-bond angle.
4672 if (term1.gt.term2) then
4674 term2=dexp(term2-termm)
4678 term1=dexp(term1-termm)
4681 C The ratio between the gamma-independent and gamma-dependent lobes of
4682 C the distribution is a Gaussian function of thet_pred_mean too.
4683 diffak=gthet(2,it)-thet_pred_mean
4684 ratak=diffak/gthet(3,it)**2
4685 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4686 C Let's differentiate it in thet_pred_mean NOW.
4688 C Now put together the distribution terms to make complete distribution.
4689 termexp=term1+ak*term2
4690 termpre=sigc+ak*sig0i
4691 C Contribution of the bending energy from this theta is just the -log of
4692 C the sum of the contributions from the two lobes and the pre-exponential
4693 C factor. Simple enough, isn't it?
4694 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4695 C NOW the derivatives!!!
4696 C 6/6/97 Take into account the deformation.
4697 E_theta=(delthec*sigcsq*term1
4698 & +ak*delthe0*sig0inv*term2)/termexp
4699 E_tc=((sigtc+aktc*sig0i)/termpre
4700 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4701 & aktc*term2)/termexp)
4704 c-----------------------------------------------------------------------------
4705 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4706 implicit real*8 (a-h,o-z)
4707 include 'DIMENSIONS'
4708 include 'COMMON.LOCAL'
4709 include 'COMMON.IOUNITS'
4710 common /calcthet/ term1,term2,termm,diffak,ratak,
4711 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4712 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4713 delthec=thetai-thet_pred_mean
4714 delthe0=thetai-theta0i
4715 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4716 t3 = thetai-thet_pred_mean
4720 t14 = t12+t6*sigsqtc
4722 t21 = thetai-theta0i
4728 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4729 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4730 & *(-t12*t9-ak*sig0inv*t27)
4734 C--------------------------------------------------------------------------
4735 subroutine ebend(etheta)
4737 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4738 C angles gamma and its derivatives in consecutive thetas and gammas.
4739 C ab initio-derived potentials from
4740 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4742 implicit real*8 (a-h,o-z)
4743 include 'DIMENSIONS'
4744 include 'COMMON.LOCAL'
4745 include 'COMMON.GEO'
4746 include 'COMMON.INTERACT'
4747 include 'COMMON.DERIV'
4748 include 'COMMON.VAR'
4749 include 'COMMON.CHAIN'
4750 include 'COMMON.IOUNITS'
4751 include 'COMMON.NAMES'
4752 include 'COMMON.FFIELD'
4753 include 'COMMON.CONTROL'
4754 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4755 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4756 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4757 & sinph1ph2(maxdouble,maxdouble)
4758 logical lprn /.false./, lprn1 /.false./
4760 do i=ithet_start,ithet_end
4764 theti2=0.5d0*theta(i)
4765 ityp2=ithetyp(itype(i-1))
4767 coskt(k)=dcos(k*theti2)
4768 sinkt(k)=dsin(k*theti2)
4773 if (phii.ne.phii) phii=150.0
4777 ityp1=ithetyp(itype(i-2))
4779 cosph1(k)=dcos(k*phii)
4780 sinph1(k)=dsin(k*phii)
4793 if (phii1.ne.phii1) phii1=150.0
4798 ityp3=ithetyp(itype(i))
4800 cosph2(k)=dcos(k*phii1)
4801 sinph2(k)=dsin(k*phii1)
4811 ethetai=aa0thet(ityp1,ityp2,ityp3)
4814 ccl=cosph1(l)*cosph2(k-l)
4815 ssl=sinph1(l)*sinph2(k-l)
4816 scl=sinph1(l)*cosph2(k-l)
4817 csl=cosph1(l)*sinph2(k-l)
4818 cosph1ph2(l,k)=ccl-ssl
4819 cosph1ph2(k,l)=ccl+ssl
4820 sinph1ph2(l,k)=scl+csl
4821 sinph1ph2(k,l)=scl-csl
4825 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4826 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4827 write (iout,*) "coskt and sinkt"
4829 write (iout,*) k,coskt(k),sinkt(k)
4833 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4834 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4837 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4838 & " ethetai",ethetai
4841 write (iout,*) "cosph and sinph"
4843 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4845 write (iout,*) "cosph1ph2 and sinph2ph2"
4848 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4849 & sinph1ph2(l,k),sinph1ph2(k,l)
4852 write(iout,*) "ethetai",ethetai
4856 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4857 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4858 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4859 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4860 ethetai=ethetai+sinkt(m)*aux
4861 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4862 dephii=dephii+k*sinkt(m)*(
4863 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4864 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4865 dephii1=dephii1+k*sinkt(m)*(
4866 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4867 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4869 & write (iout,*) "m",m," k",k," bbthet",
4870 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4871 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4872 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4873 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4877 & write(iout,*) "ethetai",ethetai
4881 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4882 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4883 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4884 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4885 ethetai=ethetai+sinkt(m)*aux
4886 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4887 dephii=dephii+l*sinkt(m)*(
4888 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4889 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4890 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4891 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4892 dephii1=dephii1+(k-l)*sinkt(m)*(
4893 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4894 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4895 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4896 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4898 write (iout,*) "m",m," k",k," l",l," ffthet",
4899 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4900 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4901 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4902 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4903 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4904 & cosph1ph2(k,l)*sinkt(m),
4905 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4911 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4912 & i,theta(i)*rad2deg,phii*rad2deg,
4913 & phii1*rad2deg,ethetai
4914 etheta=etheta+ethetai
4915 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4916 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4917 gloc(nphi+i-2,icg)=wang*dethetai
4923 c-----------------------------------------------------------------------------
4924 subroutine esc(escloc)
4925 C Calculate the local energy of a side chain and its derivatives in the
4926 C corresponding virtual-bond valence angles THETA and the spherical angles
4928 implicit real*8 (a-h,o-z)
4929 include 'DIMENSIONS'
4930 include 'COMMON.GEO'
4931 include 'COMMON.LOCAL'
4932 include 'COMMON.VAR'
4933 include 'COMMON.INTERACT'
4934 include 'COMMON.DERIV'
4935 include 'COMMON.CHAIN'
4936 include 'COMMON.IOUNITS'
4937 include 'COMMON.NAMES'
4938 include 'COMMON.FFIELD'
4939 include 'COMMON.CONTROL'
4940 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4941 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4942 common /sccalc/ time11,time12,time112,theti,it,nlobit
4945 c write (iout,'(a)') 'ESC'
4946 do i=loc_start,loc_end
4948 if (it.eq.10) goto 1
4950 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4951 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4952 theti=theta(i+1)-pipol
4957 if (x(2).gt.pi-delta) then
4961 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4963 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4964 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4966 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4967 & ddersc0(1),dersc(1))
4968 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4969 & ddersc0(3),dersc(3))
4971 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4973 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4974 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4975 & dersc0(2),esclocbi,dersc02)
4976 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4978 call splinthet(x(2),0.5d0*delta,ss,ssd)
4983 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4985 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4986 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4988 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4990 c write (iout,*) escloci
4991 else if (x(2).lt.delta) then
4995 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4997 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4998 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5000 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5001 & ddersc0(1),dersc(1))
5002 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5003 & ddersc0(3),dersc(3))
5005 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5007 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5008 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5009 & dersc0(2),esclocbi,dersc02)
5010 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5015 call splinthet(x(2),0.5d0*delta,ss,ssd)
5017 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5019 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5020 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5022 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5023 c write (iout,*) escloci
5025 call enesc(x,escloci,dersc,ddummy,.false.)
5028 escloc=escloc+escloci
5029 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5030 & 'escloc',i,escloci
5031 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5033 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5035 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5036 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5041 C---------------------------------------------------------------------------
5042 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5043 implicit real*8 (a-h,o-z)
5044 include 'DIMENSIONS'
5045 include 'COMMON.GEO'
5046 include 'COMMON.LOCAL'
5047 include 'COMMON.IOUNITS'
5048 common /sccalc/ time11,time12,time112,theti,it,nlobit
5049 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5050 double precision contr(maxlob,-1:1)
5052 c write (iout,*) 'it=',it,' nlobit=',nlobit
5056 if (mixed) ddersc(j)=0.0d0
5060 C Because of periodicity of the dependence of the SC energy in omega we have
5061 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5062 C To avoid underflows, first compute & store the exponents.
5070 z(k)=x(k)-censc(k,j,it)
5075 Axk=Axk+gaussc(l,k,j,it)*z(l)
5081 expfac=expfac+Ax(k,j,iii)*z(k)
5089 C As in the case of ebend, we want to avoid underflows in exponentiation and
5090 C subsequent NaNs and INFs in energy calculation.
5091 C Find the largest exponent
5095 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5099 cd print *,'it=',it,' emin=',emin
5101 C Compute the contribution to SC energy and derivatives
5106 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5107 if(adexp.ne.adexp) adexp=1.0
5110 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5112 cd print *,'j=',j,' expfac=',expfac
5113 escloc_i=escloc_i+expfac
5115 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5119 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5120 & +gaussc(k,2,j,it))*expfac
5127 dersc(1)=dersc(1)/cos(theti)**2
5128 ddersc(1)=ddersc(1)/cos(theti)**2
5131 escloci=-(dlog(escloc_i)-emin)
5133 dersc(j)=dersc(j)/escloc_i
5137 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5142 C------------------------------------------------------------------------------
5143 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5144 implicit real*8 (a-h,o-z)
5145 include 'DIMENSIONS'
5146 include 'COMMON.GEO'
5147 include 'COMMON.LOCAL'
5148 include 'COMMON.IOUNITS'
5149 common /sccalc/ time11,time12,time112,theti,it,nlobit
5150 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5151 double precision contr(maxlob)
5162 z(k)=x(k)-censc(k,j,it)
5168 Axk=Axk+gaussc(l,k,j,it)*z(l)
5174 expfac=expfac+Ax(k,j)*z(k)
5179 C As in the case of ebend, we want to avoid underflows in exponentiation and
5180 C subsequent NaNs and INFs in energy calculation.
5181 C Find the largest exponent
5184 if (emin.gt.contr(j)) emin=contr(j)
5188 C Compute the contribution to SC energy and derivatives
5192 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5193 escloc_i=escloc_i+expfac
5195 dersc(k)=dersc(k)+Ax(k,j)*expfac
5197 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5198 & +gaussc(1,2,j,it))*expfac
5202 dersc(1)=dersc(1)/cos(theti)**2
5203 dersc12=dersc12/cos(theti)**2
5204 escloci=-(dlog(escloc_i)-emin)
5206 dersc(j)=dersc(j)/escloc_i
5208 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5212 c----------------------------------------------------------------------------------
5213 subroutine esc(escloc)
5214 C Calculate the local energy of a side chain and its derivatives in the
5215 C corresponding virtual-bond valence angles THETA and the spherical angles
5216 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5217 C added by Urszula Kozlowska. 07/11/2007
5219 implicit real*8 (a-h,o-z)
5220 include 'DIMENSIONS'
5221 include 'COMMON.GEO'
5222 include 'COMMON.LOCAL'
5223 include 'COMMON.VAR'
5224 include 'COMMON.SCROT'
5225 include 'COMMON.INTERACT'
5226 include 'COMMON.DERIV'
5227 include 'COMMON.CHAIN'
5228 include 'COMMON.IOUNITS'
5229 include 'COMMON.NAMES'
5230 include 'COMMON.FFIELD'
5231 include 'COMMON.CONTROL'
5232 include 'COMMON.VECTORS'
5233 double precision x_prime(3),y_prime(3),z_prime(3)
5234 & , sumene,dsc_i,dp2_i,x(65),
5235 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5236 & de_dxx,de_dyy,de_dzz,de_dt
5237 double precision s1_t,s1_6_t,s2_t,s2_6_t
5239 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5240 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5241 & dt_dCi(3),dt_dCi1(3)
5242 common /sccalc/ time11,time12,time112,theti,it,nlobit
5245 do i=loc_start,loc_end
5246 costtab(i+1) =dcos(theta(i+1))
5247 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5248 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5249 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5250 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5251 cosfac=dsqrt(cosfac2)
5252 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5253 sinfac=dsqrt(sinfac2)
5255 if (it.eq.10) goto 1
5257 C Compute the axes of tghe local cartesian coordinates system; store in
5258 c x_prime, y_prime and z_prime
5265 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5266 C & dc_norm(3,i+nres)
5268 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5269 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5272 z_prime(j) = -uz(j,i-1)
5275 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5276 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5277 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5278 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5279 c & " xy",scalar(x_prime(1),y_prime(1)),
5280 c & " xz",scalar(x_prime(1),z_prime(1)),
5281 c & " yy",scalar(y_prime(1),y_prime(1)),
5282 c & " yz",scalar(y_prime(1),z_prime(1)),
5283 c & " zz",scalar(z_prime(1),z_prime(1))
5285 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5286 C to local coordinate system. Store in xx, yy, zz.
5292 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5293 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5294 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5301 C Compute the energy of the ith side cbain
5303 c write (2,*) "xx",xx," yy",yy," zz",zz
5306 x(j) = sc_parmin(j,it)
5309 Cc diagnostics - remove later
5311 yy1 = dsin(alph(2))*dcos(omeg(2))
5312 zz1 = -dsin(alph(2))*dsin(omeg(2))
5313 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5314 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5316 C," --- ", xx_w,yy_w,zz_w
5319 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5320 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5322 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5323 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5325 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5326 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5327 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5328 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5329 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5331 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5332 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5333 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5334 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5335 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5337 dsc_i = 0.743d0+x(61)
5339 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5340 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5341 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5342 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5343 s1=(1+x(63))/(0.1d0 + dscp1)
5344 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5345 s2=(1+x(65))/(0.1d0 + dscp2)
5346 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5347 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5348 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5349 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5351 c & dscp1,dscp2,sumene
5352 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5353 escloc = escloc + sumene
5354 c write (2,*) "i",i," escloc",sumene,escloc
5357 C This section to check the numerical derivatives of the energy of ith side
5358 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5359 C #define DEBUG in the code to turn it on.
5361 write (2,*) "sumene =",sumene
5365 write (2,*) xx,yy,zz
5366 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5367 de_dxx_num=(sumenep-sumene)/aincr
5369 write (2,*) "xx+ sumene from enesc=",sumenep
5372 write (2,*) xx,yy,zz
5373 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5374 de_dyy_num=(sumenep-sumene)/aincr
5376 write (2,*) "yy+ sumene from enesc=",sumenep
5379 write (2,*) xx,yy,zz
5380 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5381 de_dzz_num=(sumenep-sumene)/aincr
5383 write (2,*) "zz+ sumene from enesc=",sumenep
5384 costsave=cost2tab(i+1)
5385 sintsave=sint2tab(i+1)
5386 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5387 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5388 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5389 de_dt_num=(sumenep-sumene)/aincr
5390 write (2,*) " t+ sumene from enesc=",sumenep
5391 cost2tab(i+1)=costsave
5392 sint2tab(i+1)=sintsave
5393 C End of diagnostics section.
5396 C Compute the gradient of esc
5398 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5399 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5400 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5401 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5402 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5403 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5404 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5405 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5406 pom1=(sumene3*sint2tab(i+1)+sumene1)
5407 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5408 pom2=(sumene4*cost2tab(i+1)+sumene2)
5409 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5410 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5411 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5412 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5414 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5415 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5416 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5418 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5419 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5420 & +(pom1+pom2)*pom_dx
5422 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5425 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5426 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5427 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5429 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5430 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5431 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5432 & +x(59)*zz**2 +x(60)*xx*zz
5433 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5434 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5435 & +(pom1-pom2)*pom_dy
5437 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5440 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5441 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5442 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5443 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5444 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5445 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5446 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5447 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5449 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5452 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5453 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5454 & +pom1*pom_dt1+pom2*pom_dt2
5456 write(2,*), "de_dt = ", de_dt,de_dt_num
5460 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5461 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5462 cosfac2xx=cosfac2*xx
5463 sinfac2yy=sinfac2*yy
5465 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5467 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5469 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5470 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5471 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5472 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5473 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5474 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5475 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5476 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5477 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5478 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5482 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5483 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5486 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5487 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5488 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5490 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5491 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5495 dXX_Ctab(k,i)=dXX_Ci(k)
5496 dXX_C1tab(k,i)=dXX_Ci1(k)
5497 dYY_Ctab(k,i)=dYY_Ci(k)
5498 dYY_C1tab(k,i)=dYY_Ci1(k)
5499 dZZ_Ctab(k,i)=dZZ_Ci(k)
5500 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5501 dXX_XYZtab(k,i)=dXX_XYZ(k)
5502 dYY_XYZtab(k,i)=dYY_XYZ(k)
5503 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5507 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5508 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5509 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5510 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5511 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5513 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5514 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5515 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5516 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5517 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5518 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5519 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5520 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5522 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5523 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5525 C to check gradient call subroutine check_grad
5531 c------------------------------------------------------------------------------
5532 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5534 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5535 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5536 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5537 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5539 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5540 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5542 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5543 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5544 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5545 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5546 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5548 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5549 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5550 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5551 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5552 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5554 dsc_i = 0.743d0+x(61)
5556 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5557 & *(xx*cost2+yy*sint2))
5558 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5559 & *(xx*cost2-yy*sint2))
5560 s1=(1+x(63))/(0.1d0 + dscp1)
5561 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5562 s2=(1+x(65))/(0.1d0 + dscp2)
5563 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5564 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5565 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5570 c------------------------------------------------------------------------------
5571 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5573 C This procedure calculates two-body contact function g(rij) and its derivative:
5576 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5579 C where x=(rij-r0ij)/delta
5581 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5584 double precision rij,r0ij,eps0ij,fcont,fprimcont
5585 double precision x,x2,x4,delta
5589 if (x.lt.-1.0D0) then
5592 else if (x.le.1.0D0) then
5595 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5596 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5603 c------------------------------------------------------------------------------
5604 subroutine splinthet(theti,delta,ss,ssder)
5605 implicit real*8 (a-h,o-z)
5606 include 'DIMENSIONS'
5607 include 'COMMON.VAR'
5608 include 'COMMON.GEO'
5611 if (theti.gt.pipol) then
5612 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5614 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5619 c------------------------------------------------------------------------------
5620 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5622 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5623 double precision ksi,ksi2,ksi3,a1,a2,a3
5624 a1=fprim0*delta/(f1-f0)
5630 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5631 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5634 c------------------------------------------------------------------------------
5635 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5637 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5638 double precision ksi,ksi2,ksi3,a1,a2,a3
5643 a2=3*(f1x-f0x)-2*fprim0x*delta
5644 a3=fprim0x*delta-2*(f1x-f0x)
5645 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5648 C-----------------------------------------------------------------------------
5650 C-----------------------------------------------------------------------------
5651 subroutine etor(etors,edihcnstr)
5652 implicit real*8 (a-h,o-z)
5653 include 'DIMENSIONS'
5654 include 'COMMON.VAR'
5655 include 'COMMON.GEO'
5656 include 'COMMON.LOCAL'
5657 include 'COMMON.TORSION'
5658 include 'COMMON.INTERACT'
5659 include 'COMMON.DERIV'
5660 include 'COMMON.CHAIN'
5661 include 'COMMON.NAMES'
5662 include 'COMMON.IOUNITS'
5663 include 'COMMON.FFIELD'
5664 include 'COMMON.TORCNSTR'
5665 include 'COMMON.CONTROL'
5667 C Set lprn=.true. for debugging
5671 do i=iphi_start,iphi_end
5673 itori=itortyp(itype(i-2))
5674 itori1=itortyp(itype(i-1))
5677 C Proline-Proline pair is a special case...
5678 if (itori.eq.3 .and. itori1.eq.3) then
5679 if (phii.gt.-dwapi3) then
5681 fac=1.0D0/(1.0D0-cosphi)
5682 etorsi=v1(1,3,3)*fac
5683 etorsi=etorsi+etorsi
5684 etors=etors+etorsi-v1(1,3,3)
5685 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5686 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5689 v1ij=v1(j+1,itori,itori1)
5690 v2ij=v2(j+1,itori,itori1)
5693 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5694 if (energy_dec) etors_ii=etors_ii+
5695 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5696 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5700 v1ij=v1(j,itori,itori1)
5701 v2ij=v2(j,itori,itori1)
5704 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5705 if (energy_dec) etors_ii=etors_ii+
5706 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5707 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5710 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5713 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5714 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5715 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5716 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5717 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5719 ! 6/20/98 - dihedral angle constraints
5722 itori=idih_constr(i)
5725 if (difi.gt.drange(i)) then
5727 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5728 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5729 else if (difi.lt.-drange(i)) then
5731 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5732 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5734 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5735 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5737 ! write (iout,*) 'edihcnstr',edihcnstr
5740 c------------------------------------------------------------------------------
5741 subroutine etor_d(etors_d)
5745 c----------------------------------------------------------------------------
5747 subroutine etor(etors,edihcnstr)
5748 implicit real*8 (a-h,o-z)
5749 include 'DIMENSIONS'
5750 include 'COMMON.VAR'
5751 include 'COMMON.GEO'
5752 include 'COMMON.LOCAL'
5753 include 'COMMON.TORSION'
5754 include 'COMMON.INTERACT'
5755 include 'COMMON.DERIV'
5756 include 'COMMON.CHAIN'
5757 include 'COMMON.NAMES'
5758 include 'COMMON.IOUNITS'
5759 include 'COMMON.FFIELD'
5760 include 'COMMON.TORCNSTR'
5761 include 'COMMON.CONTROL'
5763 C Set lprn=.true. for debugging
5767 do i=iphi_start,iphi_end
5769 itori=itortyp(itype(i-2))
5770 itori1=itortyp(itype(i-1))
5773 C Regular cosine and sine terms
5774 do j=1,nterm(itori,itori1)
5775 v1ij=v1(j,itori,itori1)
5776 v2ij=v2(j,itori,itori1)
5779 etors=etors+v1ij*cosphi+v2ij*sinphi
5780 if (energy_dec) etors_ii=etors_ii+
5781 & v1ij*cosphi+v2ij*sinphi
5782 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5786 C E = SUM ----------------------------------- - v1
5787 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5789 cosphi=dcos(0.5d0*phii)
5790 sinphi=dsin(0.5d0*phii)
5791 do j=1,nlor(itori,itori1)
5792 vl1ij=vlor1(j,itori,itori1)
5793 vl2ij=vlor2(j,itori,itori1)
5794 vl3ij=vlor3(j,itori,itori1)
5795 pom=vl2ij*cosphi+vl3ij*sinphi
5796 pom1=1.0d0/(pom*pom+1.0d0)
5797 etors=etors+vl1ij*pom1
5798 if (energy_dec) etors_ii=etors_ii+
5801 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5803 C Subtract the constant term
5804 etors=etors-v0(itori,itori1)
5805 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5806 & 'etor',i,etors_ii-v0(itori,itori1)
5808 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5809 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5810 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5811 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5812 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5814 ! 6/20/98 - dihedral angle constraints
5816 c do i=1,ndih_constr
5817 do i=idihconstr_start,idihconstr_end
5818 itori=idih_constr(i)
5820 difi=pinorm(phii-phi0(i))
5821 if (difi.gt.drange(i)) then
5823 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5824 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5825 else if (difi.lt.-drange(i)) then
5827 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5828 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5832 c write (iout,*) "gloci", gloc(i-3,icg)
5833 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5834 cd & rad2deg*phi0(i), rad2deg*drange(i),
5835 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5837 cd write (iout,*) 'edihcnstr',edihcnstr
5840 c----------------------------------------------------------------------------
5841 subroutine etor_d(etors_d)
5842 C 6/23/01 Compute double torsional energy
5843 implicit real*8 (a-h,o-z)
5844 include 'DIMENSIONS'
5845 include 'COMMON.VAR'
5846 include 'COMMON.GEO'
5847 include 'COMMON.LOCAL'
5848 include 'COMMON.TORSION'
5849 include 'COMMON.INTERACT'
5850 include 'COMMON.DERIV'
5851 include 'COMMON.CHAIN'
5852 include 'COMMON.NAMES'
5853 include 'COMMON.IOUNITS'
5854 include 'COMMON.FFIELD'
5855 include 'COMMON.TORCNSTR'
5857 C Set lprn=.true. for debugging
5861 do i=iphid_start,iphid_end
5862 itori=itortyp(itype(i-2))
5863 itori1=itortyp(itype(i-1))
5864 itori2=itortyp(itype(i))
5869 do j=1,ntermd_1(itori,itori1,itori2)
5870 v1cij=v1c(1,j,itori,itori1,itori2)
5871 v1sij=v1s(1,j,itori,itori1,itori2)
5872 v2cij=v1c(2,j,itori,itori1,itori2)
5873 v2sij=v1s(2,j,itori,itori1,itori2)
5874 cosphi1=dcos(j*phii)
5875 sinphi1=dsin(j*phii)
5876 cosphi2=dcos(j*phii1)
5877 sinphi2=dsin(j*phii1)
5878 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5879 & v2cij*cosphi2+v2sij*sinphi2
5880 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5881 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5883 do k=2,ntermd_2(itori,itori1,itori2)
5885 v1cdij = v2c(k,l,itori,itori1,itori2)
5886 v2cdij = v2c(l,k,itori,itori1,itori2)
5887 v1sdij = v2s(k,l,itori,itori1,itori2)
5888 v2sdij = v2s(l,k,itori,itori1,itori2)
5889 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5890 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5891 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5892 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5893 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5894 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5895 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5896 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5897 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5898 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5901 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5902 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5903 c write (iout,*) "gloci", gloc(i-3,icg)
5908 c------------------------------------------------------------------------------
5909 subroutine eback_sc_corr(esccor)
5910 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5911 c conformational states; temporarily implemented as differences
5912 c between UNRES torsional potentials (dependent on three types of
5913 c residues) and the torsional potentials dependent on all 20 types
5914 c of residues computed from AM1 energy surfaces of terminally-blocked
5915 c amino-acid residues.
5916 implicit real*8 (a-h,o-z)
5917 include 'DIMENSIONS'
5918 include 'COMMON.VAR'
5919 include 'COMMON.GEO'
5920 include 'COMMON.LOCAL'
5921 include 'COMMON.TORSION'
5922 include 'COMMON.SCCOR'
5923 include 'COMMON.INTERACT'
5924 include 'COMMON.DERIV'
5925 include 'COMMON.CHAIN'
5926 include 'COMMON.NAMES'
5927 include 'COMMON.IOUNITS'
5928 include 'COMMON.FFIELD'
5929 include 'COMMON.CONTROL'
5931 C Set lprn=.true. for debugging
5934 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5936 do i=itau_start,itau_end
5938 isccori=isccortyp(itype(i-2))
5939 isccori1=isccortyp(itype(i-1))
5941 cccc Added 9 May 2012
5942 cc Tauangle is torsional engle depending on the value of first digit
5943 c(see comment below)
5944 cc Omicron is flat angle depending on the value of first digit
5945 c(see comment below)
5948 do intertyp=1,3 !intertyp
5949 cc Added 09 May 2012 (Adasko)
5950 cc Intertyp means interaction type of backbone mainchain correlation:
5951 c 1 = SC...Ca...Ca...Ca
5952 c 2 = Ca...Ca...Ca...SC
5953 c 3 = SC...Ca...Ca...SCi
5955 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5956 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5957 & (itype(i-1).eq.21)))
5958 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5959 & .or.(itype(i-2).eq.21)))
5960 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5961 & (itype(i-1).eq.21)))) cycle
5962 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5963 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5965 do j=1,nterm_sccor(isccori,isccori1)
5966 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5967 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5968 cosphi=dcos(j*tauangle(intertyp,i))
5969 sinphi=dsin(j*tauangle(intertyp,i))
5970 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5971 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5973 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5974 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5975 c &gloc_sc(intertyp,i-3,icg)
5977 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5978 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5979 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5980 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5981 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5985 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
5989 c----------------------------------------------------------------------------
5990 subroutine multibody(ecorr)
5991 C This subroutine calculates multi-body contributions to energy following
5992 C the idea of Skolnick et al. If side chains I and J make a contact and
5993 C at the same time side chains I+1 and J+1 make a contact, an extra
5994 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5995 implicit real*8 (a-h,o-z)
5996 include 'DIMENSIONS'
5997 include 'COMMON.IOUNITS'
5998 include 'COMMON.DERIV'
5999 include 'COMMON.INTERACT'
6000 include 'COMMON.CONTACTS'
6001 double precision gx(3),gx1(3)
6004 C Set lprn=.true. for debugging
6008 write (iout,'(a)') 'Contact function values:'
6010 write (iout,'(i2,20(1x,i2,f10.5))')
6011 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6026 num_conti=num_cont(i)
6027 num_conti1=num_cont(i1)
6032 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6033 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6034 cd & ' ishift=',ishift
6035 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6036 C The system gains extra energy.
6037 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6038 endif ! j1==j+-ishift
6047 c------------------------------------------------------------------------------
6048 double precision function esccorr(i,j,k,l,jj,kk)
6049 implicit real*8 (a-h,o-z)
6050 include 'DIMENSIONS'
6051 include 'COMMON.IOUNITS'
6052 include 'COMMON.DERIV'
6053 include 'COMMON.INTERACT'
6054 include 'COMMON.CONTACTS'
6055 double precision gx(3),gx1(3)
6060 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6061 C Calculate the multi-body contribution to energy.
6062 C Calculate multi-body contributions to the gradient.
6063 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6064 cd & k,l,(gacont(m,kk,k),m=1,3)
6066 gx(m) =ekl*gacont(m,jj,i)
6067 gx1(m)=eij*gacont(m,kk,k)
6068 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6069 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6070 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6071 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6075 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6080 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6086 c------------------------------------------------------------------------------
6087 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6088 C This subroutine calculates multi-body contributions to hydrogen-bonding
6089 implicit real*8 (a-h,o-z)
6090 include 'DIMENSIONS'
6091 include 'COMMON.IOUNITS'
6094 parameter (max_cont=maxconts)
6095 parameter (max_dim=26)
6096 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6097 double precision zapas(max_dim,maxconts,max_fg_procs),
6098 & zapas_recv(max_dim,maxconts,max_fg_procs)
6099 common /przechowalnia/ zapas
6100 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6101 & status_array(MPI_STATUS_SIZE,maxconts*2)
6103 include 'COMMON.SETUP'
6104 include 'COMMON.FFIELD'
6105 include 'COMMON.DERIV'
6106 include 'COMMON.INTERACT'
6107 include 'COMMON.CONTACTS'
6108 include 'COMMON.CONTROL'
6109 include 'COMMON.LOCAL'
6110 double precision gx(3),gx1(3),time00
6113 C Set lprn=.true. for debugging
6118 if (nfgtasks.le.1) goto 30
6120 write (iout,'(a)') 'Contact function values before RECEIVE:'
6122 write (iout,'(2i3,50(1x,i2,f5.2))')
6123 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6124 & j=1,num_cont_hb(i))
6128 do i=1,ntask_cont_from
6131 do i=1,ntask_cont_to
6134 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6136 C Make the list of contacts to send to send to other procesors
6137 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6139 do i=iturn3_start,iturn3_end
6140 c write (iout,*) "make contact list turn3",i," num_cont",
6142 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6144 do i=iturn4_start,iturn4_end
6145 c write (iout,*) "make contact list turn4",i," num_cont",
6147 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6151 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6153 do j=1,num_cont_hb(i)
6156 iproc=iint_sent_local(k,jjc,ii)
6157 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6158 if (iproc.gt.0) then
6159 ncont_sent(iproc)=ncont_sent(iproc)+1
6160 nn=ncont_sent(iproc)
6162 zapas(2,nn,iproc)=jjc
6163 zapas(3,nn,iproc)=facont_hb(j,i)
6164 zapas(4,nn,iproc)=ees0p(j,i)
6165 zapas(5,nn,iproc)=ees0m(j,i)
6166 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6167 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6168 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6169 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6170 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6171 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6172 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6173 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6174 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6175 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6176 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6177 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6178 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6179 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6180 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6181 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6182 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6183 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6184 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6185 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6186 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6193 & "Numbers of contacts to be sent to other processors",
6194 & (ncont_sent(i),i=1,ntask_cont_to)
6195 write (iout,*) "Contacts sent"
6196 do ii=1,ntask_cont_to
6198 iproc=itask_cont_to(ii)
6199 write (iout,*) nn," contacts to processor",iproc,
6200 & " of CONT_TO_COMM group"
6202 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6210 CorrelID1=nfgtasks+fg_rank+1
6212 C Receive the numbers of needed contacts from other processors
6213 do ii=1,ntask_cont_from
6214 iproc=itask_cont_from(ii)
6216 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6217 & FG_COMM,req(ireq),IERR)
6219 c write (iout,*) "IRECV ended"
6221 C Send the number of contacts needed by other processors
6222 do ii=1,ntask_cont_to
6223 iproc=itask_cont_to(ii)
6225 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6226 & FG_COMM,req(ireq),IERR)
6228 c write (iout,*) "ISEND ended"
6229 c write (iout,*) "number of requests (nn)",ireq
6232 & call MPI_Waitall(ireq,req,status_array,ierr)
6234 c & "Numbers of contacts to be received from other processors",
6235 c & (ncont_recv(i),i=1,ntask_cont_from)
6239 do ii=1,ntask_cont_from
6240 iproc=itask_cont_from(ii)
6242 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6243 c & " of CONT_TO_COMM group"
6247 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6248 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6249 c write (iout,*) "ireq,req",ireq,req(ireq)
6252 C Send the contacts to processors that need them
6253 do ii=1,ntask_cont_to
6254 iproc=itask_cont_to(ii)
6256 c write (iout,*) nn," contacts to processor",iproc,
6257 c & " of CONT_TO_COMM group"
6260 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6261 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6262 c write (iout,*) "ireq,req",ireq,req(ireq)
6264 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6268 c write (iout,*) "number of requests (contacts)",ireq
6269 c write (iout,*) "req",(req(i),i=1,4)
6272 & call MPI_Waitall(ireq,req,status_array,ierr)
6273 do iii=1,ntask_cont_from
6274 iproc=itask_cont_from(iii)
6277 write (iout,*) "Received",nn," contacts from processor",iproc,
6278 & " of CONT_FROM_COMM group"
6281 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6286 ii=zapas_recv(1,i,iii)
6287 c Flag the received contacts to prevent double-counting
6288 jj=-zapas_recv(2,i,iii)
6289 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6291 nnn=num_cont_hb(ii)+1
6294 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6295 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6296 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6297 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6298 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6299 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6300 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6301 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6302 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6303 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6304 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6305 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6306 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6307 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6308 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6309 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6310 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6311 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6312 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6313 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6314 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6315 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6316 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6317 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6322 write (iout,'(a)') 'Contact function values after receive:'
6324 write (iout,'(2i3,50(1x,i3,f5.2))')
6325 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6326 & j=1,num_cont_hb(i))
6333 write (iout,'(a)') 'Contact function values:'
6335 write (iout,'(2i3,50(1x,i3,f5.2))')
6336 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6337 & j=1,num_cont_hb(i))
6341 C Remove the loop below after debugging !!!
6348 C Calculate the local-electrostatic correlation terms
6349 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6351 num_conti=num_cont_hb(i)
6352 num_conti1=num_cont_hb(i+1)
6359 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6360 c & ' jj=',jj,' kk=',kk
6361 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6362 & .or. j.lt.0 .and. j1.gt.0) .and.
6363 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6364 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6365 C The system gains extra energy.
6366 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6367 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6368 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6370 else if (j1.eq.j) then
6371 C Contacts I-J and I-(J+1) occur simultaneously.
6372 C The system loses extra energy.
6373 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6378 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6379 c & ' jj=',jj,' kk=',kk
6381 C Contacts I-J and (I+1)-J occur simultaneously.
6382 C The system loses extra energy.
6383 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6390 c------------------------------------------------------------------------------
6391 subroutine add_hb_contact(ii,jj,itask)
6392 implicit real*8 (a-h,o-z)
6393 include "DIMENSIONS"
6394 include "COMMON.IOUNITS"
6397 parameter (max_cont=maxconts)
6398 parameter (max_dim=26)
6399 include "COMMON.CONTACTS"
6400 double precision zapas(max_dim,maxconts,max_fg_procs),
6401 & zapas_recv(max_dim,maxconts,max_fg_procs)
6402 common /przechowalnia/ zapas
6403 integer i,j,ii,jj,iproc,itask(4),nn
6404 c write (iout,*) "itask",itask
6407 if (iproc.gt.0) then
6408 do j=1,num_cont_hb(ii)
6410 c write (iout,*) "i",ii," j",jj," jjc",jjc
6412 ncont_sent(iproc)=ncont_sent(iproc)+1
6413 nn=ncont_sent(iproc)
6414 zapas(1,nn,iproc)=ii
6415 zapas(2,nn,iproc)=jjc
6416 zapas(3,nn,iproc)=facont_hb(j,ii)
6417 zapas(4,nn,iproc)=ees0p(j,ii)
6418 zapas(5,nn,iproc)=ees0m(j,ii)
6419 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6420 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6421 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6422 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6423 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6424 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6425 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6426 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6427 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6428 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6429 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6430 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6431 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6432 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6433 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6434 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6435 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6436 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6437 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6438 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6439 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6447 c------------------------------------------------------------------------------
6448 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6450 C This subroutine calculates multi-body contributions to hydrogen-bonding
6451 implicit real*8 (a-h,o-z)
6452 include 'DIMENSIONS'
6453 include 'COMMON.IOUNITS'
6456 parameter (max_cont=maxconts)
6457 parameter (max_dim=70)
6458 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6459 double precision zapas(max_dim,maxconts,max_fg_procs),
6460 & zapas_recv(max_dim,maxconts,max_fg_procs)
6461 common /przechowalnia/ zapas
6462 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6463 & status_array(MPI_STATUS_SIZE,maxconts*2)
6465 include 'COMMON.SETUP'
6466 include 'COMMON.FFIELD'
6467 include 'COMMON.DERIV'
6468 include 'COMMON.LOCAL'
6469 include 'COMMON.INTERACT'
6470 include 'COMMON.CONTACTS'
6471 include 'COMMON.CHAIN'
6472 include 'COMMON.CONTROL'
6473 double precision gx(3),gx1(3)
6474 integer num_cont_hb_old(maxres)
6476 double precision eello4,eello5,eelo6,eello_turn6
6477 external eello4,eello5,eello6,eello_turn6
6478 C Set lprn=.true. for debugging
6483 num_cont_hb_old(i)=num_cont_hb(i)
6487 if (nfgtasks.le.1) goto 30
6489 write (iout,'(a)') 'Contact function values before RECEIVE:'
6491 write (iout,'(2i3,50(1x,i2,f5.2))')
6492 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6493 & j=1,num_cont_hb(i))
6497 do i=1,ntask_cont_from
6500 do i=1,ntask_cont_to
6503 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6505 C Make the list of contacts to send to send to other procesors
6506 do i=iturn3_start,iturn3_end
6507 c write (iout,*) "make contact list turn3",i," num_cont",
6509 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6511 do i=iturn4_start,iturn4_end
6512 c write (iout,*) "make contact list turn4",i," num_cont",
6514 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6518 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6520 do j=1,num_cont_hb(i)
6523 iproc=iint_sent_local(k,jjc,ii)
6524 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6525 if (iproc.ne.0) then
6526 ncont_sent(iproc)=ncont_sent(iproc)+1
6527 nn=ncont_sent(iproc)
6529 zapas(2,nn,iproc)=jjc
6530 zapas(3,nn,iproc)=d_cont(j,i)
6534 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6539 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6547 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6558 & "Numbers of contacts to be sent to other processors",
6559 & (ncont_sent(i),i=1,ntask_cont_to)
6560 write (iout,*) "Contacts sent"
6561 do ii=1,ntask_cont_to
6563 iproc=itask_cont_to(ii)
6564 write (iout,*) nn," contacts to processor",iproc,
6565 & " of CONT_TO_COMM group"
6567 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6575 CorrelID1=nfgtasks+fg_rank+1
6577 C Receive the numbers of needed contacts from other processors
6578 do ii=1,ntask_cont_from
6579 iproc=itask_cont_from(ii)
6581 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6582 & FG_COMM,req(ireq),IERR)
6584 c write (iout,*) "IRECV ended"
6586 C Send the number of contacts needed by other processors
6587 do ii=1,ntask_cont_to
6588 iproc=itask_cont_to(ii)
6590 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6591 & FG_COMM,req(ireq),IERR)
6593 c write (iout,*) "ISEND ended"
6594 c write (iout,*) "number of requests (nn)",ireq
6597 & call MPI_Waitall(ireq,req,status_array,ierr)
6599 c & "Numbers of contacts to be received from other processors",
6600 c & (ncont_recv(i),i=1,ntask_cont_from)
6604 do ii=1,ntask_cont_from
6605 iproc=itask_cont_from(ii)
6607 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6608 c & " of CONT_TO_COMM group"
6612 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6613 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6614 c write (iout,*) "ireq,req",ireq,req(ireq)
6617 C Send the contacts to processors that need them
6618 do ii=1,ntask_cont_to
6619 iproc=itask_cont_to(ii)
6621 c write (iout,*) nn," contacts to processor",iproc,
6622 c & " of CONT_TO_COMM group"
6625 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6626 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6627 c write (iout,*) "ireq,req",ireq,req(ireq)
6629 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6633 c write (iout,*) "number of requests (contacts)",ireq
6634 c write (iout,*) "req",(req(i),i=1,4)
6637 & call MPI_Waitall(ireq,req,status_array,ierr)
6638 do iii=1,ntask_cont_from
6639 iproc=itask_cont_from(iii)
6642 write (iout,*) "Received",nn," contacts from processor",iproc,
6643 & " of CONT_FROM_COMM group"
6646 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6651 ii=zapas_recv(1,i,iii)
6652 c Flag the received contacts to prevent double-counting
6653 jj=-zapas_recv(2,i,iii)
6654 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6656 nnn=num_cont_hb(ii)+1
6659 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6663 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6668 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6676 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6685 write (iout,'(a)') 'Contact function values after receive:'
6687 write (iout,'(2i3,50(1x,i3,5f6.3))')
6688 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6689 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6696 write (iout,'(a)') 'Contact function values:'
6698 write (iout,'(2i3,50(1x,i2,5f6.3))')
6699 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6700 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6706 C Remove the loop below after debugging !!!
6713 C Calculate the dipole-dipole interaction energies
6714 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6715 do i=iatel_s,iatel_e+1
6716 num_conti=num_cont_hb(i)
6725 C Calculate the local-electrostatic correlation terms
6726 c write (iout,*) "gradcorr5 in eello5 before loop"
6728 c write (iout,'(i5,3f10.5)')
6729 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6731 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6732 c write (iout,*) "corr loop i",i
6734 num_conti=num_cont_hb(i)
6735 num_conti1=num_cont_hb(i+1)
6742 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6743 c & ' jj=',jj,' kk=',kk
6744 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6745 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6746 & .or. j.lt.0 .and. j1.gt.0) .and.
6747 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6748 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6749 C The system gains extra energy.
6751 sqd1=dsqrt(d_cont(jj,i))
6752 sqd2=dsqrt(d_cont(kk,i1))
6753 sred_geom = sqd1*sqd2
6754 IF (sred_geom.lt.cutoff_corr) THEN
6755 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6757 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6758 cd & ' jj=',jj,' kk=',kk
6759 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6760 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6762 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6763 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6766 cd write (iout,*) 'sred_geom=',sred_geom,
6767 cd & ' ekont=',ekont,' fprim=',fprimcont,
6768 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6769 cd write (iout,*) "g_contij",g_contij
6770 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6771 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6772 call calc_eello(i,jp,i+1,jp1,jj,kk)
6773 if (wcorr4.gt.0.0d0)
6774 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6775 if (energy_dec.and.wcorr4.gt.0.0d0)
6776 1 write (iout,'(a6,4i5,0pf7.3)')
6777 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6778 c write (iout,*) "gradcorr5 before eello5"
6780 c write (iout,'(i5,3f10.5)')
6781 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6783 if (wcorr5.gt.0.0d0)
6784 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6785 c write (iout,*) "gradcorr5 after eello5"
6787 c write (iout,'(i5,3f10.5)')
6788 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6790 if (energy_dec.and.wcorr5.gt.0.0d0)
6791 1 write (iout,'(a6,4i5,0pf7.3)')
6792 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6793 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6794 cd write(2,*)'ijkl',i,jp,i+1,jp1
6795 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6796 & .or. wturn6.eq.0.0d0))then
6797 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6798 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6799 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6800 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6801 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6802 cd & 'ecorr6=',ecorr6
6803 cd write (iout,'(4e15.5)') sred_geom,
6804 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6805 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6806 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6807 else if (wturn6.gt.0.0d0
6808 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6809 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6810 eturn6=eturn6+eello_turn6(i,jj,kk)
6811 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6812 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6813 cd write (2,*) 'multibody_eello:eturn6',eturn6
6822 num_cont_hb(i)=num_cont_hb_old(i)
6824 c write (iout,*) "gradcorr5 in eello5"
6826 c write (iout,'(i5,3f10.5)')
6827 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6831 c------------------------------------------------------------------------------
6832 subroutine add_hb_contact_eello(ii,jj,itask)
6833 implicit real*8 (a-h,o-z)
6834 include "DIMENSIONS"
6835 include "COMMON.IOUNITS"
6838 parameter (max_cont=maxconts)
6839 parameter (max_dim=70)
6840 include "COMMON.CONTACTS"
6841 double precision zapas(max_dim,maxconts,max_fg_procs),
6842 & zapas_recv(max_dim,maxconts,max_fg_procs)
6843 common /przechowalnia/ zapas
6844 integer i,j,ii,jj,iproc,itask(4),nn
6845 c write (iout,*) "itask",itask
6848 if (iproc.gt.0) then
6849 do j=1,num_cont_hb(ii)
6851 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6853 ncont_sent(iproc)=ncont_sent(iproc)+1
6854 nn=ncont_sent(iproc)
6855 zapas(1,nn,iproc)=ii
6856 zapas(2,nn,iproc)=jjc
6857 zapas(3,nn,iproc)=d_cont(j,ii)
6861 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6866 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6874 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6886 c------------------------------------------------------------------------------
6887 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6888 implicit real*8 (a-h,o-z)
6889 include 'DIMENSIONS'
6890 include 'COMMON.IOUNITS'
6891 include 'COMMON.DERIV'
6892 include 'COMMON.INTERACT'
6893 include 'COMMON.CONTACTS'
6894 double precision gx(3),gx1(3)
6904 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6905 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6906 C Following 4 lines for diagnostics.
6911 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6912 c & 'Contacts ',i,j,
6913 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6914 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6916 C Calculate the multi-body contribution to energy.
6917 c ecorr=ecorr+ekont*ees
6918 C Calculate multi-body contributions to the gradient.
6919 coeffpees0pij=coeffp*ees0pij
6920 coeffmees0mij=coeffm*ees0mij
6921 coeffpees0pkl=coeffp*ees0pkl
6922 coeffmees0mkl=coeffm*ees0mkl
6924 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6925 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6926 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6927 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6928 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6929 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6930 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6931 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6932 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6933 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6934 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6935 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6936 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6937 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6938 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6939 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6940 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6941 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6942 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6943 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6944 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6945 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6946 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6947 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6948 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6953 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6954 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6955 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6956 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6961 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6962 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6963 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6964 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6967 c write (iout,*) "ehbcorr",ekont*ees
6972 C---------------------------------------------------------------------------
6973 subroutine dipole(i,j,jj)
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'COMMON.IOUNITS'
6977 include 'COMMON.CHAIN'
6978 include 'COMMON.FFIELD'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.INTERACT'
6981 include 'COMMON.CONTACTS'
6982 include 'COMMON.TORSION'
6983 include 'COMMON.VAR'
6984 include 'COMMON.GEO'
6985 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6987 iti1 = itortyp(itype(i+1))
6988 if (j.lt.nres-1) then
6989 itj1 = itortyp(itype(j+1))
6994 dipi(iii,1)=Ub2(iii,i)
6995 dipderi(iii)=Ub2der(iii,i)
6996 dipi(iii,2)=b1(iii,iti1)
6997 dipj(iii,1)=Ub2(iii,j)
6998 dipderj(iii)=Ub2der(iii,j)
6999 dipj(iii,2)=b1(iii,itj1)
7003 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7006 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7013 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7017 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7022 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7023 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7025 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7027 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7029 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7034 C---------------------------------------------------------------------------
7035 subroutine calc_eello(i,j,k,l,jj,kk)
7037 C This subroutine computes matrices and vectors needed to calculate
7038 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7040 implicit real*8 (a-h,o-z)
7041 include 'DIMENSIONS'
7042 include 'COMMON.IOUNITS'
7043 include 'COMMON.CHAIN'
7044 include 'COMMON.DERIV'
7045 include 'COMMON.INTERACT'
7046 include 'COMMON.CONTACTS'
7047 include 'COMMON.TORSION'
7048 include 'COMMON.VAR'
7049 include 'COMMON.GEO'
7050 include 'COMMON.FFIELD'
7051 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7052 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7055 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7056 cd & ' jj=',jj,' kk=',kk
7057 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7058 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7059 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7062 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7063 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7066 call transpose2(aa1(1,1),aa1t(1,1))
7067 call transpose2(aa2(1,1),aa2t(1,1))
7070 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7071 & aa1tder(1,1,lll,kkk))
7072 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7073 & aa2tder(1,1,lll,kkk))
7077 C parallel orientation of the two CA-CA-CA frames.
7079 iti=itortyp(itype(i))
7083 itk1=itortyp(itype(k+1))
7084 itj=itortyp(itype(j))
7085 if (l.lt.nres-1) then
7086 itl1=itortyp(itype(l+1))
7090 C A1 kernel(j+1) A2T
7092 cd write (iout,'(3f10.5,5x,3f10.5)')
7093 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7095 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7096 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7097 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7098 C Following matrices are needed only for 6-th order cumulants
7099 IF (wcorr6.gt.0.0d0) THEN
7100 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7101 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7102 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7103 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7104 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7105 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7106 & ADtEAderx(1,1,1,1,1,1))
7108 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7109 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7110 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7111 & ADtEA1derx(1,1,1,1,1,1))
7113 C End 6-th order cumulants
7116 cd write (2,*) 'In calc_eello6'
7118 cd write (2,*) 'iii=',iii
7120 cd write (2,*) 'kkk=',kkk
7122 cd write (2,'(3(2f10.5),5x)')
7123 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7128 call transpose2(EUgder(1,1,k),auxmat(1,1))
7129 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7130 call transpose2(EUg(1,1,k),auxmat(1,1))
7131 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7132 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7136 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7137 & EAEAderx(1,1,lll,kkk,iii,1))
7141 C A1T kernel(i+1) A2
7142 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7143 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7144 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7145 C Following matrices are needed only for 6-th order cumulants
7146 IF (wcorr6.gt.0.0d0) THEN
7147 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7148 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7149 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7150 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7151 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7152 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7153 & ADtEAderx(1,1,1,1,1,2))
7154 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7155 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7156 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7157 & ADtEA1derx(1,1,1,1,1,2))
7159 C End 6-th order cumulants
7160 call transpose2(EUgder(1,1,l),auxmat(1,1))
7161 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7162 call transpose2(EUg(1,1,l),auxmat(1,1))
7163 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7164 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7168 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7169 & EAEAderx(1,1,lll,kkk,iii,2))
7174 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7175 C They are needed only when the fifth- or the sixth-order cumulants are
7177 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7178 call transpose2(AEA(1,1,1),auxmat(1,1))
7179 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7180 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7181 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7182 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7183 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7184 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7185 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7186 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7187 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7188 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7189 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7190 call transpose2(AEA(1,1,2),auxmat(1,1))
7191 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7192 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7193 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7194 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7195 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7196 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7197 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7198 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7199 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7200 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7201 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7202 C Calculate the Cartesian derivatives of the vectors.
7206 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7207 call matvec2(auxmat(1,1),b1(1,iti),
7208 & AEAb1derx(1,lll,kkk,iii,1,1))
7209 call matvec2(auxmat(1,1),Ub2(1,i),
7210 & AEAb2derx(1,lll,kkk,iii,1,1))
7211 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7212 & AEAb1derx(1,lll,kkk,iii,2,1))
7213 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7214 & AEAb2derx(1,lll,kkk,iii,2,1))
7215 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7216 call matvec2(auxmat(1,1),b1(1,itj),
7217 & AEAb1derx(1,lll,kkk,iii,1,2))
7218 call matvec2(auxmat(1,1),Ub2(1,j),
7219 & AEAb2derx(1,lll,kkk,iii,1,2))
7220 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7221 & AEAb1derx(1,lll,kkk,iii,2,2))
7222 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7223 & AEAb2derx(1,lll,kkk,iii,2,2))
7230 C Antiparallel orientation of the two CA-CA-CA frames.
7232 iti=itortyp(itype(i))
7236 itk1=itortyp(itype(k+1))
7237 itl=itortyp(itype(l))
7238 itj=itortyp(itype(j))
7239 if (j.lt.nres-1) then
7240 itj1=itortyp(itype(j+1))
7244 C A2 kernel(j-1)T A1T
7245 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7246 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7247 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7248 C Following matrices are needed only for 6-th order cumulants
7249 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7250 & j.eq.i+4 .and. l.eq.i+3)) THEN
7251 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7252 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7253 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7254 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7255 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7256 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7257 & ADtEAderx(1,1,1,1,1,1))
7258 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7259 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7260 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7261 & ADtEA1derx(1,1,1,1,1,1))
7263 C End 6-th order cumulants
7264 call transpose2(EUgder(1,1,k),auxmat(1,1))
7265 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7266 call transpose2(EUg(1,1,k),auxmat(1,1))
7267 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7268 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7272 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7273 & EAEAderx(1,1,lll,kkk,iii,1))
7277 C A2T kernel(i+1)T A1
7278 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7279 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7280 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7281 C Following matrices are needed only for 6-th order cumulants
7282 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7283 & j.eq.i+4 .and. l.eq.i+3)) THEN
7284 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7285 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7286 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7287 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7288 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7289 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7290 & ADtEAderx(1,1,1,1,1,2))
7291 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7292 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7293 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7294 & ADtEA1derx(1,1,1,1,1,2))
7296 C End 6-th order cumulants
7297 call transpose2(EUgder(1,1,j),auxmat(1,1))
7298 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7299 call transpose2(EUg(1,1,j),auxmat(1,1))
7300 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7301 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7305 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7306 & EAEAderx(1,1,lll,kkk,iii,2))
7311 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7312 C They are needed only when the fifth- or the sixth-order cumulants are
7314 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7315 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7316 call transpose2(AEA(1,1,1),auxmat(1,1))
7317 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7318 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7319 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7320 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7321 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7322 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7323 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7324 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7325 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7326 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7327 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7328 call transpose2(AEA(1,1,2),auxmat(1,1))
7329 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7330 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7331 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7332 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7333 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7334 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7335 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7336 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7337 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7338 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7339 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7340 C Calculate the Cartesian derivatives of the vectors.
7344 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7345 call matvec2(auxmat(1,1),b1(1,iti),
7346 & AEAb1derx(1,lll,kkk,iii,1,1))
7347 call matvec2(auxmat(1,1),Ub2(1,i),
7348 & AEAb2derx(1,lll,kkk,iii,1,1))
7349 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7350 & AEAb1derx(1,lll,kkk,iii,2,1))
7351 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7352 & AEAb2derx(1,lll,kkk,iii,2,1))
7353 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7354 call matvec2(auxmat(1,1),b1(1,itl),
7355 & AEAb1derx(1,lll,kkk,iii,1,2))
7356 call matvec2(auxmat(1,1),Ub2(1,l),
7357 & AEAb2derx(1,lll,kkk,iii,1,2))
7358 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7359 & AEAb1derx(1,lll,kkk,iii,2,2))
7360 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7361 & AEAb2derx(1,lll,kkk,iii,2,2))
7370 C---------------------------------------------------------------------------
7371 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7372 & KK,KKderg,AKA,AKAderg,AKAderx)
7376 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7377 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7378 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7383 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7385 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7388 cd if (lprn) write (2,*) 'In kernel'
7390 cd if (lprn) write (2,*) 'kkk=',kkk
7392 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7393 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7395 cd write (2,*) 'lll=',lll
7396 cd write (2,*) 'iii=1'
7398 cd write (2,'(3(2f10.5),5x)')
7399 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7402 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7403 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7405 cd write (2,*) 'lll=',lll
7406 cd write (2,*) 'iii=2'
7408 cd write (2,'(3(2f10.5),5x)')
7409 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7416 C---------------------------------------------------------------------------
7417 double precision function eello4(i,j,k,l,jj,kk)
7418 implicit real*8 (a-h,o-z)
7419 include 'DIMENSIONS'
7420 include 'COMMON.IOUNITS'
7421 include 'COMMON.CHAIN'
7422 include 'COMMON.DERIV'
7423 include 'COMMON.INTERACT'
7424 include 'COMMON.CONTACTS'
7425 include 'COMMON.TORSION'
7426 include 'COMMON.VAR'
7427 include 'COMMON.GEO'
7428 double precision pizda(2,2),ggg1(3),ggg2(3)
7429 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7433 cd print *,'eello4:',i,j,k,l,jj,kk
7434 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7435 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7436 cold eij=facont_hb(jj,i)
7437 cold ekl=facont_hb(kk,k)
7439 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7440 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7441 gcorr_loc(k-1)=gcorr_loc(k-1)
7442 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7444 gcorr_loc(l-1)=gcorr_loc(l-1)
7445 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7447 gcorr_loc(j-1)=gcorr_loc(j-1)
7448 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7453 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7454 & -EAEAderx(2,2,lll,kkk,iii,1)
7455 cd derx(lll,kkk,iii)=0.0d0
7459 cd gcorr_loc(l-1)=0.0d0
7460 cd gcorr_loc(j-1)=0.0d0
7461 cd gcorr_loc(k-1)=0.0d0
7463 cd write (iout,*)'Contacts have occurred for peptide groups',
7464 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7465 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7466 if (j.lt.nres-1) then
7473 if (l.lt.nres-1) then
7481 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7482 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7483 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7484 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7485 cgrad ghalf=0.5d0*ggg1(ll)
7486 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7487 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7488 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7489 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7490 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7491 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7492 cgrad ghalf=0.5d0*ggg2(ll)
7493 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7494 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7495 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7496 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7497 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7498 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7502 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7507 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7512 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7517 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7521 cd write (2,*) iii,gcorr_loc(iii)
7524 cd write (2,*) 'ekont',ekont
7525 cd write (iout,*) 'eello4',ekont*eel4
7528 C---------------------------------------------------------------------------
7529 double precision function eello5(i,j,k,l,jj,kk)
7530 implicit real*8 (a-h,o-z)
7531 include 'DIMENSIONS'
7532 include 'COMMON.IOUNITS'
7533 include 'COMMON.CHAIN'
7534 include 'COMMON.DERIV'
7535 include 'COMMON.INTERACT'
7536 include 'COMMON.CONTACTS'
7537 include 'COMMON.TORSION'
7538 include 'COMMON.VAR'
7539 include 'COMMON.GEO'
7540 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7541 double precision ggg1(3),ggg2(3)
7542 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7547 C /l\ / \ \ / \ / \ / C
7548 C / \ / \ \ / \ / \ / C
7549 C j| o |l1 | o | o| o | | o |o C
7550 C \ |/k\| |/ \| / |/ \| |/ \| C
7551 C \i/ \ / \ / / \ / \ C
7553 C (I) (II) (III) (IV) C
7555 C eello5_1 eello5_2 eello5_3 eello5_4 C
7557 C Antiparallel chains C
7560 C /j\ / \ \ / \ / \ / C
7561 C / \ / \ \ / \ / \ / C
7562 C j1| o |l | o | o| o | | o |o C
7563 C \ |/k\| |/ \| / |/ \| |/ \| C
7564 C \i/ \ / \ / / \ / \ C
7566 C (I) (II) (III) (IV) C
7568 C eello5_1 eello5_2 eello5_3 eello5_4 C
7570 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7572 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7573 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7578 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7580 itk=itortyp(itype(k))
7581 itl=itortyp(itype(l))
7582 itj=itortyp(itype(j))
7587 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7588 cd & eel5_3_num,eel5_4_num)
7592 derx(lll,kkk,iii)=0.0d0
7596 cd eij=facont_hb(jj,i)
7597 cd ekl=facont_hb(kk,k)
7599 cd write (iout,*)'Contacts have occurred for peptide groups',
7600 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7602 C Contribution from the graph I.
7603 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7604 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7605 call transpose2(EUg(1,1,k),auxmat(1,1))
7606 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7607 vv(1)=pizda(1,1)-pizda(2,2)
7608 vv(2)=pizda(1,2)+pizda(2,1)
7609 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7610 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7611 C Explicit gradient in virtual-dihedral angles.
7612 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7613 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7614 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7615 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7616 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7617 vv(1)=pizda(1,1)-pizda(2,2)
7618 vv(2)=pizda(1,2)+pizda(2,1)
7619 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7620 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7621 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7622 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7623 vv(1)=pizda(1,1)-pizda(2,2)
7624 vv(2)=pizda(1,2)+pizda(2,1)
7626 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7627 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7628 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7630 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7631 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7632 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7634 C Cartesian gradient
7638 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7640 vv(1)=pizda(1,1)-pizda(2,2)
7641 vv(2)=pizda(1,2)+pizda(2,1)
7642 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7643 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7644 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7650 C Contribution from graph II
7651 call transpose2(EE(1,1,itk),auxmat(1,1))
7652 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7653 vv(1)=pizda(1,1)+pizda(2,2)
7654 vv(2)=pizda(2,1)-pizda(1,2)
7655 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7656 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7657 C Explicit gradient in virtual-dihedral angles.
7658 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7659 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7660 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7661 vv(1)=pizda(1,1)+pizda(2,2)
7662 vv(2)=pizda(2,1)-pizda(1,2)
7664 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7665 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7666 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7668 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7669 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7670 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7672 C Cartesian gradient
7676 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7678 vv(1)=pizda(1,1)+pizda(2,2)
7679 vv(2)=pizda(2,1)-pizda(1,2)
7680 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7681 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7682 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7690 C Parallel orientation
7691 C Contribution from graph III
7692 call transpose2(EUg(1,1,l),auxmat(1,1))
7693 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7694 vv(1)=pizda(1,1)-pizda(2,2)
7695 vv(2)=pizda(1,2)+pizda(2,1)
7696 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7697 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7698 C Explicit gradient in virtual-dihedral angles.
7699 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7700 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7701 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7702 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7703 vv(1)=pizda(1,1)-pizda(2,2)
7704 vv(2)=pizda(1,2)+pizda(2,1)
7705 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7706 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7707 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7708 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7709 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)-pizda(2,2)
7711 vv(2)=pizda(1,2)+pizda(2,1)
7712 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7713 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7714 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7715 C Cartesian gradient
7719 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7721 vv(1)=pizda(1,1)-pizda(2,2)
7722 vv(2)=pizda(1,2)+pizda(2,1)
7723 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7724 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7725 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7730 C Contribution from graph IV
7732 call transpose2(EE(1,1,itl),auxmat(1,1))
7733 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7734 vv(1)=pizda(1,1)+pizda(2,2)
7735 vv(2)=pizda(2,1)-pizda(1,2)
7736 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7737 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7738 C Explicit gradient in virtual-dihedral angles.
7739 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7740 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7741 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7742 vv(1)=pizda(1,1)+pizda(2,2)
7743 vv(2)=pizda(2,1)-pizda(1,2)
7744 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7745 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7746 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7747 C Cartesian gradient
7751 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7753 vv(1)=pizda(1,1)+pizda(2,2)
7754 vv(2)=pizda(2,1)-pizda(1,2)
7755 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7756 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7757 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7762 C Antiparallel orientation
7763 C Contribution from graph III
7765 call transpose2(EUg(1,1,j),auxmat(1,1))
7766 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7767 vv(1)=pizda(1,1)-pizda(2,2)
7768 vv(2)=pizda(1,2)+pizda(2,1)
7769 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7770 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7771 C Explicit gradient in virtual-dihedral angles.
7772 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7773 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7774 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7775 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7776 vv(1)=pizda(1,1)-pizda(2,2)
7777 vv(2)=pizda(1,2)+pizda(2,1)
7778 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7779 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7780 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7781 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7782 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7783 vv(1)=pizda(1,1)-pizda(2,2)
7784 vv(2)=pizda(1,2)+pizda(2,1)
7785 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7786 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7787 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7788 C Cartesian gradient
7792 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7794 vv(1)=pizda(1,1)-pizda(2,2)
7795 vv(2)=pizda(1,2)+pizda(2,1)
7796 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7797 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7798 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7803 C Contribution from graph IV
7805 call transpose2(EE(1,1,itj),auxmat(1,1))
7806 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7807 vv(1)=pizda(1,1)+pizda(2,2)
7808 vv(2)=pizda(2,1)-pizda(1,2)
7809 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7810 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7811 C Explicit gradient in virtual-dihedral angles.
7812 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7813 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7814 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7815 vv(1)=pizda(1,1)+pizda(2,2)
7816 vv(2)=pizda(2,1)-pizda(1,2)
7817 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7818 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7819 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7820 C Cartesian gradient
7824 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7826 vv(1)=pizda(1,1)+pizda(2,2)
7827 vv(2)=pizda(2,1)-pizda(1,2)
7828 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7829 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7830 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7836 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7837 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7838 cd write (2,*) 'ijkl',i,j,k,l
7839 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7840 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7842 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7843 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7844 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7845 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7846 if (j.lt.nres-1) then
7853 if (l.lt.nres-1) then
7863 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7864 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7865 C summed up outside the subrouine as for the other subroutines
7866 C handling long-range interactions. The old code is commented out
7867 C with "cgrad" to keep track of changes.
7869 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7870 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7871 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7872 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7873 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7874 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7875 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7876 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7877 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7878 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7880 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7881 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7882 cgrad ghalf=0.5d0*ggg1(ll)
7884 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7885 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7886 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7887 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7888 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7889 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7890 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7891 cgrad ghalf=0.5d0*ggg2(ll)
7893 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7894 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7895 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7896 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7897 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7898 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7903 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7904 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7909 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7910 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7916 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7921 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7925 cd write (2,*) iii,g_corr5_loc(iii)
7928 cd write (2,*) 'ekont',ekont
7929 cd write (iout,*) 'eello5',ekont*eel5
7932 c--------------------------------------------------------------------------
7933 double precision function eello6(i,j,k,l,jj,kk)
7934 implicit real*8 (a-h,o-z)
7935 include 'DIMENSIONS'
7936 include 'COMMON.IOUNITS'
7937 include 'COMMON.CHAIN'
7938 include 'COMMON.DERIV'
7939 include 'COMMON.INTERACT'
7940 include 'COMMON.CONTACTS'
7941 include 'COMMON.TORSION'
7942 include 'COMMON.VAR'
7943 include 'COMMON.GEO'
7944 include 'COMMON.FFIELD'
7945 double precision ggg1(3),ggg2(3)
7946 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7951 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7959 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7960 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7964 derx(lll,kkk,iii)=0.0d0
7968 cd eij=facont_hb(jj,i)
7969 cd ekl=facont_hb(kk,k)
7975 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7976 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7977 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7978 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7979 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7980 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7982 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7983 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7984 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7985 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7986 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7987 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7991 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7993 C If turn contributions are considered, they will be handled separately.
7994 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7995 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7996 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7997 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7998 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7999 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8000 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8002 if (j.lt.nres-1) then
8009 if (l.lt.nres-1) then
8017 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8018 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8019 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8020 cgrad ghalf=0.5d0*ggg1(ll)
8022 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8023 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8024 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8025 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8026 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8027 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8028 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8029 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8030 cgrad ghalf=0.5d0*ggg2(ll)
8031 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8033 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8034 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8035 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8036 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8037 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8038 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8043 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8044 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8049 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8050 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8056 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8061 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8065 cd write (2,*) iii,g_corr6_loc(iii)
8068 cd write (2,*) 'ekont',ekont
8069 cd write (iout,*) 'eello6',ekont*eel6
8072 c--------------------------------------------------------------------------
8073 double precision function eello6_graph1(i,j,k,l,imat,swap)
8074 implicit real*8 (a-h,o-z)
8075 include 'DIMENSIONS'
8076 include 'COMMON.IOUNITS'
8077 include 'COMMON.CHAIN'
8078 include 'COMMON.DERIV'
8079 include 'COMMON.INTERACT'
8080 include 'COMMON.CONTACTS'
8081 include 'COMMON.TORSION'
8082 include 'COMMON.VAR'
8083 include 'COMMON.GEO'
8084 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8088 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8090 C Parallel Antiparallel
8096 C \ j|/k\| / \ |/k\|l /
8101 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8102 itk=itortyp(itype(k))
8103 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8104 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8105 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8106 call transpose2(EUgC(1,1,k),auxmat(1,1))
8107 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8108 vv1(1)=pizda1(1,1)-pizda1(2,2)
8109 vv1(2)=pizda1(1,2)+pizda1(2,1)
8110 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8111 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8112 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8113 s5=scalar2(vv(1),Dtobr2(1,i))
8114 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8115 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8116 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8117 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8118 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8119 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8120 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8121 & +scalar2(vv(1),Dtobr2der(1,i)))
8122 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8123 vv1(1)=pizda1(1,1)-pizda1(2,2)
8124 vv1(2)=pizda1(1,2)+pizda1(2,1)
8125 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8126 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8128 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8129 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8130 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8131 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8132 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8134 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8135 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8136 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8137 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8138 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8140 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8141 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8142 vv1(1)=pizda1(1,1)-pizda1(2,2)
8143 vv1(2)=pizda1(1,2)+pizda1(2,1)
8144 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8145 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8146 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8147 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8156 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8157 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8158 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8159 call transpose2(EUgC(1,1,k),auxmat(1,1))
8160 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8162 vv1(1)=pizda1(1,1)-pizda1(2,2)
8163 vv1(2)=pizda1(1,2)+pizda1(2,1)
8164 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8165 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8166 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8167 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8168 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8169 s5=scalar2(vv(1),Dtobr2(1,i))
8170 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8176 c----------------------------------------------------------------------------
8177 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8178 implicit real*8 (a-h,o-z)
8179 include 'DIMENSIONS'
8180 include 'COMMON.IOUNITS'
8181 include 'COMMON.CHAIN'
8182 include 'COMMON.DERIV'
8183 include 'COMMON.INTERACT'
8184 include 'COMMON.CONTACTS'
8185 include 'COMMON.TORSION'
8186 include 'COMMON.VAR'
8187 include 'COMMON.GEO'
8189 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8190 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8193 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8195 C Parallel Antiparallel C
8201 C \ j|/k\| \ |/k\|l C
8206 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8207 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8208 C AL 7/4/01 s1 would occur in the sixth-order moment,
8209 C but not in a cluster cumulant
8211 s1=dip(1,jj,i)*dip(1,kk,k)
8213 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8214 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8215 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8216 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8217 call transpose2(EUg(1,1,k),auxmat(1,1))
8218 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8219 vv(1)=pizda(1,1)-pizda(2,2)
8220 vv(2)=pizda(1,2)+pizda(2,1)
8221 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8222 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8224 eello6_graph2=-(s1+s2+s3+s4)
8226 eello6_graph2=-(s2+s3+s4)
8229 C Derivatives in gamma(i-1)
8232 s1=dipderg(1,jj,i)*dip(1,kk,k)
8234 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8235 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8236 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8237 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8239 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8241 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8243 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8245 C Derivatives in gamma(k-1)
8247 s1=dip(1,jj,i)*dipderg(1,kk,k)
8249 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8250 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8251 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8252 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8253 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8254 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8255 vv(1)=pizda(1,1)-pizda(2,2)
8256 vv(2)=pizda(1,2)+pizda(2,1)
8257 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8259 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8261 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8263 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8264 C Derivatives in gamma(j-1) or gamma(l-1)
8267 s1=dipderg(3,jj,i)*dip(1,kk,k)
8269 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8270 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8271 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8272 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8273 vv(1)=pizda(1,1)-pizda(2,2)
8274 vv(2)=pizda(1,2)+pizda(2,1)
8275 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8278 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8280 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8283 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8284 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8286 C Derivatives in gamma(l-1) or gamma(j-1)
8289 s1=dip(1,jj,i)*dipderg(3,kk,k)
8291 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8292 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8293 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8294 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8295 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8296 vv(1)=pizda(1,1)-pizda(2,2)
8297 vv(2)=pizda(1,2)+pizda(2,1)
8298 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8301 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8303 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8306 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8307 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8309 C Cartesian derivatives.
8311 write (2,*) 'In eello6_graph2'
8313 write (2,*) 'iii=',iii
8315 write (2,*) 'kkk=',kkk
8317 write (2,'(3(2f10.5),5x)')
8318 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8328 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8330 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8333 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8335 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8336 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8338 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8339 call transpose2(EUg(1,1,k),auxmat(1,1))
8340 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8342 vv(1)=pizda(1,1)-pizda(2,2)
8343 vv(2)=pizda(1,2)+pizda(2,1)
8344 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8345 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8347 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8349 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8352 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8354 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8361 c----------------------------------------------------------------------------
8362 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8363 implicit real*8 (a-h,o-z)
8364 include 'DIMENSIONS'
8365 include 'COMMON.IOUNITS'
8366 include 'COMMON.CHAIN'
8367 include 'COMMON.DERIV'
8368 include 'COMMON.INTERACT'
8369 include 'COMMON.CONTACTS'
8370 include 'COMMON.TORSION'
8371 include 'COMMON.VAR'
8372 include 'COMMON.GEO'
8373 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8375 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8377 C Parallel Antiparallel C
8383 C j|/k\| / |/k\|l / C
8388 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8390 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8391 C energy moment and not to the cluster cumulant.
8392 iti=itortyp(itype(i))
8393 if (j.lt.nres-1) then
8394 itj1=itortyp(itype(j+1))
8398 itk=itortyp(itype(k))
8399 itk1=itortyp(itype(k+1))
8400 if (l.lt.nres-1) then
8401 itl1=itortyp(itype(l+1))
8406 s1=dip(4,jj,i)*dip(4,kk,k)
8408 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8409 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8410 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8411 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8412 call transpose2(EE(1,1,itk),auxmat(1,1))
8413 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8414 vv(1)=pizda(1,1)+pizda(2,2)
8415 vv(2)=pizda(2,1)-pizda(1,2)
8416 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8417 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8418 cd & "sum",-(s2+s3+s4)
8420 eello6_graph3=-(s1+s2+s3+s4)
8422 eello6_graph3=-(s2+s3+s4)
8425 C Derivatives in gamma(k-1)
8426 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8427 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8428 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8429 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8430 C Derivatives in gamma(l-1)
8431 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8432 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8433 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8434 vv(1)=pizda(1,1)+pizda(2,2)
8435 vv(2)=pizda(2,1)-pizda(1,2)
8436 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8437 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8438 C Cartesian derivatives.
8444 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8446 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8449 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8451 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8452 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8454 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8455 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8457 vv(1)=pizda(1,1)+pizda(2,2)
8458 vv(2)=pizda(2,1)-pizda(1,2)
8459 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8461 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8463 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8466 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8468 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8470 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8476 c----------------------------------------------------------------------------
8477 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8478 implicit real*8 (a-h,o-z)
8479 include 'DIMENSIONS'
8480 include 'COMMON.IOUNITS'
8481 include 'COMMON.CHAIN'
8482 include 'COMMON.DERIV'
8483 include 'COMMON.INTERACT'
8484 include 'COMMON.CONTACTS'
8485 include 'COMMON.TORSION'
8486 include 'COMMON.VAR'
8487 include 'COMMON.GEO'
8488 include 'COMMON.FFIELD'
8489 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8490 & auxvec1(2),auxmat1(2,2)
8492 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8494 C Parallel Antiparallel C
8500 C \ j|/k\| \ |/k\|l C
8505 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8507 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8508 C energy moment and not to the cluster cumulant.
8509 cd write (2,*) 'eello_graph4: wturn6',wturn6
8510 iti=itortyp(itype(i))
8511 itj=itortyp(itype(j))
8512 if (j.lt.nres-1) then
8513 itj1=itortyp(itype(j+1))
8517 itk=itortyp(itype(k))
8518 if (k.lt.nres-1) then
8519 itk1=itortyp(itype(k+1))
8523 itl=itortyp(itype(l))
8524 if (l.lt.nres-1) then
8525 itl1=itortyp(itype(l+1))
8529 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8530 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8531 cd & ' itl',itl,' itl1',itl1
8534 s1=dip(3,jj,i)*dip(3,kk,k)
8536 s1=dip(2,jj,j)*dip(2,kk,l)
8539 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8540 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8542 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8543 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8545 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8546 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8548 call transpose2(EUg(1,1,k),auxmat(1,1))
8549 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8550 vv(1)=pizda(1,1)-pizda(2,2)
8551 vv(2)=pizda(2,1)+pizda(1,2)
8552 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8553 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8555 eello6_graph4=-(s1+s2+s3+s4)
8557 eello6_graph4=-(s2+s3+s4)
8559 C Derivatives in gamma(i-1)
8563 s1=dipderg(2,jj,i)*dip(3,kk,k)
8565 s1=dipderg(4,jj,j)*dip(2,kk,l)
8568 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8570 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8571 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8573 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8574 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8576 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8577 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8578 cd write (2,*) 'turn6 derivatives'
8580 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8582 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8586 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8588 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8592 C Derivatives in gamma(k-1)
8595 s1=dip(3,jj,i)*dipderg(2,kk,k)
8597 s1=dip(2,jj,j)*dipderg(4,kk,l)
8600 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8601 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8603 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8604 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8606 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8607 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8609 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8610 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8611 vv(1)=pizda(1,1)-pizda(2,2)
8612 vv(2)=pizda(2,1)+pizda(1,2)
8613 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8614 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8616 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8618 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8622 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8624 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8627 C Derivatives in gamma(j-1) or gamma(l-1)
8628 if (l.eq.j+1 .and. l.gt.1) then
8629 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8630 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8631 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8632 vv(1)=pizda(1,1)-pizda(2,2)
8633 vv(2)=pizda(2,1)+pizda(1,2)
8634 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8635 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8636 else if (j.gt.1) then
8637 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8638 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8639 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8640 vv(1)=pizda(1,1)-pizda(2,2)
8641 vv(2)=pizda(2,1)+pizda(1,2)
8642 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8643 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8644 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8646 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8649 C Cartesian derivatives.
8656 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8658 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8662 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8664 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8668 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8670 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8672 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8673 & b1(1,itj1),auxvec(1))
8674 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8676 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8677 & b1(1,itl1),auxvec(1))
8678 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8680 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8682 vv(1)=pizda(1,1)-pizda(2,2)
8683 vv(2)=pizda(2,1)+pizda(1,2)
8684 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8686 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8688 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8691 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8694 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8697 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8699 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8701 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8705 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8710 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8712 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8720 c----------------------------------------------------------------------------
8721 double precision function eello_turn6(i,jj,kk)
8722 implicit real*8 (a-h,o-z)
8723 include 'DIMENSIONS'
8724 include 'COMMON.IOUNITS'
8725 include 'COMMON.CHAIN'
8726 include 'COMMON.DERIV'
8727 include 'COMMON.INTERACT'
8728 include 'COMMON.CONTACTS'
8729 include 'COMMON.TORSION'
8730 include 'COMMON.VAR'
8731 include 'COMMON.GEO'
8732 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8733 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8735 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8736 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8737 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8738 C the respective energy moment and not to the cluster cumulant.
8747 iti=itortyp(itype(i))
8748 itk=itortyp(itype(k))
8749 itk1=itortyp(itype(k+1))
8750 itl=itortyp(itype(l))
8751 itj=itortyp(itype(j))
8752 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8753 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8754 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8759 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8761 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8765 derx_turn(lll,kkk,iii)=0.0d0
8772 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8774 cd write (2,*) 'eello6_5',eello6_5
8776 call transpose2(AEA(1,1,1),auxmat(1,1))
8777 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8778 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8779 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8781 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8782 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8783 s2 = scalar2(b1(1,itk),vtemp1(1))
8785 call transpose2(AEA(1,1,2),atemp(1,1))
8786 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8787 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8788 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8790 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8791 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8792 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8794 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8795 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8796 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8797 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8798 ss13 = scalar2(b1(1,itk),vtemp4(1))
8799 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8801 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8807 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8808 C Derivatives in gamma(i+2)
8812 call transpose2(AEA(1,1,1),auxmatd(1,1))
8813 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8814 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8815 call transpose2(AEAderg(1,1,2),atempd(1,1))
8816 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8817 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8819 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8820 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8821 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8827 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8828 C Derivatives in gamma(i+3)
8830 call transpose2(AEA(1,1,1),auxmatd(1,1))
8831 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8832 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8833 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8835 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8836 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8837 s2d = scalar2(b1(1,itk),vtemp1d(1))
8839 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8840 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8842 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8844 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8845 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8846 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8854 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8855 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8857 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8858 & -0.5d0*ekont*(s2d+s12d)
8860 C Derivatives in gamma(i+4)
8861 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8862 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8863 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8865 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8866 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8867 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8875 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8877 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8879 C Derivatives in gamma(i+5)
8881 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8882 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8883 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8885 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8886 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8887 s2d = scalar2(b1(1,itk),vtemp1d(1))
8889 call transpose2(AEA(1,1,2),atempd(1,1))
8890 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8891 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8893 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8894 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8896 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8897 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8898 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8906 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8907 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8909 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8910 & -0.5d0*ekont*(s2d+s12d)
8912 C Cartesian derivatives
8917 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8918 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8919 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8921 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8922 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8924 s2d = scalar2(b1(1,itk),vtemp1d(1))
8926 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8927 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8928 s8d = -(atempd(1,1)+atempd(2,2))*
8929 & scalar2(cc(1,1,itl),vtemp2(1))
8931 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8933 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8934 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8941 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8944 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8948 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8949 & - 0.5d0*(s8d+s12d)
8951 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8960 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8962 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8963 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8964 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8965 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8966 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8968 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8969 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8970 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8974 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8975 cd & 16*eel_turn6_num
8977 if (j.lt.nres-1) then
8984 if (l.lt.nres-1) then
8992 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8993 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8994 cgrad ghalf=0.5d0*ggg1(ll)
8996 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8997 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8998 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8999 & +ekont*derx_turn(ll,2,1)
9000 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9001 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9002 & +ekont*derx_turn(ll,4,1)
9003 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9004 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9005 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9006 cgrad ghalf=0.5d0*ggg2(ll)
9008 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9009 & +ekont*derx_turn(ll,2,2)
9010 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9011 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9012 & +ekont*derx_turn(ll,4,2)
9013 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9014 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9015 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9020 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9025 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9031 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9036 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9040 cd write (2,*) iii,g_corr6_loc(iii)
9042 eello_turn6=ekont*eel_turn6
9043 cd write (2,*) 'ekont',ekont
9044 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9048 C-----------------------------------------------------------------------------
9049 double precision function scalar(u,v)
9050 !DIR$ INLINEALWAYS scalar
9052 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9055 double precision u(3),v(3)
9056 cd double precision sc
9064 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9067 crc-------------------------------------------------
9068 SUBROUTINE MATVEC2(A1,V1,V2)
9069 !DIR$ INLINEALWAYS MATVEC2
9071 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9073 implicit real*8 (a-h,o-z)
9074 include 'DIMENSIONS'
9075 DIMENSION A1(2,2),V1(2),V2(2)
9079 c 3 VI=VI+A1(I,K)*V1(K)
9083 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9084 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9089 C---------------------------------------
9090 SUBROUTINE MATMAT2(A1,A2,A3)
9092 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9094 implicit real*8 (a-h,o-z)
9095 include 'DIMENSIONS'
9096 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9097 c DIMENSION AI3(2,2)
9101 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9107 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9108 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9109 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9110 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9118 c-------------------------------------------------------------------------
9119 double precision function scalar2(u,v)
9120 !DIR$ INLINEALWAYS scalar2
9122 double precision u(2),v(2)
9125 scalar2=u(1)*v(1)+u(2)*v(2)
9129 C-----------------------------------------------------------------------------
9131 subroutine transpose2(a,at)
9132 !DIR$ INLINEALWAYS transpose2
9134 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9137 double precision a(2,2),at(2,2)
9144 c--------------------------------------------------------------------------
9145 subroutine transpose(n,a,at)
9148 double precision a(n,n),at(n,n)
9156 C---------------------------------------------------------------------------
9157 subroutine prodmat3(a1,a2,kk,transp,prod)
9158 !DIR$ INLINEALWAYS prodmat3
9160 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9164 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9166 crc double precision auxmat(2,2),prod_(2,2)
9169 crc call transpose2(kk(1,1),auxmat(1,1))
9170 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9171 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9173 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9174 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9175 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9176 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9177 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9178 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9179 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9180 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9183 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9184 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9186 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9187 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9188 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9189 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9190 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9191 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9192 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9193 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9196 c call transpose2(a2(1,1),a2t(1,1))
9199 crc print *,((prod_(i,j),i=1,2),j=1,2)
9200 crc print *,((prod(i,j),i=1,2),j=1,2)