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.
135 C BARTEK for dfa test!
136 if (wdfa_dist.gt.0) call edfad(edfadis)
137 c print*, 'edfad is finished!', edfadis
138 if (wdfa_tor.gt.0) call edfat(edfator)
139 c print*, 'edfat is finished!', edfator
140 if (wdfa_nei.gt.0) call edfan(edfanei)
141 c print*, 'edfan is finished!', edfanei
142 if (wdfa_beta.gt.0) call edfab(edfabet)
143 c print*, 'edfab is finished!', edfabet
147 c print *,"Processor",myrank," computed USCSC"
158 time_vec=time_vec+MPI_Wtime()-time01
160 time_vec=time_vec+tcpu()-time01
163 c print *,"Processor",myrank," left VEC_AND_DERIV"
166 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
167 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
168 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
169 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
171 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
172 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
173 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
174 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
176 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
185 c write (iout,*) "Soft-spheer ELEC potential"
186 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
189 c print *,"Processor",myrank," computed UELEC"
191 C Calculate excluded-volume interaction energy between peptide groups
196 call escp(evdw2,evdw2_14)
202 c write (iout,*) "Soft-sphere SCP potential"
203 call escp_soft_sphere(evdw2,evdw2_14)
206 c Calculate the bond-stretching energy
210 C Calculate the disulfide-bridge and other energy and the contributions
211 C from other distance constraints.
212 cd print *,'Calling EHPB'
214 cd print *,'EHPB exitted succesfully.'
216 C Calculate the virtual-bond-angle energy.
218 if (wang.gt.0d0) then
223 c print *,"Processor",myrank," computed UB"
225 C Calculate the SC local energy.
228 c print *,"Processor",myrank," computed USC"
230 C Calculate the virtual-bond torsional energy.
232 cd print *,'nterm=',nterm
234 call etor(etors,edihcnstr)
239 c print *,"Processor",myrank," computed Utor"
241 C 6/23/01 Calculate double-torsional energy
243 if (wtor_d.gt.0) then
248 c print *,"Processor",myrank," computed Utord"
250 C 21/5/07 Calculate local sicdechain correlation energy
252 if (wsccor.gt.0.0d0) then
253 call eback_sc_corr(esccor)
257 c print *,"Processor",myrank," computed Usccorr"
259 C 12/1/95 Multi-body terms
263 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
264 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
265 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
266 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
267 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
274 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
275 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
276 cd write (iout,*) "multibody_hb ecorr",ecorr
278 c print *,"Processor",myrank," computed Ucorr"
280 C If performing constraint dynamics, call the constraint energy
281 C after the equilibration time
282 if(usampl.and.totT.gt.eq_time) then
291 time_enecalc=time_enecalc+MPI_Wtime()-time00
293 time_enecalc=time_enecalc+tcpu()-time00
296 c print *,"Processor",myrank," computed Uconstr"
309 energia(2)=evdw2-evdw2_14
326 energia(8)=eello_turn3
327 energia(9)=eello_turn4
334 energia(19)=edihcnstr
336 energia(20)=Uconst+Uconst_back
344 c print *," Processor",myrank," calls SUM_ENERGY"
345 call sum_energy(energia,.true.)
346 c print *," Processor",myrank," left SUM_ENERGY"
349 time_sumene=time_sumene+MPI_Wtime()-time00
351 time_sumene=time_sumene+tcpu()-time00
356 c-------------------------------------------------------------------------------
357 subroutine sum_energy(energia,reduce)
358 implicit real*8 (a-h,o-z)
363 cMS$ATTRIBUTES C :: proc_proc
369 include 'COMMON.SETUP'
370 include 'COMMON.IOUNITS'
371 double precision energia(0:n_ene),enebuff(0:n_ene+1)
372 include 'COMMON.FFIELD'
373 include 'COMMON.DERIV'
374 include 'COMMON.INTERACT'
375 include 'COMMON.SBRIDGE'
376 include 'COMMON.CHAIN'
378 include 'COMMON.CONTROL'
379 include 'COMMON.TIME1'
382 if (nfgtasks.gt.1 .and. reduce) then
384 write (iout,*) "energies before REDUCE"
385 call enerprint(energia)
389 enebuff(i)=energia(i)
392 call MPI_Barrier(FG_COMM,IERR)
393 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
395 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
396 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
398 write (iout,*) "energies after REDUCE"
399 call enerprint(energia)
402 time_Reduce=time_Reduce+MPI_Wtime()-time00
404 if (fg_rank.eq.0) then
407 evdw=energia(22)+wsct*energia(23)
412 evdw2=energia(2)+energia(18)
428 eello_turn3=energia(8)
429 eello_turn4=energia(9)
436 edihcnstr=energia(19)
445 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
446 & +wang*ebe+wtor*etors+wscloc*escloc
447 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
448 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
449 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
450 & +wbond*estr+Uconst+wsccor*esccor
451 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
454 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
455 & +wang*ebe+wtor*etors+wscloc*escloc
456 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
457 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
458 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
459 & +wbond*estr+Uconst+wsccor*esccor
460 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
468 if (isnan(etot).ne.0) energia(0)=1.0d+99
470 if (isnan(etot)) energia(0)=1.0d+99
475 idumm=proc_proc(etot,i)
477 call proc_proc(etot,i)
479 if(i.eq.1)energia(0)=1.0d+99
486 c-------------------------------------------------------------------------------
487 subroutine sum_gradient
488 implicit real*8 (a-h,o-z)
493 cMS$ATTRIBUTES C :: proc_proc
499 double precision gradbufc(3,maxres),gradbufx(3,maxres),
500 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
501 include 'COMMON.SETUP'
502 include 'COMMON.IOUNITS'
503 include 'COMMON.FFIELD'
504 include 'COMMON.DERIV'
505 include 'COMMON.INTERACT'
506 include 'COMMON.SBRIDGE'
507 include 'COMMON.CHAIN'
509 include 'COMMON.CONTROL'
510 include 'COMMON.TIME1'
511 include 'COMMON.MAXGRAD'
512 include 'COMMON.SCCOR'
521 write (iout,*) "sum_gradient gvdwc, gvdwx"
523 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
524 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
525 & (gvdwcT(j,i),j=1,3)
530 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
531 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
532 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
535 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
536 C in virtual-bond-vector coordinates
539 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
541 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
542 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
544 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
546 c write (iout,'(i5,3f10.5,2x,f10.5)')
547 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
549 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
551 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
552 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
561 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
562 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
563 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
564 & wel_loc*gel_loc_long(j,i)+
565 & wcorr*gradcorr_long(j,i)+
566 & wcorr5*gradcorr5_long(j,i)+
567 & wcorr6*gradcorr6_long(j,i)+
568 & wturn6*gcorr6_turn_long(j,i)+
569 & wstrain*ghpbc(j,i)+
570 & wdfa_dist*gdfad(j,i)+
571 & wdfa_tor*gdfat(j,i)+
572 & wdfa_nei*gdfan(j,i)+
573 & wdfa_beta*gdfab(j,i)
580 gradbufc(j,i)=wsc*gvdwc(j,i)+
581 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
582 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
583 & wel_loc*gel_loc_long(j,i)+
584 & wcorr*gradcorr_long(j,i)+
585 & wcorr5*gradcorr5_long(j,i)+
586 & wcorr6*gradcorr6_long(j,i)+
587 & wturn6*gcorr6_turn_long(j,i)+
588 & wstrain*ghpbc(j,i)+
589 & wdfa_dist*gdfad(j,i)+
590 & wdfa_tor*gdfat(j,i)+
591 & wdfa_nei*gdfan(j,i)+
592 & wdfa_beta*gdfab(j,i)
600 gradbufc(j,i)=wsc*gvdwc(j,i)+
601 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
602 & welec*gelc_long(j,i)+
604 & wel_loc*gel_loc_long(j,i)+
605 & wcorr*gradcorr_long(j,i)+
606 & wcorr5*gradcorr5_long(j,i)+
607 & wcorr6*gradcorr6_long(j,i)+
608 & wturn6*gcorr6_turn_long(j,i)+
609 & wstrain*ghpbc(j,i)+
610 & wdfa_dist*gdfad(j,i)+
611 & wdfa_tor*gdfat(j,i)+
612 & wdfa_nei*gdfan(j,i)+
613 & wdfa_beta*gdfab(j,i)
620 if (nfgtasks.gt.1) then
623 write (iout,*) "gradbufc before allreduce"
625 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
631 gradbufc_sum(j,i)=gradbufc(j,i)
634 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
635 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
636 c time_reduce=time_reduce+MPI_Wtime()-time00
638 c write (iout,*) "gradbufc_sum after allreduce"
640 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
645 c time_allreduce=time_allreduce+MPI_Wtime()-time00
653 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
654 write (iout,*) (i," jgrad_start",jgrad_start(i),
655 & " jgrad_end ",jgrad_end(i),
656 & i=igrad_start,igrad_end)
659 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
660 c do not parallelize this part.
662 c do i=igrad_start,igrad_end
663 c do j=jgrad_start(i),jgrad_end(i)
665 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
670 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
674 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
678 write (iout,*) "gradbufc after summing"
680 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
687 write (iout,*) "gradbufc"
689 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
695 gradbufc_sum(j,i)=gradbufc(j,i)
700 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
704 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
709 c gradbufc(k,i)=0.0d0
713 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
718 write (iout,*) "gradbufc after summing"
720 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
728 gradbufc(k,nres)=0.0d0
733 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
734 & wel_loc*gel_loc(j,i)+
735 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
736 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
737 & wel_loc*gel_loc_long(j,i)+
738 & wcorr*gradcorr_long(j,i)+
739 & wcorr5*gradcorr5_long(j,i)+
740 & wcorr6*gradcorr6_long(j,i)+
741 & wturn6*gcorr6_turn_long(j,i))+
743 & wcorr*gradcorr(j,i)+
744 & wturn3*gcorr3_turn(j,i)+
745 & wturn4*gcorr4_turn(j,i)+
746 & wcorr5*gradcorr5(j,i)+
747 & wcorr6*gradcorr6(j,i)+
748 & wturn6*gcorr6_turn(j,i)+
749 & wsccor*gsccorc(j,i)
750 & +wscloc*gscloc(j,i)
752 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
753 & wel_loc*gel_loc(j,i)+
754 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
755 & welec*gelc_long(j,i)+
756 & wel_loc*gel_loc_long(j,i)+
757 & wcorr*gcorr_long(j,i)+
758 & wcorr5*gradcorr5_long(j,i)+
759 & wcorr6*gradcorr6_long(j,i)+
760 & wturn6*gcorr6_turn_long(j,i))+
762 & wcorr*gradcorr(j,i)+
763 & wturn3*gcorr3_turn(j,i)+
764 & wturn4*gcorr4_turn(j,i)+
765 & wcorr5*gradcorr5(j,i)+
766 & wcorr6*gradcorr6(j,i)+
767 & wturn6*gcorr6_turn(j,i)+
768 & wsccor*gsccorc(j,i)
769 & +wscloc*gscloc(j,i)
772 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
773 & wscp*gradx_scp(j,i)+
775 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
776 & wsccor*gsccorx(j,i)
777 & +wscloc*gsclocx(j,i)
779 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
781 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
782 & wsccor*gsccorx(j,i)
783 & +wscloc*gsclocx(j,i)
788 write (iout,*) "gloc before adding corr"
790 write (iout,*) i,gloc(i,icg)
794 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
795 & +wcorr5*g_corr5_loc(i)
796 & +wcorr6*g_corr6_loc(i)
797 & +wturn4*gel_loc_turn4(i)
798 & +wturn3*gel_loc_turn3(i)
799 & +wturn6*gel_loc_turn6(i)
800 & +wel_loc*gel_loc_loc(i)
801 & +wsccor*gsccor_loc(i)
804 write (iout,*) "gloc after adding corr"
806 write (iout,*) i,gloc(i,icg)
810 if (nfgtasks.gt.1) then
813 gradbufc(j,i)=gradc(j,i,icg)
814 gradbufx(j,i)=gradx(j,i,icg)
818 glocbuf(i)=gloc(i,icg)
822 write (iout,*) "gloc_sc before reduce"
825 write (iout,*) i,j,gloc_sc(j,i,icg)
832 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
836 call MPI_Barrier(FG_COMM,IERR)
837 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
839 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
840 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
841 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
842 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
843 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
844 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
845 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
846 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
847 time_reduce=time_reduce+MPI_Wtime()-time00
850 write (iout,*) "gloc_sc after reduce"
853 write (iout,*) i,j,gloc_sc(j,i,icg)
859 write (iout,*) "gloc after reduce"
861 write (iout,*) i,gloc(i,icg)
866 if (gnorm_check) then
868 c Compute the maximum elements of the gradient
878 gcorr3_turn_max=0.0d0
879 gcorr4_turn_max=0.0d0
882 gcorr6_turn_max=0.0d0
892 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
893 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
895 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
896 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
898 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
899 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
900 & gvdwc_scp_max=gvdwc_scp_norm
901 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
902 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
903 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
904 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
905 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
906 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
907 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
908 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
909 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
910 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
911 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
912 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
913 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
915 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
916 & gcorr3_turn_max=gcorr3_turn_norm
917 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
919 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
920 & gcorr4_turn_max=gcorr4_turn_norm
921 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
922 if (gradcorr5_norm.gt.gradcorr5_max)
923 & gradcorr5_max=gradcorr5_norm
924 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
925 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
926 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
928 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
929 & gcorr6_turn_max=gcorr6_turn_norm
930 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
931 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
932 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
933 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
934 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
935 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
937 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
938 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
940 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
941 if (gradx_scp_norm.gt.gradx_scp_max)
942 & gradx_scp_max=gradx_scp_norm
943 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
944 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
945 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
946 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
947 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
948 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
949 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
950 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
954 open(istat,file=statname,position="append")
956 open(istat,file=statname,access="append")
958 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
959 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
960 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
961 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
962 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
963 & gsccorx_max,gsclocx_max
965 if (gvdwc_max.gt.1.0d4) then
966 write (iout,*) "gvdwc gvdwx gradb gradbx"
968 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
969 & gradb(j,i),gradbx(j,i),j=1,3)
971 call pdbout(0.0d0,'cipiszcze',iout)
977 write (iout,*) "gradc gradx gloc"
979 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
980 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
985 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
987 time_sumgradient=time_sumgradient+tcpu()-time01
992 c-------------------------------------------------------------------------------
993 subroutine rescale_weights(t_bath)
994 implicit real*8 (a-h,o-z)
996 include 'COMMON.IOUNITS'
997 include 'COMMON.FFIELD'
998 include 'COMMON.SBRIDGE'
999 double precision kfac /2.4d0/
1000 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
1002 c facT=2*temp0/(t_bath+temp0)
1003 if (rescale_mode.eq.0) then
1009 else if (rescale_mode.eq.1) then
1010 facT=kfac/(kfac-1.0d0+t_bath/temp0)
1011 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1012 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1013 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1014 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1015 else if (rescale_mode.eq.2) then
1021 facT=licznik/dlog(dexp(x)+dexp(-x))
1022 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
1023 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
1024 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
1025 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
1027 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1028 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1030 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1034 welec=weights(3)*fact
1035 wcorr=weights(4)*fact3
1036 wcorr5=weights(5)*fact4
1037 wcorr6=weights(6)*fact5
1038 wel_loc=weights(7)*fact2
1039 wturn3=weights(8)*fact2
1040 wturn4=weights(9)*fact3
1041 wturn6=weights(10)*fact5
1042 wtor=weights(13)*fact
1043 wtor_d=weights(14)*fact2
1044 wsccor=weights(21)*fact
1047 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1051 C------------------------------------------------------------------------
1052 subroutine enerprint(energia)
1053 implicit real*8 (a-h,o-z)
1054 include 'DIMENSIONS'
1055 include 'COMMON.IOUNITS'
1056 include 'COMMON.FFIELD'
1057 include 'COMMON.SBRIDGE'
1059 double precision energia(0:n_ene)
1062 evdw=energia(22)+wsct*energia(23)
1068 evdw2=energia(2)+energia(18)
1080 eello_turn3=energia(8)
1081 eello_turn4=energia(9)
1082 eello_turn6=energia(10)
1088 edihcnstr=energia(19)
1093 edfadis = energia(24)
1094 edfator = energia(25)
1095 edfanei = energia(26)
1096 edfabet = energia(27)
1099 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1100 & estr,wbond,ebe,wang,
1101 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1103 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1104 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1105 & edihcnstr,ebr*nss,
1106 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1107 10 format (/'Virtual-chain energies:'//
1108 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1109 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1110 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1111 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1112 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1113 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1114 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1115 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1116 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1117 & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
1118 & ' (SS bridges & dist. cnstr.)'/
1119 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1120 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1121 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1122 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1123 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1124 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1125 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1126 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1127 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1128 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1129 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1130 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1131 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1132 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1133 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1134 & 'ETOT= ',1pE16.6,' (total)')
1136 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1137 & estr,wbond,ebe,wang,
1138 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1140 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1141 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1143 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1144 10 format (/'Virtual-chain energies:'//
1145 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1146 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1147 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1148 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1149 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1150 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1151 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1152 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1153 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1154 & ' (SS bridges & dist. cnstr.)'/
1155 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1156 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1157 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1158 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1159 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1160 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1161 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1162 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1163 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1164 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1165 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1166 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1167 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1168 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1169 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1170 & 'ETOT= ',1pE16.6,' (total)')
1174 C-----------------------------------------------------------------------
1175 subroutine elj(evdw,evdw_p,evdw_m)
1177 C This subroutine calculates the interaction energy of nonbonded side chains
1178 C assuming the LJ potential of interaction.
1180 implicit real*8 (a-h,o-z)
1181 include 'DIMENSIONS'
1182 parameter (accur=1.0d-10)
1183 include 'COMMON.GEO'
1184 include 'COMMON.VAR'
1185 include 'COMMON.LOCAL'
1186 include 'COMMON.CHAIN'
1187 include 'COMMON.DERIV'
1188 include 'COMMON.INTERACT'
1189 include 'COMMON.TORSION'
1190 include 'COMMON.SBRIDGE'
1191 include 'COMMON.NAMES'
1192 include 'COMMON.IOUNITS'
1193 include 'COMMON.CONTACTS'
1195 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1197 do i=iatsc_s,iatsc_e
1206 C Calculate SC interaction energy.
1208 do iint=1,nint_gr(i)
1209 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1210 cd & 'iend=',iend(i,iint)
1211 do j=istart(i,iint),iend(i,iint)
1216 C Change 12/1/95 to calculate four-body interactions
1217 rij=xj*xj+yj*yj+zj*zj
1219 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1220 eps0ij=eps(itypi,itypj)
1222 e1=fac*fac*aa(itypi,itypj)
1223 e2=fac*bb(itypi,itypj)
1225 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1226 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1227 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1228 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1229 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1230 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1232 if (bb(itypi,itypj).gt.0) then
1233 evdw_p=evdw_p+evdwij
1235 evdw_m=evdw_m+evdwij
1241 C Calculate the components of the gradient in DC and X
1243 fac=-rrij*(e1+evdwij)
1248 if (bb(itypi,itypj).gt.0.0d0) then
1250 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1251 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1252 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1253 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1257 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1258 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1259 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1260 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1265 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1266 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1267 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1268 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1273 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1277 C 12/1/95, revised on 5/20/97
1279 C Calculate the contact function. The ith column of the array JCONT will
1280 C contain the numbers of atoms that make contacts with the atom I (of numbers
1281 C greater than I). The arrays FACONT and GACONT will contain the values of
1282 C the contact function and its derivative.
1284 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1285 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1286 C Uncomment next line, if the correlation interactions are contact function only
1287 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1289 sigij=sigma(itypi,itypj)
1290 r0ij=rs0(itypi,itypj)
1292 C Check whether the SC's are not too far to make a contact.
1295 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1296 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1298 if (fcont.gt.0.0D0) then
1299 C If the SC-SC distance if close to sigma, apply spline.
1300 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1301 cAdam & fcont1,fprimcont1)
1302 cAdam fcont1=1.0d0-fcont1
1303 cAdam if (fcont1.gt.0.0d0) then
1304 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1305 cAdam fcont=fcont*fcont1
1307 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1308 cga eps0ij=1.0d0/dsqrt(eps0ij)
1310 cga gg(k)=gg(k)*eps0ij
1312 cga eps0ij=-evdwij*eps0ij
1313 C Uncomment for AL's type of SC correlation interactions.
1314 cadam eps0ij=-evdwij
1315 num_conti=num_conti+1
1316 jcont(num_conti,i)=j
1317 facont(num_conti,i)=fcont*eps0ij
1318 fprimcont=eps0ij*fprimcont/rij
1320 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1321 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1322 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1323 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1324 gacont(1,num_conti,i)=-fprimcont*xj
1325 gacont(2,num_conti,i)=-fprimcont*yj
1326 gacont(3,num_conti,i)=-fprimcont*zj
1327 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1328 cd write (iout,'(2i3,3f10.5)')
1329 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1335 num_cont(i)=num_conti
1339 gvdwc(j,i)=expon*gvdwc(j,i)
1340 gvdwx(j,i)=expon*gvdwx(j,i)
1343 C******************************************************************************
1347 C To save time, the factor of EXPON has been extracted from ALL components
1348 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1351 C******************************************************************************
1354 C-----------------------------------------------------------------------------
1355 subroutine eljk(evdw,evdw_p,evdw_m)
1357 C This subroutine calculates the interaction energy of nonbonded side chains
1358 C assuming the LJK potential of interaction.
1360 implicit real*8 (a-h,o-z)
1361 include 'DIMENSIONS'
1362 include 'COMMON.GEO'
1363 include 'COMMON.VAR'
1364 include 'COMMON.LOCAL'
1365 include 'COMMON.CHAIN'
1366 include 'COMMON.DERIV'
1367 include 'COMMON.INTERACT'
1368 include 'COMMON.IOUNITS'
1369 include 'COMMON.NAMES'
1372 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1374 do i=iatsc_s,iatsc_e
1381 C Calculate SC interaction energy.
1383 do iint=1,nint_gr(i)
1384 do j=istart(i,iint),iend(i,iint)
1389 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1390 fac_augm=rrij**expon
1391 e_augm=augm(itypi,itypj)*fac_augm
1392 r_inv_ij=dsqrt(rrij)
1394 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1395 fac=r_shift_inv**expon
1396 e1=fac*fac*aa(itypi,itypj)
1397 e2=fac*bb(itypi,itypj)
1399 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1400 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1401 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1402 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1403 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1404 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1405 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1407 if (bb(itypi,itypj).gt.0) then
1408 evdw_p=evdw_p+evdwij
1410 evdw_m=evdw_m+evdwij
1416 C Calculate the components of the gradient in DC and X
1418 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1423 if (bb(itypi,itypj).gt.0.0d0) then
1425 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1426 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1427 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1428 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1432 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1433 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1434 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1435 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1440 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1441 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1442 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1443 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1448 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1456 gvdwc(j,i)=expon*gvdwc(j,i)
1457 gvdwx(j,i)=expon*gvdwx(j,i)
1462 C-----------------------------------------------------------------------------
1463 subroutine ebp(evdw,evdw_p,evdw_m)
1465 C This subroutine calculates the interaction energy of nonbonded side chains
1466 C assuming the Berne-Pechukas potential of interaction.
1468 implicit real*8 (a-h,o-z)
1469 include 'DIMENSIONS'
1470 include 'COMMON.GEO'
1471 include 'COMMON.VAR'
1472 include 'COMMON.LOCAL'
1473 include 'COMMON.CHAIN'
1474 include 'COMMON.DERIV'
1475 include 'COMMON.NAMES'
1476 include 'COMMON.INTERACT'
1477 include 'COMMON.IOUNITS'
1478 include 'COMMON.CALC'
1479 common /srutu/ icall
1480 c double precision rrsave(maxdim)
1483 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1485 c if (icall.eq.0) then
1491 do i=iatsc_s,iatsc_e
1497 dxi=dc_norm(1,nres+i)
1498 dyi=dc_norm(2,nres+i)
1499 dzi=dc_norm(3,nres+i)
1500 c dsci_inv=dsc_inv(itypi)
1501 dsci_inv=vbld_inv(i+nres)
1503 C Calculate SC interaction energy.
1505 do iint=1,nint_gr(i)
1506 do j=istart(i,iint),iend(i,iint)
1508 itypj=iabs(itype(j))
1509 c dscj_inv=dsc_inv(itypj)
1510 dscj_inv=vbld_inv(j+nres)
1511 chi1=chi(itypi,itypj)
1512 chi2=chi(itypj,itypi)
1519 alf12=0.5D0*(alf1+alf2)
1520 C For diagnostics only!!!
1533 dxj=dc_norm(1,nres+j)
1534 dyj=dc_norm(2,nres+j)
1535 dzj=dc_norm(3,nres+j)
1536 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1537 cd if (icall.eq.0) then
1543 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1545 C Calculate whole angle-dependent part of epsilon and contributions
1546 C to its derivatives
1547 fac=(rrij*sigsq)**expon2
1548 e1=fac*fac*aa(itypi,itypj)
1549 e2=fac*bb(itypi,itypj)
1550 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1551 eps2der=evdwij*eps3rt
1552 eps3der=evdwij*eps2rt
1553 evdwij=evdwij*eps2rt*eps3rt
1555 if (bb(itypi,itypj).gt.0) then
1556 evdw_p=evdw_p+evdwij
1558 evdw_m=evdw_m+evdwij
1564 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1565 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1566 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1567 cd & restyp(itypi),i,restyp(itypj),j,
1568 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1569 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1570 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1573 C Calculate gradient components.
1574 e1=e1*eps1*eps2rt**2*eps3rt**2
1575 fac=-expon*(e1+evdwij)
1578 C Calculate radial part of the gradient
1582 C Calculate the angular part of the gradient and sum add the contributions
1583 C to the appropriate components of the Cartesian gradient.
1585 if (bb(itypi,itypj).gt.0) then
1599 C-----------------------------------------------------------------------------
1600 subroutine egb(evdw,evdw_p,evdw_m)
1602 C This subroutine calculates the interaction energy of nonbonded side chains
1603 C assuming the Gay-Berne potential of interaction.
1605 implicit real*8 (a-h,o-z)
1606 include 'DIMENSIONS'
1607 include 'COMMON.GEO'
1608 include 'COMMON.VAR'
1609 include 'COMMON.LOCAL'
1610 include 'COMMON.CHAIN'
1611 include 'COMMON.DERIV'
1612 include 'COMMON.NAMES'
1613 include 'COMMON.INTERACT'
1614 include 'COMMON.IOUNITS'
1615 include 'COMMON.CALC'
1616 include 'COMMON.CONTROL'
1619 ccccc energy_dec=.false.
1620 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1625 c if (icall.eq.0) lprn=.false.
1627 do i=iatsc_s,iatsc_e
1633 dxi=dc_norm(1,nres+i)
1634 dyi=dc_norm(2,nres+i)
1635 dzi=dc_norm(3,nres+i)
1636 c dsci_inv=dsc_inv(itypi)
1637 dsci_inv=vbld_inv(i+nres)
1638 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1639 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1641 C Calculate SC interaction energy.
1643 do iint=1,nint_gr(i)
1644 do j=istart(i,iint),iend(i,iint)
1647 c dscj_inv=dsc_inv(itypj)
1648 dscj_inv=vbld_inv(j+nres)
1649 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1650 c & 1.0d0/vbld(j+nres)
1651 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1652 sig0ij=sigma(itypi,itypj)
1653 chi1=chi(itypi,itypj)
1654 chi2=chi(itypj,itypi)
1661 alf12=0.5D0*(alf1+alf2)
1662 C For diagnostics only!!!
1675 dxj=dc_norm(1,nres+j)
1676 dyj=dc_norm(2,nres+j)
1677 dzj=dc_norm(3,nres+j)
1678 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1679 c write (iout,*) "j",j," dc_norm",
1680 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1681 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1683 C Calculate angle-dependent terms of energy and contributions to their
1687 sig=sig0ij*dsqrt(sigsq)
1688 rij_shift=1.0D0/rij-sig+sig0ij
1689 c for diagnostics; uncomment
1690 c rij_shift=1.2*sig0ij
1691 C I hate to put IF's in the loops, but here don't have another choice!!!!
1692 if (rij_shift.le.0.0D0) then
1694 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1695 cd & restyp(itypi),i,restyp(itypj),j,
1696 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1700 c---------------------------------------------------------------
1701 rij_shift=1.0D0/rij_shift
1702 fac=rij_shift**expon
1703 e1=fac*fac*aa(itypi,itypj)
1704 e2=fac*bb(itypi,itypj)
1705 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1706 eps2der=evdwij*eps3rt
1707 eps3der=evdwij*eps2rt
1708 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1709 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1710 evdwij=evdwij*eps2rt*eps3rt
1712 if (bb(itypi,itypj).gt.0) then
1713 evdw_p=evdw_p+evdwij
1715 evdw_m=evdw_m+evdwij
1721 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1722 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1723 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1724 & restyp(itypi),i,restyp(itypj),j,
1725 & epsi,sigm,chi1,chi2,chip1,chip2,
1726 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1727 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1731 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1734 C Calculate gradient components.
1735 e1=e1*eps1*eps2rt**2*eps3rt**2
1736 fac=-expon*(e1+evdwij)*rij_shift
1740 C Calculate the radial part of the gradient
1744 C Calculate angular part of the gradient.
1746 if (bb(itypi,itypj).gt.0) then
1757 c write (iout,*) "Number of loop steps in EGB:",ind
1758 cccc energy_dec=.false.
1761 C-----------------------------------------------------------------------------
1762 subroutine egbv(evdw,evdw_p,evdw_m)
1764 C This subroutine calculates the interaction energy of nonbonded side chains
1765 C assuming the Gay-Berne-Vorobjev potential of interaction.
1767 implicit real*8 (a-h,o-z)
1768 include 'DIMENSIONS'
1769 include 'COMMON.GEO'
1770 include 'COMMON.VAR'
1771 include 'COMMON.LOCAL'
1772 include 'COMMON.CHAIN'
1773 include 'COMMON.DERIV'
1774 include 'COMMON.NAMES'
1775 include 'COMMON.INTERACT'
1776 include 'COMMON.IOUNITS'
1777 include 'COMMON.CALC'
1778 common /srutu/ icall
1781 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1784 c if (icall.eq.0) lprn=.true.
1786 do i=iatsc_s,iatsc_e
1792 dxi=dc_norm(1,nres+i)
1793 dyi=dc_norm(2,nres+i)
1794 dzi=dc_norm(3,nres+i)
1795 c dsci_inv=dsc_inv(itypi)
1796 dsci_inv=vbld_inv(i+nres)
1798 C Calculate SC interaction energy.
1800 do iint=1,nint_gr(i)
1801 do j=istart(i,iint),iend(i,iint)
1804 c dscj_inv=dsc_inv(itypj)
1805 dscj_inv=vbld_inv(j+nres)
1806 sig0ij=sigma(itypi,itypj)
1807 r0ij=r0(itypi,itypj)
1808 chi1=chi(itypi,itypj)
1809 chi2=chi(itypj,itypi)
1816 alf12=0.5D0*(alf1+alf2)
1817 C For diagnostics only!!!
1830 dxj=dc_norm(1,nres+j)
1831 dyj=dc_norm(2,nres+j)
1832 dzj=dc_norm(3,nres+j)
1833 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1835 C Calculate angle-dependent terms of energy and contributions to their
1839 sig=sig0ij*dsqrt(sigsq)
1840 rij_shift=1.0D0/rij-sig+r0ij
1841 C I hate to put IF's in the loops, but here don't have another choice!!!!
1842 if (rij_shift.le.0.0D0) then
1847 c---------------------------------------------------------------
1848 rij_shift=1.0D0/rij_shift
1849 fac=rij_shift**expon
1850 e1=fac*fac*aa(itypi,itypj)
1851 e2=fac*bb(itypi,itypj)
1852 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1853 eps2der=evdwij*eps3rt
1854 eps3der=evdwij*eps2rt
1855 fac_augm=rrij**expon
1856 e_augm=augm(itypi,itypj)*fac_augm
1857 evdwij=evdwij*eps2rt*eps3rt
1859 if (bb(itypi,itypj).gt.0) then
1860 evdw_p=evdw_p+evdwij+e_augm
1862 evdw_m=evdw_m+evdwij+e_augm
1865 evdw=evdw+evdwij+e_augm
1868 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1869 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1870 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1871 & restyp(itypi),i,restyp(itypj),j,
1872 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1873 & chi1,chi2,chip1,chip2,
1874 & eps1,eps2rt**2,eps3rt**2,
1875 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1878 C Calculate gradient components.
1879 e1=e1*eps1*eps2rt**2*eps3rt**2
1880 fac=-expon*(e1+evdwij)*rij_shift
1882 fac=rij*fac-2*expon*rrij*e_augm
1883 C Calculate the radial part of the gradient
1887 C Calculate angular part of the gradient.
1889 if (bb(itypi,itypj).gt.0) then
1901 C-----------------------------------------------------------------------------
1902 subroutine sc_angular
1903 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1904 C om12. Called by ebp, egb, and egbv.
1906 include 'COMMON.CALC'
1907 include 'COMMON.IOUNITS'
1911 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1912 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1913 om12=dxi*dxj+dyi*dyj+dzi*dzj
1915 C Calculate eps1(om12) and its derivative in om12
1916 faceps1=1.0D0-om12*chiom12
1917 faceps1_inv=1.0D0/faceps1
1918 eps1=dsqrt(faceps1_inv)
1919 C Following variable is eps1*deps1/dom12
1920 eps1_om12=faceps1_inv*chiom12
1925 c write (iout,*) "om12",om12," eps1",eps1
1926 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1931 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1932 sigsq=1.0D0-facsig*faceps1_inv
1933 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1934 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1935 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1941 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1942 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1944 C Calculate eps2 and its derivatives in om1, om2, and om12.
1947 chipom12=chip12*om12
1948 facp=1.0D0-om12*chipom12
1950 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1951 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1952 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1953 C Following variable is the square root of eps2
1954 eps2rt=1.0D0-facp1*facp_inv
1955 C Following three variables are the derivatives of the square root of eps
1956 C in om1, om2, and om12.
1957 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1958 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1959 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1960 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1961 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1962 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1963 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1964 c & " eps2rt_om12",eps2rt_om12
1965 C Calculate whole angle-dependent part of epsilon and contributions
1966 C to its derivatives
1970 C----------------------------------------------------------------------------
1971 subroutine sc_grad_T
1972 implicit real*8 (a-h,o-z)
1973 include 'DIMENSIONS'
1974 include 'COMMON.CHAIN'
1975 include 'COMMON.DERIV'
1976 include 'COMMON.CALC'
1977 include 'COMMON.IOUNITS'
1978 double precision dcosom1(3),dcosom2(3)
1979 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1980 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1981 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1982 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1986 c eom12=evdwij*eps1_om12
1988 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1989 c & " sigder",sigder
1990 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1991 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1993 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1994 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1997 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1999 c write (iout,*) "gg",(gg(k),k=1,3)
2001 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
2002 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2003 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2004 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
2005 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2006 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2007 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2008 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2009 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2010 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2013 C Calculate the components of the gradient in DC and X
2017 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2021 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
2022 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
2027 C----------------------------------------------------------------------------
2029 implicit real*8 (a-h,o-z)
2030 include 'DIMENSIONS'
2031 include 'COMMON.CHAIN'
2032 include 'COMMON.DERIV'
2033 include 'COMMON.CALC'
2034 include 'COMMON.IOUNITS'
2035 double precision dcosom1(3),dcosom2(3)
2036 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2037 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2038 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2039 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2043 c eom12=evdwij*eps1_om12
2045 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2046 c & " sigder",sigder
2047 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2048 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2050 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2051 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2054 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2056 c write (iout,*) "gg",(gg(k),k=1,3)
2058 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2059 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2060 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2061 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2062 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2063 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2064 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2065 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2066 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2067 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2070 C Calculate the components of the gradient in DC and X
2074 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2078 gvdwc(l,i)=gvdwc(l,i)-gg(l)
2079 gvdwc(l,j)=gvdwc(l,j)+gg(l)
2083 C-----------------------------------------------------------------------
2084 subroutine e_softsphere(evdw)
2086 C This subroutine calculates the interaction energy of nonbonded side chains
2087 C assuming the LJ potential of interaction.
2089 implicit real*8 (a-h,o-z)
2090 include 'DIMENSIONS'
2091 parameter (accur=1.0d-10)
2092 include 'COMMON.GEO'
2093 include 'COMMON.VAR'
2094 include 'COMMON.LOCAL'
2095 include 'COMMON.CHAIN'
2096 include 'COMMON.DERIV'
2097 include 'COMMON.INTERACT'
2098 include 'COMMON.TORSION'
2099 include 'COMMON.SBRIDGE'
2100 include 'COMMON.NAMES'
2101 include 'COMMON.IOUNITS'
2102 include 'COMMON.CONTACTS'
2104 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2106 do i=iatsc_s,iatsc_e
2113 C Calculate SC interaction energy.
2115 do iint=1,nint_gr(i)
2116 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2117 cd & 'iend=',iend(i,iint)
2118 do j=istart(i,iint),iend(i,iint)
2123 rij=xj*xj+yj*yj+zj*zj
2124 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2125 r0ij=r0(itypi,itypj)
2127 c print *,i,j,r0ij,dsqrt(rij)
2128 if (rij.lt.r0ijsq) then
2129 evdwij=0.25d0*(rij-r0ijsq)**2
2137 C Calculate the components of the gradient in DC and X
2143 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2144 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2145 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2146 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2150 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2158 C--------------------------------------------------------------------------
2159 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2162 C Soft-sphere potential of p-p interaction
2164 implicit real*8 (a-h,o-z)
2165 include 'DIMENSIONS'
2166 include 'COMMON.CONTROL'
2167 include 'COMMON.IOUNITS'
2168 include 'COMMON.GEO'
2169 include 'COMMON.VAR'
2170 include 'COMMON.LOCAL'
2171 include 'COMMON.CHAIN'
2172 include 'COMMON.DERIV'
2173 include 'COMMON.INTERACT'
2174 include 'COMMON.CONTACTS'
2175 include 'COMMON.TORSION'
2176 include 'COMMON.VECTORS'
2177 include 'COMMON.FFIELD'
2179 cd write(iout,*) 'In EELEC_soft_sphere'
2186 do i=iatel_s,iatel_e
2190 xmedi=c(1,i)+0.5d0*dxi
2191 ymedi=c(2,i)+0.5d0*dyi
2192 zmedi=c(3,i)+0.5d0*dzi
2194 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2195 do j=ielstart(i),ielend(i)
2199 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2200 r0ij=rpp(iteli,itelj)
2205 xj=c(1,j)+0.5D0*dxj-xmedi
2206 yj=c(2,j)+0.5D0*dyj-ymedi
2207 zj=c(3,j)+0.5D0*dzj-zmedi
2208 rij=xj*xj+yj*yj+zj*zj
2209 if (rij.lt.r0ijsq) then
2210 evdw1ij=0.25d0*(rij-r0ijsq)**2
2218 C Calculate contributions to the Cartesian gradient.
2224 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2225 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2228 * Loop over residues i+1 thru j-1.
2232 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2237 cgrad do i=nnt,nct-1
2239 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2241 cgrad do j=i+1,nct-1
2243 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2249 c------------------------------------------------------------------------------
2250 subroutine vec_and_deriv
2251 implicit real*8 (a-h,o-z)
2252 include 'DIMENSIONS'
2256 include 'COMMON.IOUNITS'
2257 include 'COMMON.GEO'
2258 include 'COMMON.VAR'
2259 include 'COMMON.LOCAL'
2260 include 'COMMON.CHAIN'
2261 include 'COMMON.VECTORS'
2262 include 'COMMON.SETUP'
2263 include 'COMMON.TIME1'
2264 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2265 C Compute the local reference systems. For reference system (i), the
2266 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2267 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2269 do i=ivec_start,ivec_end
2273 if (i.eq.nres-1) then
2274 C Case of the last full residue
2275 C Compute the Z-axis
2276 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2277 costh=dcos(pi-theta(nres))
2278 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2282 C Compute the derivatives of uz
2284 uzder(2,1,1)=-dc_norm(3,i-1)
2285 uzder(3,1,1)= dc_norm(2,i-1)
2286 uzder(1,2,1)= dc_norm(3,i-1)
2288 uzder(3,2,1)=-dc_norm(1,i-1)
2289 uzder(1,3,1)=-dc_norm(2,i-1)
2290 uzder(2,3,1)= dc_norm(1,i-1)
2293 uzder(2,1,2)= dc_norm(3,i)
2294 uzder(3,1,2)=-dc_norm(2,i)
2295 uzder(1,2,2)=-dc_norm(3,i)
2297 uzder(3,2,2)= dc_norm(1,i)
2298 uzder(1,3,2)= dc_norm(2,i)
2299 uzder(2,3,2)=-dc_norm(1,i)
2301 C Compute the Y-axis
2304 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2306 C Compute the derivatives of uy
2309 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2310 & -dc_norm(k,i)*dc_norm(j,i-1)
2311 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2313 uyder(j,j,1)=uyder(j,j,1)-costh
2314 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2319 uygrad(l,k,j,i)=uyder(l,k,j)
2320 uzgrad(l,k,j,i)=uzder(l,k,j)
2324 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2325 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2326 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2327 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2330 C Compute the Z-axis
2331 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2332 costh=dcos(pi-theta(i+2))
2333 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2337 C Compute the derivatives of uz
2339 uzder(2,1,1)=-dc_norm(3,i+1)
2340 uzder(3,1,1)= dc_norm(2,i+1)
2341 uzder(1,2,1)= dc_norm(3,i+1)
2343 uzder(3,2,1)=-dc_norm(1,i+1)
2344 uzder(1,3,1)=-dc_norm(2,i+1)
2345 uzder(2,3,1)= dc_norm(1,i+1)
2348 uzder(2,1,2)= dc_norm(3,i)
2349 uzder(3,1,2)=-dc_norm(2,i)
2350 uzder(1,2,2)=-dc_norm(3,i)
2352 uzder(3,2,2)= dc_norm(1,i)
2353 uzder(1,3,2)= dc_norm(2,i)
2354 uzder(2,3,2)=-dc_norm(1,i)
2356 C Compute the Y-axis
2359 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2361 C Compute the derivatives of uy
2364 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2365 & -dc_norm(k,i)*dc_norm(j,i+1)
2366 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2368 uyder(j,j,1)=uyder(j,j,1)-costh
2369 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2374 uygrad(l,k,j,i)=uyder(l,k,j)
2375 uzgrad(l,k,j,i)=uzder(l,k,j)
2379 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2380 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2381 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2382 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2386 vbld_inv_temp(1)=vbld_inv(i+1)
2387 if (i.lt.nres-1) then
2388 vbld_inv_temp(2)=vbld_inv(i+2)
2390 vbld_inv_temp(2)=vbld_inv(i)
2395 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2396 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2401 #if defined(PARVEC) && defined(MPI)
2402 if (nfgtasks1.gt.1) then
2404 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2405 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2406 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2407 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2408 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2410 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2411 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2413 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2414 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2415 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2416 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2417 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2418 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2419 time_gather=time_gather+MPI_Wtime()-time00
2421 c if (fg_rank.eq.0) then
2422 c write (iout,*) "Arrays UY and UZ"
2424 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2431 C-----------------------------------------------------------------------------
2432 subroutine check_vecgrad
2433 implicit real*8 (a-h,o-z)
2434 include 'DIMENSIONS'
2435 include 'COMMON.IOUNITS'
2436 include 'COMMON.GEO'
2437 include 'COMMON.VAR'
2438 include 'COMMON.LOCAL'
2439 include 'COMMON.CHAIN'
2440 include 'COMMON.VECTORS'
2441 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2442 dimension uyt(3,maxres),uzt(3,maxres)
2443 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2444 double precision delta /1.0d-7/
2447 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2448 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2449 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2450 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2451 cd & (dc_norm(if90,i),if90=1,3)
2452 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2453 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2454 cd write(iout,'(a)')
2460 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2461 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2474 cd write (iout,*) 'i=',i
2476 erij(k)=dc_norm(k,i)
2480 dc_norm(k,i)=erij(k)
2482 dc_norm(j,i)=dc_norm(j,i)+delta
2483 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2485 c dc_norm(k,i)=dc_norm(k,i)/fac
2487 c write (iout,*) (dc_norm(k,i),k=1,3)
2488 c write (iout,*) (erij(k),k=1,3)
2491 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2492 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2493 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2494 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2496 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2497 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2498 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2501 dc_norm(k,i)=erij(k)
2504 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2505 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2506 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2507 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2508 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2509 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2510 cd write (iout,'(a)')
2515 C--------------------------------------------------------------------------
2516 subroutine set_matrices
2517 implicit real*8 (a-h,o-z)
2518 include 'DIMENSIONS'
2521 include "COMMON.SETUP"
2523 integer status(MPI_STATUS_SIZE)
2525 include 'COMMON.IOUNITS'
2526 include 'COMMON.GEO'
2527 include 'COMMON.VAR'
2528 include 'COMMON.LOCAL'
2529 include 'COMMON.CHAIN'
2530 include 'COMMON.DERIV'
2531 include 'COMMON.INTERACT'
2532 include 'COMMON.CONTACTS'
2533 include 'COMMON.TORSION'
2534 include 'COMMON.VECTORS'
2535 include 'COMMON.FFIELD'
2536 double precision auxvec(2),auxmat(2,2)
2538 C Compute the virtual-bond-torsional-angle dependent quantities needed
2539 C to calculate the el-loc multibody terms of various order.
2542 do i=ivec_start+2,ivec_end+2
2546 if (i .lt. nres+1) then
2583 if (i .gt. 3 .and. i .lt. nres+1) then
2584 obrot_der(1,i-2)=-sin1
2585 obrot_der(2,i-2)= cos1
2586 Ugder(1,1,i-2)= sin1
2587 Ugder(1,2,i-2)=-cos1
2588 Ugder(2,1,i-2)=-cos1
2589 Ugder(2,2,i-2)=-sin1
2592 obrot2_der(1,i-2)=-dwasin2
2593 obrot2_der(2,i-2)= dwacos2
2594 Ug2der(1,1,i-2)= dwasin2
2595 Ug2der(1,2,i-2)=-dwacos2
2596 Ug2der(2,1,i-2)=-dwacos2
2597 Ug2der(2,2,i-2)=-dwasin2
2599 obrot_der(1,i-2)=0.0d0
2600 obrot_der(2,i-2)=0.0d0
2601 Ugder(1,1,i-2)=0.0d0
2602 Ugder(1,2,i-2)=0.0d0
2603 Ugder(2,1,i-2)=0.0d0
2604 Ugder(2,2,i-2)=0.0d0
2605 obrot2_der(1,i-2)=0.0d0
2606 obrot2_der(2,i-2)=0.0d0
2607 Ug2der(1,1,i-2)=0.0d0
2608 Ug2der(1,2,i-2)=0.0d0
2609 Ug2der(2,1,i-2)=0.0d0
2610 Ug2der(2,2,i-2)=0.0d0
2612 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2613 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2614 iti = itortyp(itype(i-2))
2618 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2619 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2620 iti1 = itortyp(itype(i-1))
2624 cd write (iout,*) '*******i',i,' iti1',iti
2625 cd write (iout,*) 'b1',b1(:,iti)
2626 cd write (iout,*) 'b2',b2(:,iti)
2627 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2628 c if (i .gt. iatel_s+2) then
2629 if (i .gt. nnt+2) then
2630 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2631 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2632 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2634 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2635 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2636 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2637 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2638 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2649 DtUg2(l,k,i-2)=0.0d0
2653 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2654 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2656 muder(k,i-2)=Ub2der(k,i-2)
2658 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2659 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2660 iti1 = itortyp(itype(i-1))
2665 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2667 cd write (iout,*) 'mu ',mu(:,i-2)
2668 cd write (iout,*) 'mu1',mu1(:,i-2)
2669 cd write (iout,*) 'mu2',mu2(:,i-2)
2670 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2672 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2673 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2674 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2675 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2676 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2677 C Vectors and matrices dependent on a single virtual-bond dihedral.
2678 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2679 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2680 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2681 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2682 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2683 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2684 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2685 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2686 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2689 C Matrices dependent on two consecutive virtual-bond dihedrals.
2690 C The order of matrices is from left to right.
2691 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2693 c do i=max0(ivec_start,2),ivec_end
2695 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2696 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2697 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2698 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2699 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2700 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2701 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2702 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2705 #if defined(MPI) && defined(PARMAT)
2707 c if (fg_rank.eq.0) then
2708 write (iout,*) "Arrays UG and UGDER before GATHER"
2710 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2711 & ((ug(l,k,i),l=1,2),k=1,2),
2712 & ((ugder(l,k,i),l=1,2),k=1,2)
2714 write (iout,*) "Arrays UG2 and UG2DER"
2716 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2717 & ((ug2(l,k,i),l=1,2),k=1,2),
2718 & ((ug2der(l,k,i),l=1,2),k=1,2)
2720 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2722 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2723 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2724 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2726 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2728 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2729 & costab(i),sintab(i),costab2(i),sintab2(i)
2731 write (iout,*) "Array MUDER"
2733 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2737 if (nfgtasks.gt.1) then
2739 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2740 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2741 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2743 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2744 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2746 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2747 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2749 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2750 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2752 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2753 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2755 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2756 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2758 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2759 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2761 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2762 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2763 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2764 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2765 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2766 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2767 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2768 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2769 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2770 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2771 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2772 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2773 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2775 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2776 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2778 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2779 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2781 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2782 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2784 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2785 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2787 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2788 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2790 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2791 & ivec_count(fg_rank1),
2792 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2794 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2795 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2797 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2798 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2800 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2801 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2803 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2804 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2806 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2807 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2809 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2810 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2812 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2813 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2815 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2816 & ivec_count(fg_rank1),
2817 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2819 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2820 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2822 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2823 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2825 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2826 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2828 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2829 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2831 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2832 & ivec_count(fg_rank1),
2833 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2835 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2836 & ivec_count(fg_rank1),
2837 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2839 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2840 & ivec_count(fg_rank1),
2841 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2842 & MPI_MAT2,FG_COMM1,IERR)
2843 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2844 & ivec_count(fg_rank1),
2845 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2846 & MPI_MAT2,FG_COMM1,IERR)
2849 c Passes matrix info through the ring
2852 if (irecv.lt.0) irecv=nfgtasks1-1
2855 if (inext.ge.nfgtasks1) inext=0
2857 c write (iout,*) "isend",isend," irecv",irecv
2859 lensend=lentyp(isend)
2860 lenrecv=lentyp(irecv)
2861 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2862 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2863 c & MPI_ROTAT1(lensend),inext,2200+isend,
2864 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2865 c & iprev,2200+irecv,FG_COMM,status,IERR)
2866 c write (iout,*) "Gather ROTAT1"
2868 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2869 c & MPI_ROTAT2(lensend),inext,3300+isend,
2870 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2871 c & iprev,3300+irecv,FG_COMM,status,IERR)
2872 c write (iout,*) "Gather ROTAT2"
2874 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2875 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2876 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2877 & iprev,4400+irecv,FG_COMM,status,IERR)
2878 c write (iout,*) "Gather ROTAT_OLD"
2880 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2881 & MPI_PRECOMP11(lensend),inext,5500+isend,
2882 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2883 & iprev,5500+irecv,FG_COMM,status,IERR)
2884 c write (iout,*) "Gather PRECOMP11"
2886 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2887 & MPI_PRECOMP12(lensend),inext,6600+isend,
2888 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2889 & iprev,6600+irecv,FG_COMM,status,IERR)
2890 c write (iout,*) "Gather PRECOMP12"
2892 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2894 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2895 & MPI_ROTAT2(lensend),inext,7700+isend,
2896 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2897 & iprev,7700+irecv,FG_COMM,status,IERR)
2898 c write (iout,*) "Gather PRECOMP21"
2900 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2901 & MPI_PRECOMP22(lensend),inext,8800+isend,
2902 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2903 & iprev,8800+irecv,FG_COMM,status,IERR)
2904 c write (iout,*) "Gather PRECOMP22"
2906 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2907 & MPI_PRECOMP23(lensend),inext,9900+isend,
2908 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2909 & MPI_PRECOMP23(lenrecv),
2910 & iprev,9900+irecv,FG_COMM,status,IERR)
2911 c write (iout,*) "Gather PRECOMP23"
2916 if (irecv.lt.0) irecv=nfgtasks1-1
2919 time_gather=time_gather+MPI_Wtime()-time00
2922 c if (fg_rank.eq.0) then
2923 write (iout,*) "Arrays UG and UGDER"
2925 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2926 & ((ug(l,k,i),l=1,2),k=1,2),
2927 & ((ugder(l,k,i),l=1,2),k=1,2)
2929 write (iout,*) "Arrays UG2 and UG2DER"
2931 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2932 & ((ug2(l,k,i),l=1,2),k=1,2),
2933 & ((ug2der(l,k,i),l=1,2),k=1,2)
2935 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2937 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2938 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2939 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2941 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2943 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2944 & costab(i),sintab(i),costab2(i),sintab2(i)
2946 write (iout,*) "Array MUDER"
2948 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2954 cd iti = itortyp(itype(i))
2957 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2958 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2963 C--------------------------------------------------------------------------
2964 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2966 C This subroutine calculates the average interaction energy and its gradient
2967 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2968 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2969 C The potential depends both on the distance of peptide-group centers and on
2970 C the orientation of the CA-CA virtual bonds.
2972 implicit real*8 (a-h,o-z)
2976 include 'DIMENSIONS'
2977 include 'COMMON.CONTROL'
2978 include 'COMMON.SETUP'
2979 include 'COMMON.IOUNITS'
2980 include 'COMMON.GEO'
2981 include 'COMMON.VAR'
2982 include 'COMMON.LOCAL'
2983 include 'COMMON.CHAIN'
2984 include 'COMMON.DERIV'
2985 include 'COMMON.INTERACT'
2986 include 'COMMON.CONTACTS'
2987 include 'COMMON.TORSION'
2988 include 'COMMON.VECTORS'
2989 include 'COMMON.FFIELD'
2990 include 'COMMON.TIME1'
2991 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2992 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2993 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2994 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2995 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2996 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2998 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3000 double precision scal_el /1.0d0/
3002 double precision scal_el /0.5d0/
3005 C 13-go grudnia roku pamietnego...
3006 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3007 & 0.0d0,1.0d0,0.0d0,
3008 & 0.0d0,0.0d0,1.0d0/
3009 cd write(iout,*) 'In EELEC'
3011 cd write(iout,*) 'Type',i
3012 cd write(iout,*) 'B1',B1(:,i)
3013 cd write(iout,*) 'B2',B2(:,i)
3014 cd write(iout,*) 'CC',CC(:,:,i)
3015 cd write(iout,*) 'DD',DD(:,:,i)
3016 cd write(iout,*) 'EE',EE(:,:,i)
3018 cd call check_vecgrad
3020 if (icheckgrad.eq.1) then
3022 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3024 dc_norm(k,i)=dc(k,i)*fac
3026 c write (iout,*) 'i',i,' fac',fac
3029 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3030 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3031 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3032 c call vec_and_deriv
3038 time_mat=time_mat+MPI_Wtime()-time01
3042 cd write (iout,*) 'i=',i
3044 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3047 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3048 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3061 cd print '(a)','Enter EELEC'
3062 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3064 gel_loc_loc(i)=0.0d0
3069 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3071 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3073 do i=iturn3_start,iturn3_end
3077 dx_normi=dc_norm(1,i)
3078 dy_normi=dc_norm(2,i)
3079 dz_normi=dc_norm(3,i)
3080 xmedi=c(1,i)+0.5d0*dxi
3081 ymedi=c(2,i)+0.5d0*dyi
3082 zmedi=c(3,i)+0.5d0*dzi
3084 call eelecij(i,i+2,ees,evdw1,eel_loc)
3085 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3086 num_cont_hb(i)=num_conti
3088 do i=iturn4_start,iturn4_end
3092 dx_normi=dc_norm(1,i)
3093 dy_normi=dc_norm(2,i)
3094 dz_normi=dc_norm(3,i)
3095 xmedi=c(1,i)+0.5d0*dxi
3096 ymedi=c(2,i)+0.5d0*dyi
3097 zmedi=c(3,i)+0.5d0*dzi
3098 num_conti=num_cont_hb(i)
3099 call eelecij(i,i+3,ees,evdw1,eel_loc)
3100 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3101 num_cont_hb(i)=num_conti
3104 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3106 do i=iatel_s,iatel_e
3110 dx_normi=dc_norm(1,i)
3111 dy_normi=dc_norm(2,i)
3112 dz_normi=dc_norm(3,i)
3113 xmedi=c(1,i)+0.5d0*dxi
3114 ymedi=c(2,i)+0.5d0*dyi
3115 zmedi=c(3,i)+0.5d0*dzi
3116 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3117 num_conti=num_cont_hb(i)
3118 do j=ielstart(i),ielend(i)
3119 call eelecij(i,j,ees,evdw1,eel_loc)
3121 num_cont_hb(i)=num_conti
3123 c write (iout,*) "Number of loop steps in EELEC:",ind
3125 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3126 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3128 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3129 ccc eel_loc=eel_loc+eello_turn3
3130 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3133 C-------------------------------------------------------------------------------
3134 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3135 implicit real*8 (a-h,o-z)
3136 include 'DIMENSIONS'
3140 include 'COMMON.CONTROL'
3141 include 'COMMON.IOUNITS'
3142 include 'COMMON.GEO'
3143 include 'COMMON.VAR'
3144 include 'COMMON.LOCAL'
3145 include 'COMMON.CHAIN'
3146 include 'COMMON.DERIV'
3147 include 'COMMON.INTERACT'
3148 include 'COMMON.CONTACTS'
3149 include 'COMMON.TORSION'
3150 include 'COMMON.VECTORS'
3151 include 'COMMON.FFIELD'
3152 include 'COMMON.TIME1'
3153 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3154 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3155 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3156 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3157 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3158 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3160 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3162 double precision scal_el /1.0d0/
3164 double precision scal_el /0.5d0/
3167 C 13-go grudnia roku pamietnego...
3168 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3169 & 0.0d0,1.0d0,0.0d0,
3170 & 0.0d0,0.0d0,1.0d0/
3171 c time00=MPI_Wtime()
3172 cd write (iout,*) "eelecij",i,j
3176 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3177 aaa=app(iteli,itelj)
3178 bbb=bpp(iteli,itelj)
3179 ael6i=ael6(iteli,itelj)
3180 ael3i=ael3(iteli,itelj)
3184 dx_normj=dc_norm(1,j)
3185 dy_normj=dc_norm(2,j)
3186 dz_normj=dc_norm(3,j)
3187 xj=c(1,j)+0.5D0*dxj-xmedi
3188 yj=c(2,j)+0.5D0*dyj-ymedi
3189 zj=c(3,j)+0.5D0*dzj-zmedi
3190 rij=xj*xj+yj*yj+zj*zj
3196 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3197 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3198 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3199 fac=cosa-3.0D0*cosb*cosg
3201 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3202 if (j.eq.i+2) ev1=scal_el*ev1
3207 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3210 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3211 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3214 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3215 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3216 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3217 cd & xmedi,ymedi,zmedi,xj,yj,zj
3219 if (energy_dec) then
3220 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3221 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3225 C Calculate contributions to the Cartesian gradient.
3228 facvdw=-6*rrmij*(ev1+evdwij)
3229 facel=-3*rrmij*(el1+eesij)
3235 * Radial derivatives. First process both termini of the fragment (i,j)
3241 c ghalf=0.5D0*ggg(k)
3242 c gelc(k,i)=gelc(k,i)+ghalf
3243 c gelc(k,j)=gelc(k,j)+ghalf
3245 c 9/28/08 AL Gradient compotents will be summed only at the end
3247 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3248 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3251 * Loop over residues i+1 thru j-1.
3255 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3262 c ghalf=0.5D0*ggg(k)
3263 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3264 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3266 c 9/28/08 AL Gradient compotents will be summed only at the end
3268 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3269 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3272 * Loop over residues i+1 thru j-1.
3276 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3283 fac=-3*rrmij*(facvdw+facvdw+facel)
3288 * Radial derivatives. First process both termini of the fragment (i,j)
3294 c ghalf=0.5D0*ggg(k)
3295 c gelc(k,i)=gelc(k,i)+ghalf
3296 c gelc(k,j)=gelc(k,j)+ghalf
3298 c 9/28/08 AL Gradient compotents will be summed only at the end
3300 gelc_long(k,j)=gelc(k,j)+ggg(k)
3301 gelc_long(k,i)=gelc(k,i)-ggg(k)
3304 * Loop over residues i+1 thru j-1.
3308 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3311 c 9/28/08 AL Gradient compotents will be summed only at the end
3316 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3317 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3323 ecosa=2.0D0*fac3*fac1+fac4
3326 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3327 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3329 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3330 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3332 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3333 cd & (dcosg(k),k=1,3)
3335 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3338 c ghalf=0.5D0*ggg(k)
3339 c gelc(k,i)=gelc(k,i)+ghalf
3340 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3341 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3342 c gelc(k,j)=gelc(k,j)+ghalf
3343 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3344 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3348 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3353 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3354 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3356 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3357 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3358 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3359 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3361 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3362 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3363 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3365 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3366 C energy of a peptide unit is assumed in the form of a second-order
3367 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3368 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3369 C are computed for EVERY pair of non-contiguous peptide groups.
3371 if (j.lt.nres-1) then
3382 muij(kkk)=mu(k,i)*mu(l,j)
3385 cd write (iout,*) 'EELEC: i',i,' j',j
3386 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3387 cd write(iout,*) 'muij',muij
3388 ury=scalar(uy(1,i),erij)
3389 urz=scalar(uz(1,i),erij)
3390 vry=scalar(uy(1,j),erij)
3391 vrz=scalar(uz(1,j),erij)
3392 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3393 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3394 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3395 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3396 fac=dsqrt(-ael6i)*r3ij
3401 cd write (iout,'(4i5,4f10.5)')
3402 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3403 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3404 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3405 cd & uy(:,j),uz(:,j)
3406 cd write (iout,'(4f10.5)')
3407 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3408 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3409 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3410 cd write (iout,'(9f10.5/)')
3411 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3412 C Derivatives of the elements of A in virtual-bond vectors
3413 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3415 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3416 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3417 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3418 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3419 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3420 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3421 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3422 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3423 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3424 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3425 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3426 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3428 C Compute radial contributions to the gradient
3446 C Add the contributions coming from er
3449 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3450 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3451 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3452 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3455 C Derivatives in DC(i)
3456 cgrad ghalf1=0.5d0*agg(k,1)
3457 cgrad ghalf2=0.5d0*agg(k,2)
3458 cgrad ghalf3=0.5d0*agg(k,3)
3459 cgrad ghalf4=0.5d0*agg(k,4)
3460 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3461 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3462 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3463 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3464 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3465 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3466 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3467 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3468 C Derivatives in DC(i+1)
3469 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3470 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3471 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3472 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3473 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3474 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3475 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3476 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3477 C Derivatives in DC(j)
3478 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3479 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3480 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3481 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3482 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3483 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3484 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3485 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3486 C Derivatives in DC(j+1) or DC(nres-1)
3487 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3488 & -3.0d0*vryg(k,3)*ury)
3489 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3490 & -3.0d0*vrzg(k,3)*ury)
3491 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3492 & -3.0d0*vryg(k,3)*urz)
3493 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3494 & -3.0d0*vrzg(k,3)*urz)
3495 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3497 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3510 aggi(k,l)=-aggi(k,l)
3511 aggi1(k,l)=-aggi1(k,l)
3512 aggj(k,l)=-aggj(k,l)
3513 aggj1(k,l)=-aggj1(k,l)
3516 if (j.lt.nres-1) then
3522 aggi(k,l)=-aggi(k,l)
3523 aggi1(k,l)=-aggi1(k,l)
3524 aggj(k,l)=-aggj(k,l)
3525 aggj1(k,l)=-aggj1(k,l)
3536 aggi(k,l)=-aggi(k,l)
3537 aggi1(k,l)=-aggi1(k,l)
3538 aggj(k,l)=-aggj(k,l)
3539 aggj1(k,l)=-aggj1(k,l)
3544 IF (wel_loc.gt.0.0d0) THEN
3545 C Contribution to the local-electrostatic energy coming from the i-j pair
3546 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3548 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3550 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3551 & 'eelloc',i,j,eel_loc_ij
3553 eel_loc=eel_loc+eel_loc_ij
3554 C Partial derivatives in virtual-bond dihedral angles gamma
3556 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3557 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3558 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3559 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3560 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3561 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3562 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3564 ggg(l)=agg(l,1)*muij(1)+
3565 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3566 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3567 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3568 cgrad ghalf=0.5d0*ggg(l)
3569 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3570 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3574 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3577 C Remaining derivatives of eello
3579 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3580 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3581 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3582 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3583 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3584 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3585 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3586 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3589 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3590 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3591 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3592 & .and. num_conti.le.maxconts) then
3593 c write (iout,*) i,j," entered corr"
3595 C Calculate the contact function. The ith column of the array JCONT will
3596 C contain the numbers of atoms that make contacts with the atom I (of numbers
3597 C greater than I). The arrays FACONT and GACONT will contain the values of
3598 C the contact function and its derivative.
3599 c r0ij=1.02D0*rpp(iteli,itelj)
3600 c r0ij=1.11D0*rpp(iteli,itelj)
3601 r0ij=2.20D0*rpp(iteli,itelj)
3602 c r0ij=1.55D0*rpp(iteli,itelj)
3603 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3604 if (fcont.gt.0.0D0) then
3605 num_conti=num_conti+1
3606 if (num_conti.gt.maxconts) then
3607 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3608 & ' will skip next contacts for this conf.'
3610 jcont_hb(num_conti,i)=j
3611 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3612 cd & " jcont_hb",jcont_hb(num_conti,i)
3613 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3614 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3615 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3617 d_cont(num_conti,i)=rij
3618 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3619 C --- Electrostatic-interaction matrix ---
3620 a_chuj(1,1,num_conti,i)=a22
3621 a_chuj(1,2,num_conti,i)=a23
3622 a_chuj(2,1,num_conti,i)=a32
3623 a_chuj(2,2,num_conti,i)=a33
3624 C --- Gradient of rij
3626 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3633 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3634 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3635 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3636 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3637 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3642 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3643 C Calculate contact energies
3645 wij=cosa-3.0D0*cosb*cosg
3648 c fac3=dsqrt(-ael6i)/r0ij**3
3649 fac3=dsqrt(-ael6i)*r3ij
3650 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3651 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3652 if (ees0tmp.gt.0) then
3653 ees0pij=dsqrt(ees0tmp)
3657 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3658 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3659 if (ees0tmp.gt.0) then
3660 ees0mij=dsqrt(ees0tmp)
3665 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3666 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3667 C Diagnostics. Comment out or remove after debugging!
3668 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3669 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3670 c ees0m(num_conti,i)=0.0D0
3672 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3673 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3674 C Angular derivatives of the contact function
3675 ees0pij1=fac3/ees0pij
3676 ees0mij1=fac3/ees0mij
3677 fac3p=-3.0D0*fac3*rrmij
3678 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3679 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3681 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3682 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3683 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3684 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3685 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3686 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3687 ecosap=ecosa1+ecosa2
3688 ecosbp=ecosb1+ecosb2
3689 ecosgp=ecosg1+ecosg2
3690 ecosam=ecosa1-ecosa2
3691 ecosbm=ecosb1-ecosb2
3692 ecosgm=ecosg1-ecosg2
3701 facont_hb(num_conti,i)=fcont
3702 fprimcont=fprimcont/rij
3703 cd facont_hb(num_conti,i)=1.0D0
3704 C Following line is for diagnostics.
3707 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3708 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3711 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3712 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3714 gggp(1)=gggp(1)+ees0pijp*xj
3715 gggp(2)=gggp(2)+ees0pijp*yj
3716 gggp(3)=gggp(3)+ees0pijp*zj
3717 gggm(1)=gggm(1)+ees0mijp*xj
3718 gggm(2)=gggm(2)+ees0mijp*yj
3719 gggm(3)=gggm(3)+ees0mijp*zj
3720 C Derivatives due to the contact function
3721 gacont_hbr(1,num_conti,i)=fprimcont*xj
3722 gacont_hbr(2,num_conti,i)=fprimcont*yj
3723 gacont_hbr(3,num_conti,i)=fprimcont*zj
3726 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3727 c following the change of gradient-summation algorithm.
3729 cgrad ghalfp=0.5D0*gggp(k)
3730 cgrad ghalfm=0.5D0*gggm(k)
3731 gacontp_hb1(k,num_conti,i)=!ghalfp
3732 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3733 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3734 gacontp_hb2(k,num_conti,i)=!ghalfp
3735 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3736 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3737 gacontp_hb3(k,num_conti,i)=gggp(k)
3738 gacontm_hb1(k,num_conti,i)=!ghalfm
3739 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3740 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3741 gacontm_hb2(k,num_conti,i)=!ghalfm
3742 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3743 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3744 gacontm_hb3(k,num_conti,i)=gggm(k)
3746 C Diagnostics. Comment out or remove after debugging!
3748 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3749 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3750 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3751 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3752 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3753 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3756 endif ! num_conti.le.maxconts
3759 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3762 ghalf=0.5d0*agg(l,k)
3763 aggi(l,k)=aggi(l,k)+ghalf
3764 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3765 aggj(l,k)=aggj(l,k)+ghalf
3768 if (j.eq.nres-1 .and. i.lt.j-2) then
3771 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3776 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3779 C-----------------------------------------------------------------------------
3780 subroutine eturn3(i,eello_turn3)
3781 C Third- and fourth-order contributions from turns
3782 implicit real*8 (a-h,o-z)
3783 include 'DIMENSIONS'
3784 include 'COMMON.IOUNITS'
3785 include 'COMMON.GEO'
3786 include 'COMMON.VAR'
3787 include 'COMMON.LOCAL'
3788 include 'COMMON.CHAIN'
3789 include 'COMMON.DERIV'
3790 include 'COMMON.INTERACT'
3791 include 'COMMON.CONTACTS'
3792 include 'COMMON.TORSION'
3793 include 'COMMON.VECTORS'
3794 include 'COMMON.FFIELD'
3795 include 'COMMON.CONTROL'
3797 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3798 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3799 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3800 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3801 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3802 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3803 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3806 c write (iout,*) "eturn3",i,j,j1,j2
3811 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3813 C Third-order contributions
3820 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3821 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3822 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3823 call transpose2(auxmat(1,1),auxmat1(1,1))
3824 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3825 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3826 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3827 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3828 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3829 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3830 cd & ' eello_turn3_num',4*eello_turn3_num
3831 C Derivatives in gamma(i)
3832 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3833 call transpose2(auxmat2(1,1),auxmat3(1,1))
3834 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3835 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3836 C Derivatives in gamma(i+1)
3837 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3838 call transpose2(auxmat2(1,1),auxmat3(1,1))
3839 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3840 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3841 & +0.5d0*(pizda(1,1)+pizda(2,2))
3842 C Cartesian derivatives
3844 c ghalf1=0.5d0*agg(l,1)
3845 c ghalf2=0.5d0*agg(l,2)
3846 c ghalf3=0.5d0*agg(l,3)
3847 c ghalf4=0.5d0*agg(l,4)
3848 a_temp(1,1)=aggi(l,1)!+ghalf1
3849 a_temp(1,2)=aggi(l,2)!+ghalf2
3850 a_temp(2,1)=aggi(l,3)!+ghalf3
3851 a_temp(2,2)=aggi(l,4)!+ghalf4
3852 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3853 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3854 & +0.5d0*(pizda(1,1)+pizda(2,2))
3855 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3856 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3857 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3858 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3859 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3860 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3861 & +0.5d0*(pizda(1,1)+pizda(2,2))
3862 a_temp(1,1)=aggj(l,1)!+ghalf1
3863 a_temp(1,2)=aggj(l,2)!+ghalf2
3864 a_temp(2,1)=aggj(l,3)!+ghalf3
3865 a_temp(2,2)=aggj(l,4)!+ghalf4
3866 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3867 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3868 & +0.5d0*(pizda(1,1)+pizda(2,2))
3869 a_temp(1,1)=aggj1(l,1)
3870 a_temp(1,2)=aggj1(l,2)
3871 a_temp(2,1)=aggj1(l,3)
3872 a_temp(2,2)=aggj1(l,4)
3873 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3874 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3875 & +0.5d0*(pizda(1,1)+pizda(2,2))
3879 C-------------------------------------------------------------------------------
3880 subroutine eturn4(i,eello_turn4)
3881 C Third- and fourth-order contributions from turns
3882 implicit real*8 (a-h,o-z)
3883 include 'DIMENSIONS'
3884 include 'COMMON.IOUNITS'
3885 include 'COMMON.GEO'
3886 include 'COMMON.VAR'
3887 include 'COMMON.LOCAL'
3888 include 'COMMON.CHAIN'
3889 include 'COMMON.DERIV'
3890 include 'COMMON.INTERACT'
3891 include 'COMMON.CONTACTS'
3892 include 'COMMON.TORSION'
3893 include 'COMMON.VECTORS'
3894 include 'COMMON.FFIELD'
3895 include 'COMMON.CONTROL'
3897 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3898 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3899 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3900 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3901 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3902 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3903 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3906 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3908 C Fourth-order contributions
3916 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3917 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3918 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3923 iti1=itortyp(itype(i+1))
3924 iti2=itortyp(itype(i+2))
3925 iti3=itortyp(itype(i+3))
3926 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3927 call transpose2(EUg(1,1,i+1),e1t(1,1))
3928 call transpose2(Eug(1,1,i+2),e2t(1,1))
3929 call transpose2(Eug(1,1,i+3),e3t(1,1))
3930 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3931 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3932 s1=scalar2(b1(1,iti2),auxvec(1))
3933 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3934 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3935 s2=scalar2(b1(1,iti1),auxvec(1))
3936 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3937 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3938 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3939 eello_turn4=eello_turn4-(s1+s2+s3)
3940 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3941 & 'eturn4',i,j,-(s1+s2+s3)
3942 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3943 cd & ' eello_turn4_num',8*eello_turn4_num
3944 C Derivatives in gamma(i)
3945 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3946 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3947 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3948 s1=scalar2(b1(1,iti2),auxvec(1))
3949 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3950 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3951 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3952 C Derivatives in gamma(i+1)
3953 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3954 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3955 s2=scalar2(b1(1,iti1),auxvec(1))
3956 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3957 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3958 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3959 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3960 C Derivatives in gamma(i+2)
3961 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3962 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3963 s1=scalar2(b1(1,iti2),auxvec(1))
3964 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3965 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3966 s2=scalar2(b1(1,iti1),auxvec(1))
3967 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3968 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3969 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3970 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3971 C Cartesian derivatives
3972 C Derivatives of this turn contributions in DC(i+2)
3973 if (j.lt.nres-1) then
3975 a_temp(1,1)=agg(l,1)
3976 a_temp(1,2)=agg(l,2)
3977 a_temp(2,1)=agg(l,3)
3978 a_temp(2,2)=agg(l,4)
3979 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3980 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3981 s1=scalar2(b1(1,iti2),auxvec(1))
3982 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3983 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3984 s2=scalar2(b1(1,iti1),auxvec(1))
3985 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3986 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3987 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3989 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3992 C Remaining derivatives of this turn contribution
3994 a_temp(1,1)=aggi(l,1)
3995 a_temp(1,2)=aggi(l,2)
3996 a_temp(2,1)=aggi(l,3)
3997 a_temp(2,2)=aggi(l,4)
3998 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3999 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4000 s1=scalar2(b1(1,iti2),auxvec(1))
4001 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4002 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4003 s2=scalar2(b1(1,iti1),auxvec(1))
4004 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4005 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4006 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4007 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4008 a_temp(1,1)=aggi1(l,1)
4009 a_temp(1,2)=aggi1(l,2)
4010 a_temp(2,1)=aggi1(l,3)
4011 a_temp(2,2)=aggi1(l,4)
4012 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4013 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4014 s1=scalar2(b1(1,iti2),auxvec(1))
4015 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4016 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4017 s2=scalar2(b1(1,iti1),auxvec(1))
4018 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4019 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4020 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4021 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4022 a_temp(1,1)=aggj(l,1)
4023 a_temp(1,2)=aggj(l,2)
4024 a_temp(2,1)=aggj(l,3)
4025 a_temp(2,2)=aggj(l,4)
4026 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4027 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4028 s1=scalar2(b1(1,iti2),auxvec(1))
4029 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4030 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4031 s2=scalar2(b1(1,iti1),auxvec(1))
4032 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4033 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4034 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4035 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4036 a_temp(1,1)=aggj1(l,1)
4037 a_temp(1,2)=aggj1(l,2)
4038 a_temp(2,1)=aggj1(l,3)
4039 a_temp(2,2)=aggj1(l,4)
4040 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4041 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4042 s1=scalar2(b1(1,iti2),auxvec(1))
4043 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4044 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4045 s2=scalar2(b1(1,iti1),auxvec(1))
4046 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4047 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4048 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4049 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4050 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4054 C-----------------------------------------------------------------------------
4055 subroutine vecpr(u,v,w)
4056 implicit real*8(a-h,o-z)
4057 dimension u(3),v(3),w(3)
4058 w(1)=u(2)*v(3)-u(3)*v(2)
4059 w(2)=-u(1)*v(3)+u(3)*v(1)
4060 w(3)=u(1)*v(2)-u(2)*v(1)
4063 C-----------------------------------------------------------------------------
4064 subroutine unormderiv(u,ugrad,unorm,ungrad)
4065 C This subroutine computes the derivatives of a normalized vector u, given
4066 C the derivatives computed without normalization conditions, ugrad. Returns
4069 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4070 double precision vec(3)
4071 double precision scalar
4073 c write (2,*) 'ugrad',ugrad
4076 vec(i)=scalar(ugrad(1,i),u(1))
4078 c write (2,*) 'vec',vec
4081 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4084 c write (2,*) 'ungrad',ungrad
4087 C-----------------------------------------------------------------------------
4088 subroutine escp_soft_sphere(evdw2,evdw2_14)
4090 C This subroutine calculates the excluded-volume interaction energy between
4091 C peptide-group centers and side chains and its gradient in virtual-bond and
4092 C side-chain vectors.
4094 implicit real*8 (a-h,o-z)
4095 include 'DIMENSIONS'
4096 include 'COMMON.GEO'
4097 include 'COMMON.VAR'
4098 include 'COMMON.LOCAL'
4099 include 'COMMON.CHAIN'
4100 include 'COMMON.DERIV'
4101 include 'COMMON.INTERACT'
4102 include 'COMMON.FFIELD'
4103 include 'COMMON.IOUNITS'
4104 include 'COMMON.CONTROL'
4109 cd print '(a)','Enter ESCP'
4110 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4111 do i=iatscp_s,iatscp_e
4113 xi=0.5D0*(c(1,i)+c(1,i+1))
4114 yi=0.5D0*(c(2,i)+c(2,i+1))
4115 zi=0.5D0*(c(3,i)+c(3,i+1))
4117 do iint=1,nscp_gr(i)
4119 do j=iscpstart(i,iint),iscpend(i,iint)
4121 C Uncomment following three lines for SC-p interactions
4125 C Uncomment following three lines for Ca-p interactions
4129 rij=xj*xj+yj*yj+zj*zj
4132 if (rij.lt.r0ijsq) then
4133 evdwij=0.25d0*(rij-r0ijsq)**2
4141 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4146 cgrad if (j.lt.i) then
4147 cd write (iout,*) 'j<i'
4148 C Uncomment following three lines for SC-p interactions
4150 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4153 cd write (iout,*) 'j>i'
4155 cgrad ggg(k)=-ggg(k)
4156 C Uncomment following line for SC-p interactions
4157 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4161 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4163 cgrad kstart=min0(i+1,j)
4164 cgrad kend=max0(i-1,j-1)
4165 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4166 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4167 cgrad do k=kstart,kend
4169 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4173 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4174 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4182 C-----------------------------------------------------------------------------
4183 subroutine escp(evdw2,evdw2_14)
4185 C This subroutine calculates the excluded-volume interaction energy between
4186 C peptide-group centers and side chains and its gradient in virtual-bond and
4187 C side-chain vectors.
4189 implicit real*8 (a-h,o-z)
4190 include 'DIMENSIONS'
4191 include 'COMMON.GEO'
4192 include 'COMMON.VAR'
4193 include 'COMMON.LOCAL'
4194 include 'COMMON.CHAIN'
4195 include 'COMMON.DERIV'
4196 include 'COMMON.INTERACT'
4197 include 'COMMON.FFIELD'
4198 include 'COMMON.IOUNITS'
4199 include 'COMMON.CONTROL'
4203 cd print '(a)','Enter ESCP'
4204 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4205 do i=iatscp_s,iatscp_e
4207 xi=0.5D0*(c(1,i)+c(1,i+1))
4208 yi=0.5D0*(c(2,i)+c(2,i+1))
4209 zi=0.5D0*(c(3,i)+c(3,i+1))
4211 do iint=1,nscp_gr(i)
4213 do j=iscpstart(i,iint),iscpend(i,iint)
4215 C Uncomment following three lines for SC-p interactions
4219 C Uncomment following three lines for Ca-p interactions
4223 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4225 e1=fac*fac*aad(itypj,iteli)
4226 e2=fac*bad(itypj,iteli)
4227 if (iabs(j-i) .le. 2) then
4230 evdw2_14=evdw2_14+e1+e2
4234 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4235 & 'evdw2',i,j,evdwij
4237 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4239 fac=-(evdwij+e1)*rrij
4243 cgrad if (j.lt.i) then
4244 cd write (iout,*) 'j<i'
4245 C Uncomment following three lines for SC-p interactions
4247 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4250 cd write (iout,*) 'j>i'
4252 cgrad ggg(k)=-ggg(k)
4253 C Uncomment following line for SC-p interactions
4254 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4255 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4259 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4261 cgrad kstart=min0(i+1,j)
4262 cgrad kend=max0(i-1,j-1)
4263 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4264 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4265 cgrad do k=kstart,kend
4267 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4271 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4272 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4280 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4281 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4282 gradx_scp(j,i)=expon*gradx_scp(j,i)
4285 C******************************************************************************
4289 C To save time the factor EXPON has been extracted from ALL components
4290 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4293 C******************************************************************************
4296 C--------------------------------------------------------------------------
4297 subroutine edis(ehpb)
4299 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4301 implicit real*8 (a-h,o-z)
4302 include 'DIMENSIONS'
4303 include 'COMMON.SBRIDGE'
4304 include 'COMMON.CHAIN'
4305 include 'COMMON.DERIV'
4306 include 'COMMON.VAR'
4307 include 'COMMON.INTERACT'
4308 include 'COMMON.IOUNITS'
4311 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4312 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4313 if (link_end.eq.0) return
4314 do i=link_start,link_end
4315 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4316 C CA-CA distance used in regularization of structure.
4319 C iii and jjj point to the residues for which the distance is assigned.
4320 if (ii.gt.nres) then
4327 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4328 c & dhpb(i),dhpb1(i),forcon(i)
4329 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4330 C distance and angle dependent SS bond potential.
4331 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4332 call ssbond_ene(iii,jjj,eij)
4334 cd write (iout,*) "eij",eij
4335 else if (ii.gt.nres .and. jj.gt.nres) then
4336 c Restraints from contact prediction
4338 if (dhpb1(i).gt.0.0d0) then
4339 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4340 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4341 c write (iout,*) "beta nmr",
4342 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4346 C Get the force constant corresponding to this distance.
4348 C Calculate the contribution to energy.
4349 ehpb=ehpb+waga*rdis*rdis
4350 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4352 C Evaluate gradient.
4357 ggg(j)=fac*(c(j,jj)-c(j,ii))
4360 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4361 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4364 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4365 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4368 C Calculate the distance between the two points and its difference from the
4371 if (dhpb1(i).gt.0.0d0) then
4372 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4373 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4374 c write (iout,*) "alph nmr",
4375 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4378 C Get the force constant corresponding to this distance.
4380 C Calculate the contribution to energy.
4381 ehpb=ehpb+waga*rdis*rdis
4382 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4384 C Evaluate gradient.
4388 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4389 cd & ' waga=',waga,' fac=',fac
4391 ggg(j)=fac*(c(j,jj)-c(j,ii))
4393 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4394 C If this is a SC-SC distance, we need to calculate the contributions to the
4395 C Cartesian gradient in the SC vectors (ghpbx).
4398 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4399 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4402 cgrad do j=iii,jjj-1
4404 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4408 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4409 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4416 C--------------------------------------------------------------------------
4417 subroutine ssbond_ene(i,j,eij)
4419 C Calculate the distance and angle dependent SS-bond potential energy
4420 C using a free-energy function derived based on RHF/6-31G** ab initio
4421 C calculations of diethyl disulfide.
4423 C A. Liwo and U. Kozlowska, 11/24/03
4425 implicit real*8 (a-h,o-z)
4426 include 'DIMENSIONS'
4427 include 'COMMON.SBRIDGE'
4428 include 'COMMON.CHAIN'
4429 include 'COMMON.DERIV'
4430 include 'COMMON.LOCAL'
4431 include 'COMMON.INTERACT'
4432 include 'COMMON.VAR'
4433 include 'COMMON.IOUNITS'
4434 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4439 dxi=dc_norm(1,nres+i)
4440 dyi=dc_norm(2,nres+i)
4441 dzi=dc_norm(3,nres+i)
4442 c dsci_inv=dsc_inv(itypi)
4443 dsci_inv=vbld_inv(nres+i)
4445 c dscj_inv=dsc_inv(itypj)
4446 dscj_inv=vbld_inv(nres+j)
4450 dxj=dc_norm(1,nres+j)
4451 dyj=dc_norm(2,nres+j)
4452 dzj=dc_norm(3,nres+j)
4453 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4458 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4459 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4460 om12=dxi*dxj+dyi*dyj+dzi*dzj
4462 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4463 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4469 deltat12=om2-om1+2.0d0
4471 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4472 & +akct*deltad*deltat12
4473 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4474 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4475 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4476 c & " deltat12",deltat12," eij",eij
4477 ed=2*akcm*deltad+akct*deltat12
4479 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4480 eom1=-2*akth*deltat1-pom1-om2*pom2
4481 eom2= 2*akth*deltat2+pom1-om1*pom2
4484 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4485 ghpbx(k,i)=ghpbx(k,i)-ggk
4486 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4487 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4488 ghpbx(k,j)=ghpbx(k,j)+ggk
4489 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4490 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4491 ghpbc(k,i)=ghpbc(k,i)-ggk
4492 ghpbc(k,j)=ghpbc(k,j)+ggk
4495 C Calculate the components of the gradient in DC and X
4499 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4504 C--------------------------------------------------------------------------
4505 subroutine ebond(estr)
4507 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4509 implicit real*8 (a-h,o-z)
4510 include 'DIMENSIONS'
4511 include 'COMMON.LOCAL'
4512 include 'COMMON.GEO'
4513 include 'COMMON.INTERACT'
4514 include 'COMMON.DERIV'
4515 include 'COMMON.VAR'
4516 include 'COMMON.CHAIN'
4517 include 'COMMON.IOUNITS'
4518 include 'COMMON.NAMES'
4519 include 'COMMON.FFIELD'
4520 include 'COMMON.CONTROL'
4521 include 'COMMON.SETUP'
4522 double precision u(3),ud(3)
4524 do i=ibondp_start,ibondp_end
4525 diff = vbld(i)-vbldp0
4526 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4529 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4531 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4535 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4537 do i=ibond_start,ibond_end
4542 diff=vbld(i+nres)-vbldsc0(1,iti)
4543 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4544 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4545 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4547 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4551 diff=vbld(i+nres)-vbldsc0(j,iti)
4552 ud(j)=aksc(j,iti)*diff
4553 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4567 uprod2=uprod2*u(k)*u(k)
4571 usumsqder=usumsqder+ud(j)*uprod2
4573 estr=estr+uprod/usum
4575 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4583 C--------------------------------------------------------------------------
4584 subroutine ebend(etheta)
4586 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4587 C angles gamma and its derivatives in consecutive thetas and gammas.
4589 implicit real*8 (a-h,o-z)
4590 include 'DIMENSIONS'
4591 include 'COMMON.LOCAL'
4592 include 'COMMON.GEO'
4593 include 'COMMON.INTERACT'
4594 include 'COMMON.DERIV'
4595 include 'COMMON.VAR'
4596 include 'COMMON.CHAIN'
4597 include 'COMMON.IOUNITS'
4598 include 'COMMON.NAMES'
4599 include 'COMMON.FFIELD'
4600 include 'COMMON.CONTROL'
4601 common /calcthet/ term1,term2,termm,diffak,ratak,
4602 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4603 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4604 double precision y(2),z(2)
4606 c time11=dexp(-2*time)
4609 c write (*,'(a,i2)') 'EBEND ICG=',icg
4610 do i=ithet_start,ithet_end
4611 C Zero the energy function and its derivative at 0 or pi.
4612 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4617 if (phii.ne.phii) phii=150.0
4630 if (phii1.ne.phii1) phii1=150.0
4642 C Calculate the "mean" value of theta from the part of the distribution
4643 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4644 C In following comments this theta will be referred to as t_c.
4645 thet_pred_mean=0.0d0
4649 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4651 dthett=thet_pred_mean*ssd
4652 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4653 C Derivatives of the "mean" values in gamma1 and gamma2.
4654 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4655 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4656 if (theta(i).gt.pi-delta) then
4657 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4659 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4660 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4661 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4663 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4665 else if (theta(i).lt.delta) then
4666 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4667 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4668 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4670 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4671 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4674 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4677 etheta=etheta+ethetai
4678 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4680 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4681 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4682 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4684 C Ufff.... We've done all this!!!
4687 C---------------------------------------------------------------------------
4688 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4690 implicit real*8 (a-h,o-z)
4691 include 'DIMENSIONS'
4692 include 'COMMON.LOCAL'
4693 include 'COMMON.IOUNITS'
4694 common /calcthet/ term1,term2,termm,diffak,ratak,
4695 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4696 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4697 C Calculate the contributions to both Gaussian lobes.
4698 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4699 C The "polynomial part" of the "standard deviation" of this part of
4703 sig=sig*thet_pred_mean+polthet(j,it)
4705 C Derivative of the "interior part" of the "standard deviation of the"
4706 C gamma-dependent Gaussian lobe in t_c.
4707 sigtc=3*polthet(3,it)
4709 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4712 C Set the parameters of both Gaussian lobes of the distribution.
4713 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4714 fac=sig*sig+sigc0(it)
4717 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4718 sigsqtc=-4.0D0*sigcsq*sigtc
4719 c print *,i,sig,sigtc,sigsqtc
4720 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4721 sigtc=-sigtc/(fac*fac)
4722 C Following variable is sigma(t_c)**(-2)
4723 sigcsq=sigcsq*sigcsq
4725 sig0inv=1.0D0/sig0i**2
4726 delthec=thetai-thet_pred_mean
4727 delthe0=thetai-theta0i
4728 term1=-0.5D0*sigcsq*delthec*delthec
4729 term2=-0.5D0*sig0inv*delthe0*delthe0
4730 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4731 C NaNs in taking the logarithm. We extract the largest exponent which is added
4732 C to the energy (this being the log of the distribution) at the end of energy
4733 C term evaluation for this virtual-bond angle.
4734 if (term1.gt.term2) then
4736 term2=dexp(term2-termm)
4740 term1=dexp(term1-termm)
4743 C The ratio between the gamma-independent and gamma-dependent lobes of
4744 C the distribution is a Gaussian function of thet_pred_mean too.
4745 diffak=gthet(2,it)-thet_pred_mean
4746 ratak=diffak/gthet(3,it)**2
4747 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4748 C Let's differentiate it in thet_pred_mean NOW.
4750 C Now put together the distribution terms to make complete distribution.
4751 termexp=term1+ak*term2
4752 termpre=sigc+ak*sig0i
4753 C Contribution of the bending energy from this theta is just the -log of
4754 C the sum of the contributions from the two lobes and the pre-exponential
4755 C factor. Simple enough, isn't it?
4756 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4757 C NOW the derivatives!!!
4758 C 6/6/97 Take into account the deformation.
4759 E_theta=(delthec*sigcsq*term1
4760 & +ak*delthe0*sig0inv*term2)/termexp
4761 E_tc=((sigtc+aktc*sig0i)/termpre
4762 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4763 & aktc*term2)/termexp)
4766 c-----------------------------------------------------------------------------
4767 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4768 implicit real*8 (a-h,o-z)
4769 include 'DIMENSIONS'
4770 include 'COMMON.LOCAL'
4771 include 'COMMON.IOUNITS'
4772 common /calcthet/ term1,term2,termm,diffak,ratak,
4773 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4774 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4775 delthec=thetai-thet_pred_mean
4776 delthe0=thetai-theta0i
4777 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4778 t3 = thetai-thet_pred_mean
4782 t14 = t12+t6*sigsqtc
4784 t21 = thetai-theta0i
4790 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4791 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4792 & *(-t12*t9-ak*sig0inv*t27)
4796 C--------------------------------------------------------------------------
4797 subroutine ebend(etheta)
4799 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4800 C angles gamma and its derivatives in consecutive thetas and gammas.
4801 C ab initio-derived potentials from
4802 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4804 implicit real*8 (a-h,o-z)
4805 include 'DIMENSIONS'
4806 include 'COMMON.LOCAL'
4807 include 'COMMON.GEO'
4808 include 'COMMON.INTERACT'
4809 include 'COMMON.DERIV'
4810 include 'COMMON.VAR'
4811 include 'COMMON.CHAIN'
4812 include 'COMMON.IOUNITS'
4813 include 'COMMON.NAMES'
4814 include 'COMMON.FFIELD'
4815 include 'COMMON.CONTROL'
4816 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4817 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4818 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4819 & sinph1ph2(maxdouble,maxdouble)
4820 logical lprn /.false./, lprn1 /.false./
4822 do i=ithet_start,ithet_end
4826 theti2=0.5d0*theta(i)
4827 ityp2=ithetyp(itype(i-1))
4829 coskt(k)=dcos(k*theti2)
4830 sinkt(k)=dsin(k*theti2)
4835 if (phii.ne.phii) phii=150.0
4839 ityp1=ithetyp(itype(i-2))
4841 cosph1(k)=dcos(k*phii)
4842 sinph1(k)=dsin(k*phii)
4855 if (phii1.ne.phii1) phii1=150.0
4860 ityp3=ithetyp(itype(i))
4862 cosph2(k)=dcos(k*phii1)
4863 sinph2(k)=dsin(k*phii1)
4873 ethetai=aa0thet(ityp1,ityp2,ityp3)
4876 ccl=cosph1(l)*cosph2(k-l)
4877 ssl=sinph1(l)*sinph2(k-l)
4878 scl=sinph1(l)*cosph2(k-l)
4879 csl=cosph1(l)*sinph2(k-l)
4880 cosph1ph2(l,k)=ccl-ssl
4881 cosph1ph2(k,l)=ccl+ssl
4882 sinph1ph2(l,k)=scl+csl
4883 sinph1ph2(k,l)=scl-csl
4887 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4888 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4889 write (iout,*) "coskt and sinkt"
4891 write (iout,*) k,coskt(k),sinkt(k)
4895 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4896 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4899 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4900 & " ethetai",ethetai
4903 write (iout,*) "cosph and sinph"
4905 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4907 write (iout,*) "cosph1ph2 and sinph2ph2"
4910 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4911 & sinph1ph2(l,k),sinph1ph2(k,l)
4914 write(iout,*) "ethetai",ethetai
4918 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4919 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4920 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4921 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4922 ethetai=ethetai+sinkt(m)*aux
4923 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4924 dephii=dephii+k*sinkt(m)*(
4925 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4926 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4927 dephii1=dephii1+k*sinkt(m)*(
4928 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4929 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4931 & write (iout,*) "m",m," k",k," bbthet",
4932 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4933 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4934 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4935 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4939 & write(iout,*) "ethetai",ethetai
4943 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4944 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4945 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4946 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4947 ethetai=ethetai+sinkt(m)*aux
4948 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4949 dephii=dephii+l*sinkt(m)*(
4950 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4951 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4952 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4953 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4954 dephii1=dephii1+(k-l)*sinkt(m)*(
4955 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4956 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4957 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4958 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4960 write (iout,*) "m",m," k",k," l",l," ffthet",
4961 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4962 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4963 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4964 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4965 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4966 & cosph1ph2(k,l)*sinkt(m),
4967 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4973 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4974 & i,theta(i)*rad2deg,phii*rad2deg,
4975 & phii1*rad2deg,ethetai
4976 etheta=etheta+ethetai
4977 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4978 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4979 gloc(nphi+i-2,icg)=wang*dethetai
4985 c-----------------------------------------------------------------------------
4986 subroutine esc(escloc)
4987 C Calculate the local energy of a side chain and its derivatives in the
4988 C corresponding virtual-bond valence angles THETA and the spherical angles
4990 implicit real*8 (a-h,o-z)
4991 include 'DIMENSIONS'
4992 include 'COMMON.GEO'
4993 include 'COMMON.LOCAL'
4994 include 'COMMON.VAR'
4995 include 'COMMON.INTERACT'
4996 include 'COMMON.DERIV'
4997 include 'COMMON.CHAIN'
4998 include 'COMMON.IOUNITS'
4999 include 'COMMON.NAMES'
5000 include 'COMMON.FFIELD'
5001 include 'COMMON.CONTROL'
5002 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5003 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5004 common /sccalc/ time11,time12,time112,theti,it,nlobit
5007 c write (iout,'(a)') 'ESC'
5008 do i=loc_start,loc_end
5010 if (it.eq.10) goto 1
5012 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5013 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5014 theti=theta(i+1)-pipol
5019 if (x(2).gt.pi-delta) then
5023 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5025 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5026 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5028 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5029 & ddersc0(1),dersc(1))
5030 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5031 & ddersc0(3),dersc(3))
5033 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5035 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5036 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5037 & dersc0(2),esclocbi,dersc02)
5038 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5040 call splinthet(x(2),0.5d0*delta,ss,ssd)
5045 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5047 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5048 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5050 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5052 c write (iout,*) escloci
5053 else if (x(2).lt.delta) then
5057 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5059 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5060 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5062 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5063 & ddersc0(1),dersc(1))
5064 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5065 & ddersc0(3),dersc(3))
5067 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5069 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5070 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5071 & dersc0(2),esclocbi,dersc02)
5072 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5077 call splinthet(x(2),0.5d0*delta,ss,ssd)
5079 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5081 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5082 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5084 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5085 c write (iout,*) escloci
5087 call enesc(x,escloci,dersc,ddummy,.false.)
5090 escloc=escloc+escloci
5091 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5092 & 'escloc',i,escloci
5093 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5095 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5097 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5098 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5103 C---------------------------------------------------------------------------
5104 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5105 implicit real*8 (a-h,o-z)
5106 include 'DIMENSIONS'
5107 include 'COMMON.GEO'
5108 include 'COMMON.LOCAL'
5109 include 'COMMON.IOUNITS'
5110 common /sccalc/ time11,time12,time112,theti,it,nlobit
5111 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5112 double precision contr(maxlob,-1:1)
5114 c write (iout,*) 'it=',it,' nlobit=',nlobit
5118 if (mixed) ddersc(j)=0.0d0
5122 C Because of periodicity of the dependence of the SC energy in omega we have
5123 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5124 C To avoid underflows, first compute & store the exponents.
5132 z(k)=x(k)-censc(k,j,it)
5137 Axk=Axk+gaussc(l,k,j,it)*z(l)
5143 expfac=expfac+Ax(k,j,iii)*z(k)
5151 C As in the case of ebend, we want to avoid underflows in exponentiation and
5152 C subsequent NaNs and INFs in energy calculation.
5153 C Find the largest exponent
5157 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5161 cd print *,'it=',it,' emin=',emin
5163 C Compute the contribution to SC energy and derivatives
5168 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5169 if(adexp.ne.adexp) adexp=1.0
5172 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5174 cd print *,'j=',j,' expfac=',expfac
5175 escloc_i=escloc_i+expfac
5177 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5181 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5182 & +gaussc(k,2,j,it))*expfac
5189 dersc(1)=dersc(1)/cos(theti)**2
5190 ddersc(1)=ddersc(1)/cos(theti)**2
5193 escloci=-(dlog(escloc_i)-emin)
5195 dersc(j)=dersc(j)/escloc_i
5199 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5204 C------------------------------------------------------------------------------
5205 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5206 implicit real*8 (a-h,o-z)
5207 include 'DIMENSIONS'
5208 include 'COMMON.GEO'
5209 include 'COMMON.LOCAL'
5210 include 'COMMON.IOUNITS'
5211 common /sccalc/ time11,time12,time112,theti,it,nlobit
5212 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5213 double precision contr(maxlob)
5224 z(k)=x(k)-censc(k,j,it)
5230 Axk=Axk+gaussc(l,k,j,it)*z(l)
5236 expfac=expfac+Ax(k,j)*z(k)
5241 C As in the case of ebend, we want to avoid underflows in exponentiation and
5242 C subsequent NaNs and INFs in energy calculation.
5243 C Find the largest exponent
5246 if (emin.gt.contr(j)) emin=contr(j)
5250 C Compute the contribution to SC energy and derivatives
5254 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5255 escloc_i=escloc_i+expfac
5257 dersc(k)=dersc(k)+Ax(k,j)*expfac
5259 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5260 & +gaussc(1,2,j,it))*expfac
5264 dersc(1)=dersc(1)/cos(theti)**2
5265 dersc12=dersc12/cos(theti)**2
5266 escloci=-(dlog(escloc_i)-emin)
5268 dersc(j)=dersc(j)/escloc_i
5270 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5274 c----------------------------------------------------------------------------------
5275 subroutine esc(escloc)
5276 C Calculate the local energy of a side chain and its derivatives in the
5277 C corresponding virtual-bond valence angles THETA and the spherical angles
5278 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5279 C added by Urszula Kozlowska. 07/11/2007
5281 implicit real*8 (a-h,o-z)
5282 include 'DIMENSIONS'
5283 include 'COMMON.GEO'
5284 include 'COMMON.LOCAL'
5285 include 'COMMON.VAR'
5286 include 'COMMON.SCROT'
5287 include 'COMMON.INTERACT'
5288 include 'COMMON.DERIV'
5289 include 'COMMON.CHAIN'
5290 include 'COMMON.IOUNITS'
5291 include 'COMMON.NAMES'
5292 include 'COMMON.FFIELD'
5293 include 'COMMON.CONTROL'
5294 include 'COMMON.VECTORS'
5295 double precision x_prime(3),y_prime(3),z_prime(3)
5296 & , sumene,dsc_i,dp2_i,x(65),
5297 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5298 & de_dxx,de_dyy,de_dzz,de_dt
5299 double precision s1_t,s1_6_t,s2_t,s2_6_t
5301 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5302 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5303 & dt_dCi(3),dt_dCi1(3)
5304 common /sccalc/ time11,time12,time112,theti,it,nlobit
5307 do i=loc_start,loc_end
5308 costtab(i+1) =dcos(theta(i+1))
5309 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5310 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5311 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5312 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5313 cosfac=dsqrt(cosfac2)
5314 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5315 sinfac=dsqrt(sinfac2)
5317 if (it.eq.10) goto 1
5319 C Compute the axes of tghe local cartesian coordinates system; store in
5320 c x_prime, y_prime and z_prime
5327 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5328 C & dc_norm(3,i+nres)
5330 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5331 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5334 z_prime(j) = -uz(j,i-1)
5337 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5338 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5339 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5340 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5341 c & " xy",scalar(x_prime(1),y_prime(1)),
5342 c & " xz",scalar(x_prime(1),z_prime(1)),
5343 c & " yy",scalar(y_prime(1),y_prime(1)),
5344 c & " yz",scalar(y_prime(1),z_prime(1)),
5345 c & " zz",scalar(z_prime(1),z_prime(1))
5347 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5348 C to local coordinate system. Store in xx, yy, zz.
5354 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5355 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5356 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
5363 C Compute the energy of the ith side cbain
5365 c write (2,*) "xx",xx," yy",yy," zz",zz
5368 x(j) = sc_parmin(j,it)
5371 Cc diagnostics - remove later
5373 yy1 = dsin(alph(2))*dcos(omeg(2))
5374 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5375 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5376 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5378 C," --- ", xx_w,yy_w,zz_w
5381 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5382 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5384 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5385 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5387 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5388 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5389 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5390 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5391 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5393 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5394 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5395 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5396 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5397 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5399 dsc_i = 0.743d0+x(61)
5401 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5402 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5403 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5404 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5405 s1=(1+x(63))/(0.1d0 + dscp1)
5406 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5407 s2=(1+x(65))/(0.1d0 + dscp2)
5408 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5409 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5410 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5411 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5413 c & dscp1,dscp2,sumene
5414 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5415 escloc = escloc + sumene
5416 c write (2,*) "i",i," escloc",sumene,escloc
5419 C This section to check the numerical derivatives of the energy of ith side
5420 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5421 C #define DEBUG in the code to turn it on.
5423 write (2,*) "sumene =",sumene
5427 write (2,*) xx,yy,zz
5428 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5429 de_dxx_num=(sumenep-sumene)/aincr
5431 write (2,*) "xx+ sumene from enesc=",sumenep
5434 write (2,*) xx,yy,zz
5435 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5436 de_dyy_num=(sumenep-sumene)/aincr
5438 write (2,*) "yy+ sumene from enesc=",sumenep
5441 write (2,*) xx,yy,zz
5442 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5443 de_dzz_num=(sumenep-sumene)/aincr
5445 write (2,*) "zz+ sumene from enesc=",sumenep
5446 costsave=cost2tab(i+1)
5447 sintsave=sint2tab(i+1)
5448 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5449 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5450 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5451 de_dt_num=(sumenep-sumene)/aincr
5452 write (2,*) " t+ sumene from enesc=",sumenep
5453 cost2tab(i+1)=costsave
5454 sint2tab(i+1)=sintsave
5455 C End of diagnostics section.
5458 C Compute the gradient of esc
5460 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5461 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5462 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5463 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5464 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5465 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5466 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5467 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5468 pom1=(sumene3*sint2tab(i+1)+sumene1)
5469 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5470 pom2=(sumene4*cost2tab(i+1)+sumene2)
5471 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5472 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5473 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5474 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5476 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5477 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5478 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5480 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5481 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5482 & +(pom1+pom2)*pom_dx
5484 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5487 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5488 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5489 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5491 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5492 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5493 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5494 & +x(59)*zz**2 +x(60)*xx*zz
5495 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5496 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5497 & +(pom1-pom2)*pom_dy
5499 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5502 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5503 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5504 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5505 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5506 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5507 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5508 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5509 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5511 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5514 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5515 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5516 & +pom1*pom_dt1+pom2*pom_dt2
5518 write(2,*), "de_dt = ", de_dt,de_dt_num
5522 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5523 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5524 cosfac2xx=cosfac2*xx
5525 sinfac2yy=sinfac2*yy
5527 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5529 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5531 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5532 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5533 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5534 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5535 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5536 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5537 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5538 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5539 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5540 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5544 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5545 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5548 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5549 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5550 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5552 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5553 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5557 dXX_Ctab(k,i)=dXX_Ci(k)
5558 dXX_C1tab(k,i)=dXX_Ci1(k)
5559 dYY_Ctab(k,i)=dYY_Ci(k)
5560 dYY_C1tab(k,i)=dYY_Ci1(k)
5561 dZZ_Ctab(k,i)=dZZ_Ci(k)
5562 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5563 dXX_XYZtab(k,i)=dXX_XYZ(k)
5564 dYY_XYZtab(k,i)=dYY_XYZ(k)
5565 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5569 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5570 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5571 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5572 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5573 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5575 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5576 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5577 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5578 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5579 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5580 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5581 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5582 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5584 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5585 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5587 C to check gradient call subroutine check_grad
5593 c------------------------------------------------------------------------------
5594 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5596 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5597 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5598 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5599 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5601 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5602 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5604 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5605 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5606 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5607 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5608 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5610 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5611 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5612 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5613 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5614 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5616 dsc_i = 0.743d0+x(61)
5618 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5619 & *(xx*cost2+yy*sint2))
5620 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5621 & *(xx*cost2-yy*sint2))
5622 s1=(1+x(63))/(0.1d0 + dscp1)
5623 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5624 s2=(1+x(65))/(0.1d0 + dscp2)
5625 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5626 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5627 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5632 c------------------------------------------------------------------------------
5633 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5635 C This procedure calculates two-body contact function g(rij) and its derivative:
5638 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5641 C where x=(rij-r0ij)/delta
5643 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5646 double precision rij,r0ij,eps0ij,fcont,fprimcont
5647 double precision x,x2,x4,delta
5651 if (x.lt.-1.0D0) then
5654 else if (x.le.1.0D0) then
5657 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5658 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5665 c------------------------------------------------------------------------------
5666 subroutine splinthet(theti,delta,ss,ssder)
5667 implicit real*8 (a-h,o-z)
5668 include 'DIMENSIONS'
5669 include 'COMMON.VAR'
5670 include 'COMMON.GEO'
5673 if (theti.gt.pipol) then
5674 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5676 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5681 c------------------------------------------------------------------------------
5682 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5684 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5685 double precision ksi,ksi2,ksi3,a1,a2,a3
5686 a1=fprim0*delta/(f1-f0)
5692 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5693 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5696 c------------------------------------------------------------------------------
5697 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5699 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5700 double precision ksi,ksi2,ksi3,a1,a2,a3
5705 a2=3*(f1x-f0x)-2*fprim0x*delta
5706 a3=fprim0x*delta-2*(f1x-f0x)
5707 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5710 C-----------------------------------------------------------------------------
5712 C-----------------------------------------------------------------------------
5713 subroutine etor(etors,edihcnstr)
5714 implicit real*8 (a-h,o-z)
5715 include 'DIMENSIONS'
5716 include 'COMMON.VAR'
5717 include 'COMMON.GEO'
5718 include 'COMMON.LOCAL'
5719 include 'COMMON.TORSION'
5720 include 'COMMON.INTERACT'
5721 include 'COMMON.DERIV'
5722 include 'COMMON.CHAIN'
5723 include 'COMMON.NAMES'
5724 include 'COMMON.IOUNITS'
5725 include 'COMMON.FFIELD'
5726 include 'COMMON.TORCNSTR'
5727 include 'COMMON.CONTROL'
5729 C Set lprn=.true. for debugging
5733 do i=iphi_start,iphi_end
5735 itori=itortyp(itype(i-2))
5736 itori1=itortyp(itype(i-1))
5739 C Proline-Proline pair is a special case...
5740 if (itori.eq.3 .and. itori1.eq.3) then
5741 if (phii.gt.-dwapi3) then
5743 fac=1.0D0/(1.0D0-cosphi)
5744 etorsi=v1(1,3,3)*fac
5745 etorsi=etorsi+etorsi
5746 etors=etors+etorsi-v1(1,3,3)
5747 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5748 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5751 v1ij=v1(j+1,itori,itori1)
5752 v2ij=v2(j+1,itori,itori1)
5755 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5756 if (energy_dec) etors_ii=etors_ii+
5757 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5758 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5762 v1ij=v1(j,itori,itori1)
5763 v2ij=v2(j,itori,itori1)
5766 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5767 if (energy_dec) etors_ii=etors_ii+
5768 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5769 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5772 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5775 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5776 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5777 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5778 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5779 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5781 ! 6/20/98 - dihedral angle constraints
5784 itori=idih_constr(i)
5787 if (difi.gt.drange(i)) then
5789 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5790 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5791 else if (difi.lt.-drange(i)) then
5793 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5794 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5796 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5797 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5799 ! write (iout,*) 'edihcnstr',edihcnstr
5802 c------------------------------------------------------------------------------
5803 subroutine etor_d(etors_d)
5807 c----------------------------------------------------------------------------
5809 subroutine etor(etors,edihcnstr)
5810 implicit real*8 (a-h,o-z)
5811 include 'DIMENSIONS'
5812 include 'COMMON.VAR'
5813 include 'COMMON.GEO'
5814 include 'COMMON.LOCAL'
5815 include 'COMMON.TORSION'
5816 include 'COMMON.INTERACT'
5817 include 'COMMON.DERIV'
5818 include 'COMMON.CHAIN'
5819 include 'COMMON.NAMES'
5820 include 'COMMON.IOUNITS'
5821 include 'COMMON.FFIELD'
5822 include 'COMMON.TORCNSTR'
5823 include 'COMMON.CONTROL'
5825 C Set lprn=.true. for debugging
5829 do i=iphi_start,iphi_end
5831 itori=itortyp(itype(i-2))
5832 itori1=itortyp(itype(i-1))
5835 C Regular cosine and sine terms
5836 do j=1,nterm(itori,itori1)
5837 v1ij=v1(j,itori,itori1)
5838 v2ij=v2(j,itori,itori1)
5841 etors=etors+v1ij*cosphi+v2ij*sinphi
5842 if (energy_dec) etors_ii=etors_ii+
5843 & v1ij*cosphi+v2ij*sinphi
5844 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5848 C E = SUM ----------------------------------- - v1
5849 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5851 cosphi=dcos(0.5d0*phii)
5852 sinphi=dsin(0.5d0*phii)
5853 do j=1,nlor(itori,itori1)
5854 vl1ij=vlor1(j,itori,itori1)
5855 vl2ij=vlor2(j,itori,itori1)
5856 vl3ij=vlor3(j,itori,itori1)
5857 pom=vl2ij*cosphi+vl3ij*sinphi
5858 pom1=1.0d0/(pom*pom+1.0d0)
5859 etors=etors+vl1ij*pom1
5860 if (energy_dec) etors_ii=etors_ii+
5863 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5865 C Subtract the constant term
5866 etors=etors-v0(itori,itori1)
5867 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5868 & 'etor',i,etors_ii-v0(itori,itori1)
5870 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5871 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5872 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5873 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5874 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5876 ! 6/20/98 - dihedral angle constraints
5878 c do i=1,ndih_constr
5879 do i=idihconstr_start,idihconstr_end
5880 itori=idih_constr(i)
5882 difi=pinorm(phii-phi0(i))
5883 if (difi.gt.drange(i)) then
5885 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5886 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5887 else if (difi.lt.-drange(i)) then
5889 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5890 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5894 c write (iout,*) "gloci", gloc(i-3,icg)
5895 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5896 cd & rad2deg*phi0(i), rad2deg*drange(i),
5897 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5899 cd write (iout,*) 'edihcnstr',edihcnstr
5902 c----------------------------------------------------------------------------
5903 subroutine etor_d(etors_d)
5904 C 6/23/01 Compute double torsional energy
5905 implicit real*8 (a-h,o-z)
5906 include 'DIMENSIONS'
5907 include 'COMMON.VAR'
5908 include 'COMMON.GEO'
5909 include 'COMMON.LOCAL'
5910 include 'COMMON.TORSION'
5911 include 'COMMON.INTERACT'
5912 include 'COMMON.DERIV'
5913 include 'COMMON.CHAIN'
5914 include 'COMMON.NAMES'
5915 include 'COMMON.IOUNITS'
5916 include 'COMMON.FFIELD'
5917 include 'COMMON.TORCNSTR'
5919 C Set lprn=.true. for debugging
5923 do i=iphid_start,iphid_end
5924 itori=itortyp(itype(i-2))
5925 itori1=itortyp(itype(i-1))
5926 itori2=itortyp(itype(i))
5931 do j=1,ntermd_1(itori,itori1,itori2)
5932 v1cij=v1c(1,j,itori,itori1,itori2)
5933 v1sij=v1s(1,j,itori,itori1,itori2)
5934 v2cij=v1c(2,j,itori,itori1,itori2)
5935 v2sij=v1s(2,j,itori,itori1,itori2)
5936 cosphi1=dcos(j*phii)
5937 sinphi1=dsin(j*phii)
5938 cosphi2=dcos(j*phii1)
5939 sinphi2=dsin(j*phii1)
5940 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5941 & v2cij*cosphi2+v2sij*sinphi2
5942 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5943 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5945 do k=2,ntermd_2(itori,itori1,itori2)
5947 v1cdij = v2c(k,l,itori,itori1,itori2)
5948 v2cdij = v2c(l,k,itori,itori1,itori2)
5949 v1sdij = v2s(k,l,itori,itori1,itori2)
5950 v2sdij = v2s(l,k,itori,itori1,itori2)
5951 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5952 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5953 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5954 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5955 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5956 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5957 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5958 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5959 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5960 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5963 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5964 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5965 c write (iout,*) "gloci", gloc(i-3,icg)
5970 c------------------------------------------------------------------------------
5971 subroutine eback_sc_corr(esccor)
5972 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5973 c conformational states; temporarily implemented as differences
5974 c between UNRES torsional potentials (dependent on three types of
5975 c residues) and the torsional potentials dependent on all 20 types
5976 c of residues computed from AM1 energy surfaces of terminally-blocked
5977 c amino-acid residues.
5978 implicit real*8 (a-h,o-z)
5979 include 'DIMENSIONS'
5980 include 'COMMON.VAR'
5981 include 'COMMON.GEO'
5982 include 'COMMON.LOCAL'
5983 include 'COMMON.TORSION'
5984 include 'COMMON.SCCOR'
5985 include 'COMMON.INTERACT'
5986 include 'COMMON.DERIV'
5987 include 'COMMON.CHAIN'
5988 include 'COMMON.NAMES'
5989 include 'COMMON.IOUNITS'
5990 include 'COMMON.FFIELD'
5991 include 'COMMON.CONTROL'
5993 C Set lprn=.true. for debugging
5996 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5998 do i=itau_start,itau_end
6000 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6001 isccori=isccortyp(itype(i-2))
6002 isccori1=isccortyp(itype(i-1))
6004 cccc Added 9 May 2012
6005 cc Tauangle is torsional engle depending on the value of first digit
6006 c(see comment below)
6007 cc Omicron is flat angle depending on the value of first digit
6008 c(see comment below)
6011 do intertyp=1,3 !intertyp
6012 cc Added 09 May 2012 (Adasko)
6013 cc Intertyp means interaction type of backbone mainchain correlation:
6014 c 1 = SC...Ca...Ca...Ca
6015 c 2 = Ca...Ca...Ca...SC
6016 c 3 = SC...Ca...Ca...SCi
6018 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6019 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6020 & (itype(i-1).eq.ntyp1)))
6021 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6022 & .or.(itype(i-2).eq.ntyp1)))
6023 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6024 & (itype(i-1).eq.ntyp1)))) cycle
6025 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6026 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6028 do j=1,nterm_sccor(isccori,isccori1)
6029 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6030 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6031 cosphi=dcos(j*tauangle(intertyp,i))
6032 sinphi=dsin(j*tauangle(intertyp,i))
6033 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6034 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6036 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6037 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6038 c &gloc_sc(intertyp,i-3,icg)
6040 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6041 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6042 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6043 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6044 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6048 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6052 c----------------------------------------------------------------------------
6053 subroutine multibody(ecorr)
6054 C This subroutine calculates multi-body contributions to energy following
6055 C the idea of Skolnick et al. If side chains I and J make a contact and
6056 C at the same time side chains I+1 and J+1 make a contact, an extra
6057 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6058 implicit real*8 (a-h,o-z)
6059 include 'DIMENSIONS'
6060 include 'COMMON.IOUNITS'
6061 include 'COMMON.DERIV'
6062 include 'COMMON.INTERACT'
6063 include 'COMMON.CONTACTS'
6064 double precision gx(3),gx1(3)
6067 C Set lprn=.true. for debugging
6071 write (iout,'(a)') 'Contact function values:'
6073 write (iout,'(i2,20(1x,i2,f10.5))')
6074 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6089 num_conti=num_cont(i)
6090 num_conti1=num_cont(i1)
6095 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6096 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6097 cd & ' ishift=',ishift
6098 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6099 C The system gains extra energy.
6100 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6101 endif ! j1==j+-ishift
6110 c------------------------------------------------------------------------------
6111 double precision function esccorr(i,j,k,l,jj,kk)
6112 implicit real*8 (a-h,o-z)
6113 include 'DIMENSIONS'
6114 include 'COMMON.IOUNITS'
6115 include 'COMMON.DERIV'
6116 include 'COMMON.INTERACT'
6117 include 'COMMON.CONTACTS'
6118 double precision gx(3),gx1(3)
6123 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6124 C Calculate the multi-body contribution to energy.
6125 C Calculate multi-body contributions to the gradient.
6126 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6127 cd & k,l,(gacont(m,kk,k),m=1,3)
6129 gx(m) =ekl*gacont(m,jj,i)
6130 gx1(m)=eij*gacont(m,kk,k)
6131 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6132 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6133 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6134 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6138 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6143 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6149 c------------------------------------------------------------------------------
6150 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6151 C This subroutine calculates multi-body contributions to hydrogen-bonding
6152 implicit real*8 (a-h,o-z)
6153 include 'DIMENSIONS'
6154 include 'COMMON.IOUNITS'
6157 parameter (max_cont=maxconts)
6158 parameter (max_dim=26)
6159 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6160 double precision zapas(max_dim,maxconts,max_fg_procs),
6161 & zapas_recv(max_dim,maxconts,max_fg_procs)
6162 common /przechowalnia/ zapas
6163 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6164 & status_array(MPI_STATUS_SIZE,maxconts*2)
6166 include 'COMMON.SETUP'
6167 include 'COMMON.FFIELD'
6168 include 'COMMON.DERIV'
6169 include 'COMMON.INTERACT'
6170 include 'COMMON.CONTACTS'
6171 include 'COMMON.CONTROL'
6172 include 'COMMON.LOCAL'
6173 double precision gx(3),gx1(3),time00
6176 C Set lprn=.true. for debugging
6181 if (nfgtasks.le.1) goto 30
6183 write (iout,'(a)') 'Contact function values before RECEIVE:'
6185 write (iout,'(2i3,50(1x,i2,f5.2))')
6186 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6187 & j=1,num_cont_hb(i))
6191 do i=1,ntask_cont_from
6194 do i=1,ntask_cont_to
6197 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6199 C Make the list of contacts to send to send to other procesors
6200 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6202 do i=iturn3_start,iturn3_end
6203 c write (iout,*) "make contact list turn3",i," num_cont",
6205 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6207 do i=iturn4_start,iturn4_end
6208 c write (iout,*) "make contact list turn4",i," num_cont",
6210 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6214 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6216 do j=1,num_cont_hb(i)
6219 iproc=iint_sent_local(k,jjc,ii)
6220 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6221 if (iproc.gt.0) then
6222 ncont_sent(iproc)=ncont_sent(iproc)+1
6223 nn=ncont_sent(iproc)
6225 zapas(2,nn,iproc)=jjc
6226 zapas(3,nn,iproc)=facont_hb(j,i)
6227 zapas(4,nn,iproc)=ees0p(j,i)
6228 zapas(5,nn,iproc)=ees0m(j,i)
6229 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6230 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6231 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6232 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6233 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6234 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6235 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6236 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6237 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6238 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6239 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6240 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6241 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6242 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6243 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6244 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6245 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6246 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6247 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6248 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6249 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6256 & "Numbers of contacts to be sent to other processors",
6257 & (ncont_sent(i),i=1,ntask_cont_to)
6258 write (iout,*) "Contacts sent"
6259 do ii=1,ntask_cont_to
6261 iproc=itask_cont_to(ii)
6262 write (iout,*) nn," contacts to processor",iproc,
6263 & " of CONT_TO_COMM group"
6265 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6273 CorrelID1=nfgtasks+fg_rank+1
6275 C Receive the numbers of needed contacts from other processors
6276 do ii=1,ntask_cont_from
6277 iproc=itask_cont_from(ii)
6279 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6280 & FG_COMM,req(ireq),IERR)
6282 c write (iout,*) "IRECV ended"
6284 C Send the number of contacts needed by other processors
6285 do ii=1,ntask_cont_to
6286 iproc=itask_cont_to(ii)
6288 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6289 & FG_COMM,req(ireq),IERR)
6291 c write (iout,*) "ISEND ended"
6292 c write (iout,*) "number of requests (nn)",ireq
6295 & call MPI_Waitall(ireq,req,status_array,ierr)
6297 c & "Numbers of contacts to be received from other processors",
6298 c & (ncont_recv(i),i=1,ntask_cont_from)
6302 do ii=1,ntask_cont_from
6303 iproc=itask_cont_from(ii)
6305 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6306 c & " of CONT_TO_COMM group"
6310 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6311 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6312 c write (iout,*) "ireq,req",ireq,req(ireq)
6315 C Send the contacts to processors that need them
6316 do ii=1,ntask_cont_to
6317 iproc=itask_cont_to(ii)
6319 c write (iout,*) nn," contacts to processor",iproc,
6320 c & " of CONT_TO_COMM group"
6323 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6324 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6325 c write (iout,*) "ireq,req",ireq,req(ireq)
6327 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6331 c write (iout,*) "number of requests (contacts)",ireq
6332 c write (iout,*) "req",(req(i),i=1,4)
6335 & call MPI_Waitall(ireq,req,status_array,ierr)
6336 do iii=1,ntask_cont_from
6337 iproc=itask_cont_from(iii)
6340 write (iout,*) "Received",nn," contacts from processor",iproc,
6341 & " of CONT_FROM_COMM group"
6344 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6349 ii=zapas_recv(1,i,iii)
6350 c Flag the received contacts to prevent double-counting
6351 jj=-zapas_recv(2,i,iii)
6352 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6354 nnn=num_cont_hb(ii)+1
6357 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6358 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6359 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6360 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6361 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6362 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6363 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6364 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6365 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6366 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6367 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6368 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6369 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6370 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6371 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6372 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6373 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6374 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6375 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6376 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6377 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6378 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6379 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6380 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6385 write (iout,'(a)') 'Contact function values after receive:'
6387 write (iout,'(2i3,50(1x,i3,f5.2))')
6388 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6389 & j=1,num_cont_hb(i))
6396 write (iout,'(a)') 'Contact function values:'
6398 write (iout,'(2i3,50(1x,i3,f5.2))')
6399 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6400 & j=1,num_cont_hb(i))
6404 C Remove the loop below after debugging !!!
6411 C Calculate the local-electrostatic correlation terms
6412 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6414 num_conti=num_cont_hb(i)
6415 num_conti1=num_cont_hb(i+1)
6422 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6423 c & ' jj=',jj,' kk=',kk
6424 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6425 & .or. j.lt.0 .and. j1.gt.0) .and.
6426 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6427 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6428 C The system gains extra energy.
6429 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6430 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6431 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6433 else if (j1.eq.j) then
6434 C Contacts I-J and I-(J+1) occur simultaneously.
6435 C The system loses extra energy.
6436 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6441 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6442 c & ' jj=',jj,' kk=',kk
6444 C Contacts I-J and (I+1)-J occur simultaneously.
6445 C The system loses extra energy.
6446 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6453 c------------------------------------------------------------------------------
6454 subroutine add_hb_contact(ii,jj,itask)
6455 implicit real*8 (a-h,o-z)
6456 include "DIMENSIONS"
6457 include "COMMON.IOUNITS"
6460 parameter (max_cont=maxconts)
6461 parameter (max_dim=26)
6462 include "COMMON.CONTACTS"
6463 double precision zapas(max_dim,maxconts,max_fg_procs),
6464 & zapas_recv(max_dim,maxconts,max_fg_procs)
6465 common /przechowalnia/ zapas
6466 integer i,j,ii,jj,iproc,itask(4),nn
6467 c write (iout,*) "itask",itask
6470 if (iproc.gt.0) then
6471 do j=1,num_cont_hb(ii)
6473 c write (iout,*) "i",ii," j",jj," jjc",jjc
6475 ncont_sent(iproc)=ncont_sent(iproc)+1
6476 nn=ncont_sent(iproc)
6477 zapas(1,nn,iproc)=ii
6478 zapas(2,nn,iproc)=jjc
6479 zapas(3,nn,iproc)=facont_hb(j,ii)
6480 zapas(4,nn,iproc)=ees0p(j,ii)
6481 zapas(5,nn,iproc)=ees0m(j,ii)
6482 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6483 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6484 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6485 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6486 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6487 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6488 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6489 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6490 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6491 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6492 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6493 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6494 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6495 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6496 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6497 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6498 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6499 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6500 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6501 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6502 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6510 c------------------------------------------------------------------------------
6511 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6513 C This subroutine calculates multi-body contributions to hydrogen-bonding
6514 implicit real*8 (a-h,o-z)
6515 include 'DIMENSIONS'
6516 include 'COMMON.IOUNITS'
6519 parameter (max_cont=maxconts)
6520 parameter (max_dim=70)
6521 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6522 double precision zapas(max_dim,maxconts,max_fg_procs),
6523 & zapas_recv(max_dim,maxconts,max_fg_procs)
6524 common /przechowalnia/ zapas
6525 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6526 & status_array(MPI_STATUS_SIZE,maxconts*2)
6528 include 'COMMON.SETUP'
6529 include 'COMMON.FFIELD'
6530 include 'COMMON.DERIV'
6531 include 'COMMON.LOCAL'
6532 include 'COMMON.INTERACT'
6533 include 'COMMON.CONTACTS'
6534 include 'COMMON.CHAIN'
6535 include 'COMMON.CONTROL'
6536 double precision gx(3),gx1(3)
6537 integer num_cont_hb_old(maxres)
6539 double precision eello4,eello5,eelo6,eello_turn6
6540 external eello4,eello5,eello6,eello_turn6
6541 C Set lprn=.true. for debugging
6546 num_cont_hb_old(i)=num_cont_hb(i)
6550 if (nfgtasks.le.1) goto 30
6552 write (iout,'(a)') 'Contact function values before RECEIVE:'
6554 write (iout,'(2i3,50(1x,i2,f5.2))')
6555 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6556 & j=1,num_cont_hb(i))
6560 do i=1,ntask_cont_from
6563 do i=1,ntask_cont_to
6566 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6568 C Make the list of contacts to send to send to other procesors
6569 do i=iturn3_start,iturn3_end
6570 c write (iout,*) "make contact list turn3",i," num_cont",
6572 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6574 do i=iturn4_start,iturn4_end
6575 c write (iout,*) "make contact list turn4",i," num_cont",
6577 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6581 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6583 do j=1,num_cont_hb(i)
6586 iproc=iint_sent_local(k,jjc,ii)
6587 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6588 if (iproc.ne.0) then
6589 ncont_sent(iproc)=ncont_sent(iproc)+1
6590 nn=ncont_sent(iproc)
6592 zapas(2,nn,iproc)=jjc
6593 zapas(3,nn,iproc)=d_cont(j,i)
6597 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6602 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6610 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6621 & "Numbers of contacts to be sent to other processors",
6622 & (ncont_sent(i),i=1,ntask_cont_to)
6623 write (iout,*) "Contacts sent"
6624 do ii=1,ntask_cont_to
6626 iproc=itask_cont_to(ii)
6627 write (iout,*) nn," contacts to processor",iproc,
6628 & " of CONT_TO_COMM group"
6630 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6638 CorrelID1=nfgtasks+fg_rank+1
6640 C Receive the numbers of needed contacts from other processors
6641 do ii=1,ntask_cont_from
6642 iproc=itask_cont_from(ii)
6644 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6645 & FG_COMM,req(ireq),IERR)
6647 c write (iout,*) "IRECV ended"
6649 C Send the number of contacts needed by other processors
6650 do ii=1,ntask_cont_to
6651 iproc=itask_cont_to(ii)
6653 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6654 & FG_COMM,req(ireq),IERR)
6656 c write (iout,*) "ISEND ended"
6657 c write (iout,*) "number of requests (nn)",ireq
6660 & call MPI_Waitall(ireq,req,status_array,ierr)
6662 c & "Numbers of contacts to be received from other processors",
6663 c & (ncont_recv(i),i=1,ntask_cont_from)
6667 do ii=1,ntask_cont_from
6668 iproc=itask_cont_from(ii)
6670 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6671 c & " of CONT_TO_COMM group"
6675 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6676 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6677 c write (iout,*) "ireq,req",ireq,req(ireq)
6680 C Send the contacts to processors that need them
6681 do ii=1,ntask_cont_to
6682 iproc=itask_cont_to(ii)
6684 c write (iout,*) nn," contacts to processor",iproc,
6685 c & " of CONT_TO_COMM group"
6688 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6689 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6690 c write (iout,*) "ireq,req",ireq,req(ireq)
6692 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6696 c write (iout,*) "number of requests (contacts)",ireq
6697 c write (iout,*) "req",(req(i),i=1,4)
6700 & call MPI_Waitall(ireq,req,status_array,ierr)
6701 do iii=1,ntask_cont_from
6702 iproc=itask_cont_from(iii)
6705 write (iout,*) "Received",nn," contacts from processor",iproc,
6706 & " of CONT_FROM_COMM group"
6709 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6714 ii=zapas_recv(1,i,iii)
6715 c Flag the received contacts to prevent double-counting
6716 jj=-zapas_recv(2,i,iii)
6717 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6719 nnn=num_cont_hb(ii)+1
6722 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6726 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6731 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6739 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6748 write (iout,'(a)') 'Contact function values after receive:'
6750 write (iout,'(2i3,50(1x,i3,5f6.3))')
6751 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6752 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6759 write (iout,'(a)') 'Contact function values:'
6761 write (iout,'(2i3,50(1x,i2,5f6.3))')
6762 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6763 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6769 C Remove the loop below after debugging !!!
6776 C Calculate the dipole-dipole interaction energies
6777 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6778 do i=iatel_s,iatel_e+1
6779 num_conti=num_cont_hb(i)
6788 C Calculate the local-electrostatic correlation terms
6789 c write (iout,*) "gradcorr5 in eello5 before loop"
6791 c write (iout,'(i5,3f10.5)')
6792 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6794 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6795 c write (iout,*) "corr loop i",i
6797 num_conti=num_cont_hb(i)
6798 num_conti1=num_cont_hb(i+1)
6805 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6806 c & ' jj=',jj,' kk=',kk
6807 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6808 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6809 & .or. j.lt.0 .and. j1.gt.0) .and.
6810 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6811 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6812 C The system gains extra energy.
6814 sqd1=dsqrt(d_cont(jj,i))
6815 sqd2=dsqrt(d_cont(kk,i1))
6816 sred_geom = sqd1*sqd2
6817 IF (sred_geom.lt.cutoff_corr) THEN
6818 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6820 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6821 cd & ' jj=',jj,' kk=',kk
6822 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6823 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6825 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6826 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6829 cd write (iout,*) 'sred_geom=',sred_geom,
6830 cd & ' ekont=',ekont,' fprim=',fprimcont,
6831 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6832 cd write (iout,*) "g_contij",g_contij
6833 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6834 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6835 call calc_eello(i,jp,i+1,jp1,jj,kk)
6836 if (wcorr4.gt.0.0d0)
6837 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6838 if (energy_dec.and.wcorr4.gt.0.0d0)
6839 1 write (iout,'(a6,4i5,0pf7.3)')
6840 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6841 c write (iout,*) "gradcorr5 before eello5"
6843 c write (iout,'(i5,3f10.5)')
6844 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6846 if (wcorr5.gt.0.0d0)
6847 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6848 c write (iout,*) "gradcorr5 after eello5"
6850 c write (iout,'(i5,3f10.5)')
6851 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6853 if (energy_dec.and.wcorr5.gt.0.0d0)
6854 1 write (iout,'(a6,4i5,0pf7.3)')
6855 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6856 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6857 cd write(2,*)'ijkl',i,jp,i+1,jp1
6858 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6859 & .or. wturn6.eq.0.0d0))then
6860 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6861 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6862 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6863 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6864 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6865 cd & 'ecorr6=',ecorr6
6866 cd write (iout,'(4e15.5)') sred_geom,
6867 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6868 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6869 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6870 else if (wturn6.gt.0.0d0
6871 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6872 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6873 eturn6=eturn6+eello_turn6(i,jj,kk)
6874 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6875 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6876 cd write (2,*) 'multibody_eello:eturn6',eturn6
6885 num_cont_hb(i)=num_cont_hb_old(i)
6887 c write (iout,*) "gradcorr5 in eello5"
6889 c write (iout,'(i5,3f10.5)')
6890 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6894 c------------------------------------------------------------------------------
6895 subroutine add_hb_contact_eello(ii,jj,itask)
6896 implicit real*8 (a-h,o-z)
6897 include "DIMENSIONS"
6898 include "COMMON.IOUNITS"
6901 parameter (max_cont=maxconts)
6902 parameter (max_dim=70)
6903 include "COMMON.CONTACTS"
6904 double precision zapas(max_dim,maxconts,max_fg_procs),
6905 & zapas_recv(max_dim,maxconts,max_fg_procs)
6906 common /przechowalnia/ zapas
6907 integer i,j,ii,jj,iproc,itask(4),nn
6908 c write (iout,*) "itask",itask
6911 if (iproc.gt.0) then
6912 do j=1,num_cont_hb(ii)
6914 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6916 ncont_sent(iproc)=ncont_sent(iproc)+1
6917 nn=ncont_sent(iproc)
6918 zapas(1,nn,iproc)=ii
6919 zapas(2,nn,iproc)=jjc
6920 zapas(3,nn,iproc)=d_cont(j,ii)
6924 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6929 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6937 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6949 c------------------------------------------------------------------------------
6950 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6951 implicit real*8 (a-h,o-z)
6952 include 'DIMENSIONS'
6953 include 'COMMON.IOUNITS'
6954 include 'COMMON.DERIV'
6955 include 'COMMON.INTERACT'
6956 include 'COMMON.CONTACTS'
6957 double precision gx(3),gx1(3)
6967 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6968 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6969 C Following 4 lines for diagnostics.
6974 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6975 c & 'Contacts ',i,j,
6976 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6977 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6979 C Calculate the multi-body contribution to energy.
6980 c ecorr=ecorr+ekont*ees
6981 C Calculate multi-body contributions to the gradient.
6982 coeffpees0pij=coeffp*ees0pij
6983 coeffmees0mij=coeffm*ees0mij
6984 coeffpees0pkl=coeffp*ees0pkl
6985 coeffmees0mkl=coeffm*ees0mkl
6987 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6988 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6989 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6990 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6991 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6992 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6993 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6994 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6995 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6996 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6997 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6998 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6999 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7000 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7001 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7002 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7003 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7004 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7005 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7006 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7007 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7008 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7009 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7010 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7011 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7016 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7017 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7018 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7019 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7024 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7025 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7026 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7027 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7030 c write (iout,*) "ehbcorr",ekont*ees
7035 C---------------------------------------------------------------------------
7036 subroutine dipole(i,j,jj)
7037 implicit real*8 (a-h,o-z)
7038 include 'DIMENSIONS'
7039 include 'COMMON.IOUNITS'
7040 include 'COMMON.CHAIN'
7041 include 'COMMON.FFIELD'
7042 include 'COMMON.DERIV'
7043 include 'COMMON.INTERACT'
7044 include 'COMMON.CONTACTS'
7045 include 'COMMON.TORSION'
7046 include 'COMMON.VAR'
7047 include 'COMMON.GEO'
7048 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7050 iti1 = itortyp(itype(i+1))
7051 if (j.lt.nres-1) then
7052 itj1 = itortyp(itype(j+1))
7057 dipi(iii,1)=Ub2(iii,i)
7058 dipderi(iii)=Ub2der(iii,i)
7059 dipi(iii,2)=b1(iii,iti1)
7060 dipj(iii,1)=Ub2(iii,j)
7061 dipderj(iii)=Ub2der(iii,j)
7062 dipj(iii,2)=b1(iii,itj1)
7066 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7069 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7076 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7080 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7085 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7086 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7088 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7090 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7092 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7097 C---------------------------------------------------------------------------
7098 subroutine calc_eello(i,j,k,l,jj,kk)
7100 C This subroutine computes matrices and vectors needed to calculate
7101 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7103 implicit real*8 (a-h,o-z)
7104 include 'DIMENSIONS'
7105 include 'COMMON.IOUNITS'
7106 include 'COMMON.CHAIN'
7107 include 'COMMON.DERIV'
7108 include 'COMMON.INTERACT'
7109 include 'COMMON.CONTACTS'
7110 include 'COMMON.TORSION'
7111 include 'COMMON.VAR'
7112 include 'COMMON.GEO'
7113 include 'COMMON.FFIELD'
7114 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7115 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7118 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7119 cd & ' jj=',jj,' kk=',kk
7120 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7121 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7122 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7125 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7126 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7129 call transpose2(aa1(1,1),aa1t(1,1))
7130 call transpose2(aa2(1,1),aa2t(1,1))
7133 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7134 & aa1tder(1,1,lll,kkk))
7135 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7136 & aa2tder(1,1,lll,kkk))
7140 C parallel orientation of the two CA-CA-CA frames.
7142 iti=itortyp(itype(i))
7146 itk1=itortyp(itype(k+1))
7147 itj=itortyp(itype(j))
7148 if (l.lt.nres-1) then
7149 itl1=itortyp(itype(l+1))
7153 C A1 kernel(j+1) A2T
7155 cd write (iout,'(3f10.5,5x,3f10.5)')
7156 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7158 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7159 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7160 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7161 C Following matrices are needed only for 6-th order cumulants
7162 IF (wcorr6.gt.0.0d0) THEN
7163 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7164 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7165 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7166 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7167 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7168 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7169 & ADtEAderx(1,1,1,1,1,1))
7171 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7172 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7173 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7174 & ADtEA1derx(1,1,1,1,1,1))
7176 C End 6-th order cumulants
7179 cd write (2,*) 'In calc_eello6'
7181 cd write (2,*) 'iii=',iii
7183 cd write (2,*) 'kkk=',kkk
7185 cd write (2,'(3(2f10.5),5x)')
7186 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7191 call transpose2(EUgder(1,1,k),auxmat(1,1))
7192 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7193 call transpose2(EUg(1,1,k),auxmat(1,1))
7194 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7195 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7199 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7200 & EAEAderx(1,1,lll,kkk,iii,1))
7204 C A1T kernel(i+1) A2
7205 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7206 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7207 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7208 C Following matrices are needed only for 6-th order cumulants
7209 IF (wcorr6.gt.0.0d0) THEN
7210 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7211 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7212 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7213 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7214 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7215 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7216 & ADtEAderx(1,1,1,1,1,2))
7217 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7218 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7219 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7220 & ADtEA1derx(1,1,1,1,1,2))
7222 C End 6-th order cumulants
7223 call transpose2(EUgder(1,1,l),auxmat(1,1))
7224 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7225 call transpose2(EUg(1,1,l),auxmat(1,1))
7226 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7227 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7231 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7232 & EAEAderx(1,1,lll,kkk,iii,2))
7237 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7238 C They are needed only when the fifth- or the sixth-order cumulants are
7240 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7241 call transpose2(AEA(1,1,1),auxmat(1,1))
7242 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7243 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7244 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7245 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7246 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7247 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7248 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7249 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7250 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7251 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7252 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7253 call transpose2(AEA(1,1,2),auxmat(1,1))
7254 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7255 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7256 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7257 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7258 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7259 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7260 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7261 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7262 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7263 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7264 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7265 C Calculate the Cartesian derivatives of the vectors.
7269 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7270 call matvec2(auxmat(1,1),b1(1,iti),
7271 & AEAb1derx(1,lll,kkk,iii,1,1))
7272 call matvec2(auxmat(1,1),Ub2(1,i),
7273 & AEAb2derx(1,lll,kkk,iii,1,1))
7274 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7275 & AEAb1derx(1,lll,kkk,iii,2,1))
7276 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7277 & AEAb2derx(1,lll,kkk,iii,2,1))
7278 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7279 call matvec2(auxmat(1,1),b1(1,itj),
7280 & AEAb1derx(1,lll,kkk,iii,1,2))
7281 call matvec2(auxmat(1,1),Ub2(1,j),
7282 & AEAb2derx(1,lll,kkk,iii,1,2))
7283 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7284 & AEAb1derx(1,lll,kkk,iii,2,2))
7285 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7286 & AEAb2derx(1,lll,kkk,iii,2,2))
7293 C Antiparallel orientation of the two CA-CA-CA frames.
7295 iti=itortyp(itype(i))
7299 itk1=itortyp(itype(k+1))
7300 itl=itortyp(itype(l))
7301 itj=itortyp(itype(j))
7302 if (j.lt.nres-1) then
7303 itj1=itortyp(itype(j+1))
7307 C A2 kernel(j-1)T A1T
7308 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7309 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7310 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7311 C Following matrices are needed only for 6-th order cumulants
7312 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7313 & j.eq.i+4 .and. l.eq.i+3)) THEN
7314 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7315 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7316 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7317 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7318 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7319 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7320 & ADtEAderx(1,1,1,1,1,1))
7321 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7322 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7323 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7324 & ADtEA1derx(1,1,1,1,1,1))
7326 C End 6-th order cumulants
7327 call transpose2(EUgder(1,1,k),auxmat(1,1))
7328 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7329 call transpose2(EUg(1,1,k),auxmat(1,1))
7330 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7331 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7335 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7336 & EAEAderx(1,1,lll,kkk,iii,1))
7340 C A2T kernel(i+1)T A1
7341 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7342 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7343 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7344 C Following matrices are needed only for 6-th order cumulants
7345 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7346 & j.eq.i+4 .and. l.eq.i+3)) THEN
7347 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7348 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7349 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7350 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7351 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7352 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7353 & ADtEAderx(1,1,1,1,1,2))
7354 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7355 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7356 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7357 & ADtEA1derx(1,1,1,1,1,2))
7359 C End 6-th order cumulants
7360 call transpose2(EUgder(1,1,j),auxmat(1,1))
7361 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7362 call transpose2(EUg(1,1,j),auxmat(1,1))
7363 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7364 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7368 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7369 & EAEAderx(1,1,lll,kkk,iii,2))
7374 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7375 C They are needed only when the fifth- or the sixth-order cumulants are
7377 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7378 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7379 call transpose2(AEA(1,1,1),auxmat(1,1))
7380 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7381 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7382 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7383 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7384 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7385 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7386 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7387 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7388 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7389 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7390 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7391 call transpose2(AEA(1,1,2),auxmat(1,1))
7392 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7393 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7394 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7395 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7396 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7397 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7398 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7399 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7400 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7401 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7402 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7403 C Calculate the Cartesian derivatives of the vectors.
7407 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7408 call matvec2(auxmat(1,1),b1(1,iti),
7409 & AEAb1derx(1,lll,kkk,iii,1,1))
7410 call matvec2(auxmat(1,1),Ub2(1,i),
7411 & AEAb2derx(1,lll,kkk,iii,1,1))
7412 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7413 & AEAb1derx(1,lll,kkk,iii,2,1))
7414 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7415 & AEAb2derx(1,lll,kkk,iii,2,1))
7416 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7417 call matvec2(auxmat(1,1),b1(1,itl),
7418 & AEAb1derx(1,lll,kkk,iii,1,2))
7419 call matvec2(auxmat(1,1),Ub2(1,l),
7420 & AEAb2derx(1,lll,kkk,iii,1,2))
7421 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7422 & AEAb1derx(1,lll,kkk,iii,2,2))
7423 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7424 & AEAb2derx(1,lll,kkk,iii,2,2))
7433 C---------------------------------------------------------------------------
7434 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7435 & KK,KKderg,AKA,AKAderg,AKAderx)
7439 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7440 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7441 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7446 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7448 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7451 cd if (lprn) write (2,*) 'In kernel'
7453 cd if (lprn) write (2,*) 'kkk=',kkk
7455 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7456 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7458 cd write (2,*) 'lll=',lll
7459 cd write (2,*) 'iii=1'
7461 cd write (2,'(3(2f10.5),5x)')
7462 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7465 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7466 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7468 cd write (2,*) 'lll=',lll
7469 cd write (2,*) 'iii=2'
7471 cd write (2,'(3(2f10.5),5x)')
7472 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7479 C---------------------------------------------------------------------------
7480 double precision function eello4(i,j,k,l,jj,kk)
7481 implicit real*8 (a-h,o-z)
7482 include 'DIMENSIONS'
7483 include 'COMMON.IOUNITS'
7484 include 'COMMON.CHAIN'
7485 include 'COMMON.DERIV'
7486 include 'COMMON.INTERACT'
7487 include 'COMMON.CONTACTS'
7488 include 'COMMON.TORSION'
7489 include 'COMMON.VAR'
7490 include 'COMMON.GEO'
7491 double precision pizda(2,2),ggg1(3),ggg2(3)
7492 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7496 cd print *,'eello4:',i,j,k,l,jj,kk
7497 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7498 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7499 cold eij=facont_hb(jj,i)
7500 cold ekl=facont_hb(kk,k)
7502 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7503 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7504 gcorr_loc(k-1)=gcorr_loc(k-1)
7505 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7507 gcorr_loc(l-1)=gcorr_loc(l-1)
7508 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7510 gcorr_loc(j-1)=gcorr_loc(j-1)
7511 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7516 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7517 & -EAEAderx(2,2,lll,kkk,iii,1)
7518 cd derx(lll,kkk,iii)=0.0d0
7522 cd gcorr_loc(l-1)=0.0d0
7523 cd gcorr_loc(j-1)=0.0d0
7524 cd gcorr_loc(k-1)=0.0d0
7526 cd write (iout,*)'Contacts have occurred for peptide groups',
7527 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7528 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7529 if (j.lt.nres-1) then
7536 if (l.lt.nres-1) then
7544 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7545 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7546 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7547 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7548 cgrad ghalf=0.5d0*ggg1(ll)
7549 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7550 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7551 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7552 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7553 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7554 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7555 cgrad ghalf=0.5d0*ggg2(ll)
7556 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7557 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7558 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7559 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7560 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7561 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7565 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7570 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7575 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7580 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7584 cd write (2,*) iii,gcorr_loc(iii)
7587 cd write (2,*) 'ekont',ekont
7588 cd write (iout,*) 'eello4',ekont*eel4
7591 C---------------------------------------------------------------------------
7592 double precision function eello5(i,j,k,l,jj,kk)
7593 implicit real*8 (a-h,o-z)
7594 include 'DIMENSIONS'
7595 include 'COMMON.IOUNITS'
7596 include 'COMMON.CHAIN'
7597 include 'COMMON.DERIV'
7598 include 'COMMON.INTERACT'
7599 include 'COMMON.CONTACTS'
7600 include 'COMMON.TORSION'
7601 include 'COMMON.VAR'
7602 include 'COMMON.GEO'
7603 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7604 double precision ggg1(3),ggg2(3)
7605 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7610 C /l\ / \ \ / \ / \ / C
7611 C / \ / \ \ / \ / \ / C
7612 C j| o |l1 | o | o| o | | o |o C
7613 C \ |/k\| |/ \| / |/ \| |/ \| C
7614 C \i/ \ / \ / / \ / \ C
7616 C (I) (II) (III) (IV) C
7618 C eello5_1 eello5_2 eello5_3 eello5_4 C
7620 C Antiparallel chains C
7623 C /j\ / \ \ / \ / \ / C
7624 C / \ / \ \ / \ / \ / C
7625 C j1| o |l | o | o| o | | o |o C
7626 C \ |/k\| |/ \| / |/ \| |/ \| C
7627 C \i/ \ / \ / / \ / \ C
7629 C (I) (II) (III) (IV) C
7631 C eello5_1 eello5_2 eello5_3 eello5_4 C
7633 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7635 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7636 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7641 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7643 itk=itortyp(itype(k))
7644 itl=itortyp(itype(l))
7645 itj=itortyp(itype(j))
7650 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7651 cd & eel5_3_num,eel5_4_num)
7655 derx(lll,kkk,iii)=0.0d0
7659 cd eij=facont_hb(jj,i)
7660 cd ekl=facont_hb(kk,k)
7662 cd write (iout,*)'Contacts have occurred for peptide groups',
7663 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7665 C Contribution from the graph I.
7666 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7667 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7668 call transpose2(EUg(1,1,k),auxmat(1,1))
7669 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7670 vv(1)=pizda(1,1)-pizda(2,2)
7671 vv(2)=pizda(1,2)+pizda(2,1)
7672 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7673 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7674 C Explicit gradient in virtual-dihedral angles.
7675 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7676 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7677 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7678 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7679 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7680 vv(1)=pizda(1,1)-pizda(2,2)
7681 vv(2)=pizda(1,2)+pizda(2,1)
7682 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7683 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7684 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7685 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7686 vv(1)=pizda(1,1)-pizda(2,2)
7687 vv(2)=pizda(1,2)+pizda(2,1)
7689 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7690 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7693 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7694 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7695 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7697 C Cartesian gradient
7701 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7703 vv(1)=pizda(1,1)-pizda(2,2)
7704 vv(2)=pizda(1,2)+pizda(2,1)
7705 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7706 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7707 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7713 C Contribution from graph II
7714 call transpose2(EE(1,1,itk),auxmat(1,1))
7715 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7716 vv(1)=pizda(1,1)+pizda(2,2)
7717 vv(2)=pizda(2,1)-pizda(1,2)
7718 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7719 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7720 C Explicit gradient in virtual-dihedral angles.
7721 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7722 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7723 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7724 vv(1)=pizda(1,1)+pizda(2,2)
7725 vv(2)=pizda(2,1)-pizda(1,2)
7727 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7728 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7729 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7731 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7732 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7733 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7735 C Cartesian gradient
7739 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7741 vv(1)=pizda(1,1)+pizda(2,2)
7742 vv(2)=pizda(2,1)-pizda(1,2)
7743 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7744 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7745 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7753 C Parallel orientation
7754 C Contribution from graph III
7755 call transpose2(EUg(1,1,l),auxmat(1,1))
7756 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7757 vv(1)=pizda(1,1)-pizda(2,2)
7758 vv(2)=pizda(1,2)+pizda(2,1)
7759 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7760 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7761 C Explicit gradient in virtual-dihedral angles.
7762 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7763 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7764 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7765 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7766 vv(1)=pizda(1,1)-pizda(2,2)
7767 vv(2)=pizda(1,2)+pizda(2,1)
7768 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7769 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7770 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7771 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7772 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7773 vv(1)=pizda(1,1)-pizda(2,2)
7774 vv(2)=pizda(1,2)+pizda(2,1)
7775 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7776 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7777 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7778 C Cartesian gradient
7782 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7784 vv(1)=pizda(1,1)-pizda(2,2)
7785 vv(2)=pizda(1,2)+pizda(2,1)
7786 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7787 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7788 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7793 C Contribution from graph IV
7795 call transpose2(EE(1,1,itl),auxmat(1,1))
7796 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7797 vv(1)=pizda(1,1)+pizda(2,2)
7798 vv(2)=pizda(2,1)-pizda(1,2)
7799 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7800 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7801 C Explicit gradient in virtual-dihedral angles.
7802 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7803 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7804 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7805 vv(1)=pizda(1,1)+pizda(2,2)
7806 vv(2)=pizda(2,1)-pizda(1,2)
7807 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7808 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7809 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7810 C Cartesian gradient
7814 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7816 vv(1)=pizda(1,1)+pizda(2,2)
7817 vv(2)=pizda(2,1)-pizda(1,2)
7818 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7819 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7820 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7825 C Antiparallel orientation
7826 C Contribution from graph III
7828 call transpose2(EUg(1,1,j),auxmat(1,1))
7829 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7830 vv(1)=pizda(1,1)-pizda(2,2)
7831 vv(2)=pizda(1,2)+pizda(2,1)
7832 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7833 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7834 C Explicit gradient in virtual-dihedral angles.
7835 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7836 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7837 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7838 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7839 vv(1)=pizda(1,1)-pizda(2,2)
7840 vv(2)=pizda(1,2)+pizda(2,1)
7841 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7842 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7843 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7844 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7845 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7846 vv(1)=pizda(1,1)-pizda(2,2)
7847 vv(2)=pizda(1,2)+pizda(2,1)
7848 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7849 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7850 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7851 C Cartesian gradient
7855 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7857 vv(1)=pizda(1,1)-pizda(2,2)
7858 vv(2)=pizda(1,2)+pizda(2,1)
7859 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7860 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7861 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7866 C Contribution from graph IV
7868 call transpose2(EE(1,1,itj),auxmat(1,1))
7869 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7870 vv(1)=pizda(1,1)+pizda(2,2)
7871 vv(2)=pizda(2,1)-pizda(1,2)
7872 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7873 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7874 C Explicit gradient in virtual-dihedral angles.
7875 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7876 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7877 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7878 vv(1)=pizda(1,1)+pizda(2,2)
7879 vv(2)=pizda(2,1)-pizda(1,2)
7880 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7881 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7882 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7883 C Cartesian gradient
7887 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7889 vv(1)=pizda(1,1)+pizda(2,2)
7890 vv(2)=pizda(2,1)-pizda(1,2)
7891 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7892 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7893 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7899 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7900 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7901 cd write (2,*) 'ijkl',i,j,k,l
7902 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7903 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7905 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7906 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7907 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7908 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7909 if (j.lt.nres-1) then
7916 if (l.lt.nres-1) then
7926 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7927 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7928 C summed up outside the subrouine as for the other subroutines
7929 C handling long-range interactions. The old code is commented out
7930 C with "cgrad" to keep track of changes.
7932 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7933 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7934 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7935 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7936 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7937 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7938 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7939 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7940 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7941 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7943 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7944 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7945 cgrad ghalf=0.5d0*ggg1(ll)
7947 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7948 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7949 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7950 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7951 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7952 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7953 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7954 cgrad ghalf=0.5d0*ggg2(ll)
7956 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7957 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7958 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7959 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7960 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7961 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7966 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7967 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7972 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7973 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7979 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7984 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7988 cd write (2,*) iii,g_corr5_loc(iii)
7991 cd write (2,*) 'ekont',ekont
7992 cd write (iout,*) 'eello5',ekont*eel5
7995 c--------------------------------------------------------------------------
7996 double precision function eello6(i,j,k,l,jj,kk)
7997 implicit real*8 (a-h,o-z)
7998 include 'DIMENSIONS'
7999 include 'COMMON.IOUNITS'
8000 include 'COMMON.CHAIN'
8001 include 'COMMON.DERIV'
8002 include 'COMMON.INTERACT'
8003 include 'COMMON.CONTACTS'
8004 include 'COMMON.TORSION'
8005 include 'COMMON.VAR'
8006 include 'COMMON.GEO'
8007 include 'COMMON.FFIELD'
8008 double precision ggg1(3),ggg2(3)
8009 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8014 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8022 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8023 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8027 derx(lll,kkk,iii)=0.0d0
8031 cd eij=facont_hb(jj,i)
8032 cd ekl=facont_hb(kk,k)
8038 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8039 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8040 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8041 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8042 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8043 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8045 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8046 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8047 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8048 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8049 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8050 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8054 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8056 C If turn contributions are considered, they will be handled separately.
8057 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8058 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8059 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8060 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8061 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8062 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8063 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8065 if (j.lt.nres-1) then
8072 if (l.lt.nres-1) then
8080 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8081 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8082 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8083 cgrad ghalf=0.5d0*ggg1(ll)
8085 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8086 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8087 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8088 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8089 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8090 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8091 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8092 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8093 cgrad ghalf=0.5d0*ggg2(ll)
8094 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8096 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8097 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8098 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8099 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8100 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8101 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8106 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8107 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8112 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8113 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8119 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8124 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8128 cd write (2,*) iii,g_corr6_loc(iii)
8131 cd write (2,*) 'ekont',ekont
8132 cd write (iout,*) 'eello6',ekont*eel6
8135 c--------------------------------------------------------------------------
8136 double precision function eello6_graph1(i,j,k,l,imat,swap)
8137 implicit real*8 (a-h,o-z)
8138 include 'DIMENSIONS'
8139 include 'COMMON.IOUNITS'
8140 include 'COMMON.CHAIN'
8141 include 'COMMON.DERIV'
8142 include 'COMMON.INTERACT'
8143 include 'COMMON.CONTACTS'
8144 include 'COMMON.TORSION'
8145 include 'COMMON.VAR'
8146 include 'COMMON.GEO'
8147 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8151 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8153 C Parallel Antiparallel
8159 C \ j|/k\| / \ |/k\|l /
8164 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8165 itk=itortyp(itype(k))
8166 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8167 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8168 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8169 call transpose2(EUgC(1,1,k),auxmat(1,1))
8170 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8171 vv1(1)=pizda1(1,1)-pizda1(2,2)
8172 vv1(2)=pizda1(1,2)+pizda1(2,1)
8173 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8174 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8175 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8176 s5=scalar2(vv(1),Dtobr2(1,i))
8177 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8178 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8179 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8180 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8181 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8182 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8183 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8184 & +scalar2(vv(1),Dtobr2der(1,i)))
8185 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8186 vv1(1)=pizda1(1,1)-pizda1(2,2)
8187 vv1(2)=pizda1(1,2)+pizda1(2,1)
8188 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8189 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8191 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8192 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8193 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8194 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8195 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8197 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8198 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8199 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8200 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8201 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8203 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8204 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8205 vv1(1)=pizda1(1,1)-pizda1(2,2)
8206 vv1(2)=pizda1(1,2)+pizda1(2,1)
8207 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8208 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8209 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8210 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8219 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8220 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8221 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8222 call transpose2(EUgC(1,1,k),auxmat(1,1))
8223 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8225 vv1(1)=pizda1(1,1)-pizda1(2,2)
8226 vv1(2)=pizda1(1,2)+pizda1(2,1)
8227 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8228 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8229 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8230 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8231 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8232 s5=scalar2(vv(1),Dtobr2(1,i))
8233 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8239 c----------------------------------------------------------------------------
8240 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8241 implicit real*8 (a-h,o-z)
8242 include 'DIMENSIONS'
8243 include 'COMMON.IOUNITS'
8244 include 'COMMON.CHAIN'
8245 include 'COMMON.DERIV'
8246 include 'COMMON.INTERACT'
8247 include 'COMMON.CONTACTS'
8248 include 'COMMON.TORSION'
8249 include 'COMMON.VAR'
8250 include 'COMMON.GEO'
8252 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8253 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8256 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8258 C Parallel Antiparallel C
8264 C \ j|/k\| \ |/k\|l C
8269 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8270 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8271 C AL 7/4/01 s1 would occur in the sixth-order moment,
8272 C but not in a cluster cumulant
8274 s1=dip(1,jj,i)*dip(1,kk,k)
8276 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8277 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8278 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8279 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8280 call transpose2(EUg(1,1,k),auxmat(1,1))
8281 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8282 vv(1)=pizda(1,1)-pizda(2,2)
8283 vv(2)=pizda(1,2)+pizda(2,1)
8284 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8285 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8287 eello6_graph2=-(s1+s2+s3+s4)
8289 eello6_graph2=-(s2+s3+s4)
8292 C Derivatives in gamma(i-1)
8295 s1=dipderg(1,jj,i)*dip(1,kk,k)
8297 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8298 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8299 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8300 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8302 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8304 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8306 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8308 C Derivatives in gamma(k-1)
8310 s1=dip(1,jj,i)*dipderg(1,kk,k)
8312 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8313 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8314 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8315 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8316 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8317 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8318 vv(1)=pizda(1,1)-pizda(2,2)
8319 vv(2)=pizda(1,2)+pizda(2,1)
8320 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8322 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8324 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8326 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8327 C Derivatives in gamma(j-1) or gamma(l-1)
8330 s1=dipderg(3,jj,i)*dip(1,kk,k)
8332 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8333 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8334 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8335 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8336 vv(1)=pizda(1,1)-pizda(2,2)
8337 vv(2)=pizda(1,2)+pizda(2,1)
8338 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8341 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8343 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8346 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8347 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8349 C Derivatives in gamma(l-1) or gamma(j-1)
8352 s1=dip(1,jj,i)*dipderg(3,kk,k)
8354 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8355 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8356 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8357 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8358 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8359 vv(1)=pizda(1,1)-pizda(2,2)
8360 vv(2)=pizda(1,2)+pizda(2,1)
8361 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8364 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8366 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8369 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8370 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8372 C Cartesian derivatives.
8374 write (2,*) 'In eello6_graph2'
8376 write (2,*) 'iii=',iii
8378 write (2,*) 'kkk=',kkk
8380 write (2,'(3(2f10.5),5x)')
8381 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8391 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8393 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8396 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8398 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8399 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8401 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8402 call transpose2(EUg(1,1,k),auxmat(1,1))
8403 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8405 vv(1)=pizda(1,1)-pizda(2,2)
8406 vv(2)=pizda(1,2)+pizda(2,1)
8407 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8408 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8410 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8412 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8415 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8417 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8424 c----------------------------------------------------------------------------
8425 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8426 implicit real*8 (a-h,o-z)
8427 include 'DIMENSIONS'
8428 include 'COMMON.IOUNITS'
8429 include 'COMMON.CHAIN'
8430 include 'COMMON.DERIV'
8431 include 'COMMON.INTERACT'
8432 include 'COMMON.CONTACTS'
8433 include 'COMMON.TORSION'
8434 include 'COMMON.VAR'
8435 include 'COMMON.GEO'
8436 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8438 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8440 C Parallel Antiparallel C
8446 C j|/k\| / |/k\|l / C
8451 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8453 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8454 C energy moment and not to the cluster cumulant.
8455 iti=itortyp(itype(i))
8456 if (j.lt.nres-1) then
8457 itj1=itortyp(itype(j+1))
8461 itk=itortyp(itype(k))
8462 itk1=itortyp(itype(k+1))
8463 if (l.lt.nres-1) then
8464 itl1=itortyp(itype(l+1))
8469 s1=dip(4,jj,i)*dip(4,kk,k)
8471 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8472 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8473 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8474 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8475 call transpose2(EE(1,1,itk),auxmat(1,1))
8476 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8477 vv(1)=pizda(1,1)+pizda(2,2)
8478 vv(2)=pizda(2,1)-pizda(1,2)
8479 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8480 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8481 cd & "sum",-(s2+s3+s4)
8483 eello6_graph3=-(s1+s2+s3+s4)
8485 eello6_graph3=-(s2+s3+s4)
8488 C Derivatives in gamma(k-1)
8489 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8490 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8491 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8492 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8493 C Derivatives in gamma(l-1)
8494 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8495 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8496 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8497 vv(1)=pizda(1,1)+pizda(2,2)
8498 vv(2)=pizda(2,1)-pizda(1,2)
8499 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8500 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8501 C Cartesian derivatives.
8507 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8509 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8512 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8514 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8515 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8517 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8518 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8520 vv(1)=pizda(1,1)+pizda(2,2)
8521 vv(2)=pizda(2,1)-pizda(1,2)
8522 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8524 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8526 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8529 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8531 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8533 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8539 c----------------------------------------------------------------------------
8540 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8541 implicit real*8 (a-h,o-z)
8542 include 'DIMENSIONS'
8543 include 'COMMON.IOUNITS'
8544 include 'COMMON.CHAIN'
8545 include 'COMMON.DERIV'
8546 include 'COMMON.INTERACT'
8547 include 'COMMON.CONTACTS'
8548 include 'COMMON.TORSION'
8549 include 'COMMON.VAR'
8550 include 'COMMON.GEO'
8551 include 'COMMON.FFIELD'
8552 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8553 & auxvec1(2),auxmat1(2,2)
8555 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8557 C Parallel Antiparallel C
8563 C \ j|/k\| \ |/k\|l C
8568 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8570 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8571 C energy moment and not to the cluster cumulant.
8572 cd write (2,*) 'eello_graph4: wturn6',wturn6
8573 iti=itortyp(itype(i))
8574 itj=itortyp(itype(j))
8575 if (j.lt.nres-1) then
8576 itj1=itortyp(itype(j+1))
8580 itk=itortyp(itype(k))
8581 if (k.lt.nres-1) then
8582 itk1=itortyp(itype(k+1))
8586 itl=itortyp(itype(l))
8587 if (l.lt.nres-1) then
8588 itl1=itortyp(itype(l+1))
8592 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8593 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8594 cd & ' itl',itl,' itl1',itl1
8597 s1=dip(3,jj,i)*dip(3,kk,k)
8599 s1=dip(2,jj,j)*dip(2,kk,l)
8602 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8603 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8605 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8606 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8608 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8609 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8611 call transpose2(EUg(1,1,k),auxmat(1,1))
8612 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8613 vv(1)=pizda(1,1)-pizda(2,2)
8614 vv(2)=pizda(2,1)+pizda(1,2)
8615 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8616 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8618 eello6_graph4=-(s1+s2+s3+s4)
8620 eello6_graph4=-(s2+s3+s4)
8622 C Derivatives in gamma(i-1)
8626 s1=dipderg(2,jj,i)*dip(3,kk,k)
8628 s1=dipderg(4,jj,j)*dip(2,kk,l)
8631 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8633 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8634 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8636 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8637 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8639 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8640 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8641 cd write (2,*) 'turn6 derivatives'
8643 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8645 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8649 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8651 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8655 C Derivatives in gamma(k-1)
8658 s1=dip(3,jj,i)*dipderg(2,kk,k)
8660 s1=dip(2,jj,j)*dipderg(4,kk,l)
8663 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8664 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8666 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8667 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8669 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8670 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8672 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8673 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8674 vv(1)=pizda(1,1)-pizda(2,2)
8675 vv(2)=pizda(2,1)+pizda(1,2)
8676 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8677 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8679 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8681 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8685 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8687 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8690 C Derivatives in gamma(j-1) or gamma(l-1)
8691 if (l.eq.j+1 .and. l.gt.1) then
8692 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8693 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8694 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8695 vv(1)=pizda(1,1)-pizda(2,2)
8696 vv(2)=pizda(2,1)+pizda(1,2)
8697 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8698 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8699 else if (j.gt.1) then
8700 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8701 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8702 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8703 vv(1)=pizda(1,1)-pizda(2,2)
8704 vv(2)=pizda(2,1)+pizda(1,2)
8705 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8706 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8707 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8709 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8712 C Cartesian derivatives.
8719 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8721 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8725 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8727 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8731 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8733 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8735 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8736 & b1(1,itj1),auxvec(1))
8737 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8739 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8740 & b1(1,itl1),auxvec(1))
8741 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8743 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8745 vv(1)=pizda(1,1)-pizda(2,2)
8746 vv(2)=pizda(2,1)+pizda(1,2)
8747 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8749 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8751 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8754 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8757 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8760 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8762 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8764 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8768 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8770 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8773 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8775 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8783 c----------------------------------------------------------------------------
8784 double precision function eello_turn6(i,jj,kk)
8785 implicit real*8 (a-h,o-z)
8786 include 'DIMENSIONS'
8787 include 'COMMON.IOUNITS'
8788 include 'COMMON.CHAIN'
8789 include 'COMMON.DERIV'
8790 include 'COMMON.INTERACT'
8791 include 'COMMON.CONTACTS'
8792 include 'COMMON.TORSION'
8793 include 'COMMON.VAR'
8794 include 'COMMON.GEO'
8795 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8796 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8798 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8799 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8800 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8801 C the respective energy moment and not to the cluster cumulant.
8810 iti=itortyp(itype(i))
8811 itk=itortyp(itype(k))
8812 itk1=itortyp(itype(k+1))
8813 itl=itortyp(itype(l))
8814 itj=itortyp(itype(j))
8815 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8816 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8817 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8822 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8824 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8828 derx_turn(lll,kkk,iii)=0.0d0
8835 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8837 cd write (2,*) 'eello6_5',eello6_5
8839 call transpose2(AEA(1,1,1),auxmat(1,1))
8840 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8841 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8842 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8844 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8845 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8846 s2 = scalar2(b1(1,itk),vtemp1(1))
8848 call transpose2(AEA(1,1,2),atemp(1,1))
8849 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8850 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8851 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8853 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8854 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8855 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8857 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8858 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8859 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8860 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8861 ss13 = scalar2(b1(1,itk),vtemp4(1))
8862 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8864 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8870 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8871 C Derivatives in gamma(i+2)
8875 call transpose2(AEA(1,1,1),auxmatd(1,1))
8876 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8877 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8878 call transpose2(AEAderg(1,1,2),atempd(1,1))
8879 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8880 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8882 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8883 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8884 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8890 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8891 C Derivatives in gamma(i+3)
8893 call transpose2(AEA(1,1,1),auxmatd(1,1))
8894 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8895 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8896 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8898 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8899 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8900 s2d = scalar2(b1(1,itk),vtemp1d(1))
8902 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8903 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8905 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8907 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8908 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8909 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8917 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8918 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8920 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8921 & -0.5d0*ekont*(s2d+s12d)
8923 C Derivatives in gamma(i+4)
8924 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8925 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8926 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8928 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8929 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8930 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8938 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8940 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8942 C Derivatives in gamma(i+5)
8944 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8945 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8946 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8948 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8949 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8950 s2d = scalar2(b1(1,itk),vtemp1d(1))
8952 call transpose2(AEA(1,1,2),atempd(1,1))
8953 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8954 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8956 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8957 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8959 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8960 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8961 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8969 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8970 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8972 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8973 & -0.5d0*ekont*(s2d+s12d)
8975 C Cartesian derivatives
8980 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8981 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8982 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8984 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8985 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8987 s2d = scalar2(b1(1,itk),vtemp1d(1))
8989 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8990 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8991 s8d = -(atempd(1,1)+atempd(2,2))*
8992 & scalar2(cc(1,1,itl),vtemp2(1))
8994 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8996 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8997 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9004 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9007 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9011 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9012 & - 0.5d0*(s8d+s12d)
9014 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9023 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9025 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9026 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9027 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9028 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9029 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9031 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9032 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9033 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9037 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9038 cd & 16*eel_turn6_num
9040 if (j.lt.nres-1) then
9047 if (l.lt.nres-1) then
9055 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9056 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9057 cgrad ghalf=0.5d0*ggg1(ll)
9059 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9060 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9061 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9062 & +ekont*derx_turn(ll,2,1)
9063 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9064 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9065 & +ekont*derx_turn(ll,4,1)
9066 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9067 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9068 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9069 cgrad ghalf=0.5d0*ggg2(ll)
9071 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9072 & +ekont*derx_turn(ll,2,2)
9073 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9074 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9075 & +ekont*derx_turn(ll,4,2)
9076 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9077 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9078 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9083 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9088 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9094 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9099 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9103 cd write (2,*) iii,g_corr6_loc(iii)
9105 eello_turn6=ekont*eel_turn6
9106 cd write (2,*) 'ekont',ekont
9107 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9111 C-----------------------------------------------------------------------------
9112 double precision function scalar(u,v)
9113 !DIR$ INLINEALWAYS scalar
9115 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9118 double precision u(3),v(3)
9119 cd double precision sc
9127 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9130 crc-------------------------------------------------
9131 SUBROUTINE MATVEC2(A1,V1,V2)
9132 !DIR$ INLINEALWAYS MATVEC2
9134 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9136 implicit real*8 (a-h,o-z)
9137 include 'DIMENSIONS'
9138 DIMENSION A1(2,2),V1(2),V2(2)
9142 c 3 VI=VI+A1(I,K)*V1(K)
9146 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9147 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9152 C---------------------------------------
9153 SUBROUTINE MATMAT2(A1,A2,A3)
9155 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9157 implicit real*8 (a-h,o-z)
9158 include 'DIMENSIONS'
9159 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9160 c DIMENSION AI3(2,2)
9164 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9170 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9171 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9172 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9173 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9181 c-------------------------------------------------------------------------
9182 double precision function scalar2(u,v)
9183 !DIR$ INLINEALWAYS scalar2
9185 double precision u(2),v(2)
9188 scalar2=u(1)*v(1)+u(2)*v(2)
9192 C-----------------------------------------------------------------------------
9194 subroutine transpose2(a,at)
9195 !DIR$ INLINEALWAYS transpose2
9197 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9200 double precision a(2,2),at(2,2)
9207 c--------------------------------------------------------------------------
9208 subroutine transpose(n,a,at)
9211 double precision a(n,n),at(n,n)
9219 C---------------------------------------------------------------------------
9220 subroutine prodmat3(a1,a2,kk,transp,prod)
9221 !DIR$ INLINEALWAYS prodmat3
9223 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9227 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9229 crc double precision auxmat(2,2),prod_(2,2)
9232 crc call transpose2(kk(1,1),auxmat(1,1))
9233 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9234 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9236 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9237 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9238 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9239 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9240 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9241 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9242 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9243 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9246 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9247 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9249 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9250 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9251 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9252 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9253 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9254 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9255 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9256 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9259 c call transpose2(a2(1,1),a2t(1,1))
9262 crc print *,((prod_(i,j),i=1,2),j=1,2)
9263 crc print *,((prod(i,j),i=1,2),j=1,2)