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
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
126 c print *,"Processor",myrank," computed USCSC"
132 time_vec=time_vec+MPI_Wtime()-time01
134 c print *,"Processor",myrank," left VEC_AND_DERIV"
137 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
138 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
139 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
140 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
142 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
143 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
144 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
145 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
147 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
156 c write (iout,*) "Soft-spheer ELEC potential"
157 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
160 c print *,"Processor",myrank," computed UELEC"
162 C Calculate excluded-volume interaction energy between peptide groups
167 call escp(evdw2,evdw2_14)
173 c write (iout,*) "Soft-sphere SCP potential"
174 call escp_soft_sphere(evdw2,evdw2_14)
177 c Calculate the bond-stretching energy
181 C Calculate the disulfide-bridge and other energy and the contributions
182 C from other distance constraints.
183 cd print *,'Calling EHPB'
185 cd print *,'EHPB exitted succesfully.'
187 C Calculate the virtual-bond-angle energy.
189 if (wang.gt.0d0) then
194 c print *,"Processor",myrank," computed UB"
196 C Calculate the SC local energy.
199 c print *,"Processor",myrank," computed USC"
201 C Calculate the virtual-bond torsional energy.
203 cd print *,'nterm=',nterm
205 call etor(etors,edihcnstr)
210 c print *,"Processor",myrank," computed Utor"
212 C 6/23/01 Calculate double-torsional energy
214 if (wtor_d.gt.0) then
219 c print *,"Processor",myrank," computed Utord"
221 C 21/5/07 Calculate local sicdechain correlation energy
223 if (wsccor.gt.0.0d0) then
224 call eback_sc_corr(esccor)
228 c print *,"Processor",myrank," computed Usccorr"
230 C 12/1/95 Multi-body terms
234 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
235 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
236 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
237 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
238 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
245 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
246 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
247 cd write (iout,*) "multibody_hb ecorr",ecorr
249 c print *,"Processor",myrank," computed Ucorr"
251 C If performing constraint dynamics, call the constraint energy
252 C after the equilibration time
253 if(usampl.and.totT.gt.eq_time) then
261 time_enecalc=time_enecalc+MPI_Wtime()-time00
263 c print *,"Processor",myrank," computed Uconstr"
272 energia(2)=evdw2-evdw2_14
289 energia(8)=eello_turn3
290 energia(9)=eello_turn4
297 energia(19)=edihcnstr
299 energia(20)=Uconst+Uconst_back
303 c print *," Processor",myrank," calls SUM_ENERGY"
304 call sum_energy(energia,.true.)
305 c print *," Processor",myrank," left SUM_ENERGY"
307 time_sumene=time_sumene+MPI_Wtime()-time00
311 c-------------------------------------------------------------------------------
312 subroutine sum_energy(energia,reduce)
313 implicit real*8 (a-h,o-z)
318 cMS$ATTRIBUTES C :: proc_proc
324 include 'COMMON.SETUP'
325 include 'COMMON.IOUNITS'
326 double precision energia(0:n_ene),enebuff(0:n_ene+1)
327 include 'COMMON.FFIELD'
328 include 'COMMON.DERIV'
329 include 'COMMON.INTERACT'
330 include 'COMMON.SBRIDGE'
331 include 'COMMON.CHAIN'
333 include 'COMMON.CONTROL'
334 include 'COMMON.TIME1'
337 if (nfgtasks.gt.1 .and. reduce) then
339 write (iout,*) "energies before REDUCE"
340 call enerprint(energia)
344 enebuff(i)=energia(i)
347 call MPI_Barrier(FG_COMM,IERR)
348 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
350 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
351 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
353 write (iout,*) "energies after REDUCE"
354 call enerprint(energia)
357 time_Reduce=time_Reduce+MPI_Wtime()-time00
359 if (fg_rank.eq.0) then
362 evdw=energia(22)+wsct*energia(23)
367 evdw2=energia(2)+energia(18)
383 eello_turn3=energia(8)
384 eello_turn4=energia(9)
391 edihcnstr=energia(19)
396 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
397 & +wang*ebe+wtor*etors+wscloc*escloc
398 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
399 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
400 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
401 & +wbond*estr+Uconst+wsccor*esccor
403 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
404 & +wang*ebe+wtor*etors+wscloc*escloc
405 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
406 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
407 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
408 & +wbond*estr+Uconst+wsccor*esccor
414 if (isnan(etot).ne.0) energia(0)=1.0d+99
416 if (isnan(etot)) energia(0)=1.0d+99
421 idumm=proc_proc(etot,i)
423 call proc_proc(etot,i)
425 if(i.eq.1)energia(0)=1.0d+99
432 c-------------------------------------------------------------------------------
433 subroutine sum_gradient
434 implicit real*8 (a-h,o-z)
439 cMS$ATTRIBUTES C :: proc_proc
445 double precision gradbufc(3,maxres),gradbufx(3,maxres),
446 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
447 include 'COMMON.SETUP'
448 include 'COMMON.IOUNITS'
449 include 'COMMON.FFIELD'
450 include 'COMMON.DERIV'
451 include 'COMMON.INTERACT'
452 include 'COMMON.SBRIDGE'
453 include 'COMMON.CHAIN'
455 include 'COMMON.CONTROL'
456 include 'COMMON.TIME1'
457 include 'COMMON.MAXGRAD'
458 include 'COMMON.SCCOR'
467 write (iout,*) "sum_gradient gvdwc, gvdwx"
469 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
470 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
471 & (gvdwcT(j,i),j=1,3)
476 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
477 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
478 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
481 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
482 C in virtual-bond-vector coordinates
485 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
487 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
488 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
490 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
492 c write (iout,'(i5,3f10.5,2x,f10.5)')
493 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
495 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
497 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
498 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
507 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
508 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
509 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
510 & wel_loc*gel_loc_long(j,i)+
511 & wcorr*gradcorr_long(j,i)+
512 & wcorr5*gradcorr5_long(j,i)+
513 & wcorr6*gradcorr6_long(j,i)+
514 & wturn6*gcorr6_turn_long(j,i)+
521 gradbufc(j,i)=wsc*gvdwc(j,i)+
522 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
523 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
524 & wel_loc*gel_loc_long(j,i)+
525 & wcorr*gradcorr_long(j,i)+
526 & wcorr5*gradcorr5_long(j,i)+
527 & wcorr6*gradcorr6_long(j,i)+
528 & wturn6*gcorr6_turn_long(j,i)+
536 gradbufc(j,i)=wsc*gvdwc(j,i)+
537 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
538 & welec*gelc_long(j,i)+
540 & wel_loc*gel_loc_long(j,i)+
541 & wcorr*gradcorr_long(j,i)+
542 & wcorr5*gradcorr5_long(j,i)+
543 & wcorr6*gradcorr6_long(j,i)+
544 & wturn6*gcorr6_turn_long(j,i)+
550 if (nfgtasks.gt.1) then
553 write (iout,*) "gradbufc before allreduce"
555 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
561 gradbufc_sum(j,i)=gradbufc(j,i)
564 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
565 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
566 c time_reduce=time_reduce+MPI_Wtime()-time00
568 c write (iout,*) "gradbufc_sum after allreduce"
570 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
575 c time_allreduce=time_allreduce+MPI_Wtime()-time00
583 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
584 write (iout,*) (i," jgrad_start",jgrad_start(i),
585 & " jgrad_end ",jgrad_end(i),
586 & i=igrad_start,igrad_end)
589 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
590 c do not parallelize this part.
592 c do i=igrad_start,igrad_end
593 c do j=jgrad_start(i),jgrad_end(i)
595 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
600 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
604 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
608 write (iout,*) "gradbufc after summing"
610 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
617 write (iout,*) "gradbufc"
619 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
625 gradbufc_sum(j,i)=gradbufc(j,i)
630 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
634 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
639 c gradbufc(k,i)=0.0d0
643 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
648 write (iout,*) "gradbufc after summing"
650 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
658 gradbufc(k,nres)=0.0d0
663 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
664 & wel_loc*gel_loc(j,i)+
665 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
666 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
667 & wel_loc*gel_loc_long(j,i)+
668 & wcorr*gradcorr_long(j,i)+
669 & wcorr5*gradcorr5_long(j,i)+
670 & wcorr6*gradcorr6_long(j,i)+
671 & wturn6*gcorr6_turn_long(j,i))+
673 & wcorr*gradcorr(j,i)+
674 & wturn3*gcorr3_turn(j,i)+
675 & wturn4*gcorr4_turn(j,i)+
676 & wcorr5*gradcorr5(j,i)+
677 & wcorr6*gradcorr6(j,i)+
678 & wturn6*gcorr6_turn(j,i)+
679 & wsccor*gsccorc(j,i)
680 & +wscloc*gscloc(j,i)
682 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
683 & wel_loc*gel_loc(j,i)+
684 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
685 & welec*gelc_long(j,i)+
686 & wel_loc*gel_loc_long(j,i)+
687 & wcorr*gcorr_long(j,i)+
688 & wcorr5*gradcorr5_long(j,i)+
689 & wcorr6*gradcorr6_long(j,i)+
690 & wturn6*gcorr6_turn_long(j,i))+
692 & wcorr*gradcorr(j,i)+
693 & wturn3*gcorr3_turn(j,i)+
694 & wturn4*gcorr4_turn(j,i)+
695 & wcorr5*gradcorr5(j,i)+
696 & wcorr6*gradcorr6(j,i)+
697 & wturn6*gcorr6_turn(j,i)+
698 & wsccor*gsccorc(j,i)
699 & +wscloc*gscloc(j,i)
702 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
703 & wscp*gradx_scp(j,i)+
705 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
706 & wsccor*gsccorx(j,i)
707 & +wscloc*gsclocx(j,i)
709 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
711 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
712 & wsccor*gsccorx(j,i)
713 & +wscloc*gsclocx(j,i)
718 write (iout,*) "gloc before adding corr"
720 write (iout,*) i,gloc(i,icg)
724 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
725 & +wcorr5*g_corr5_loc(i)
726 & +wcorr6*g_corr6_loc(i)
727 & +wturn4*gel_loc_turn4(i)
728 & +wturn3*gel_loc_turn3(i)
729 & +wturn6*gel_loc_turn6(i)
730 & +wel_loc*gel_loc_loc(i)
733 write (iout,*) "gloc after adding corr"
735 write (iout,*) i,gloc(i,icg)
739 if (nfgtasks.gt.1) then
742 gradbufc(j,i)=gradc(j,i,icg)
743 gradbufx(j,i)=gradx(j,i,icg)
747 glocbuf(i)=gloc(i,icg)
750 write (iout,*) "gloc_sc before reduce"
753 write (iout,*) i,j,gloc_sc(j,i,icg)
759 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
763 call MPI_Barrier(FG_COMM,IERR)
764 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
766 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
767 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
768 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
769 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
770 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
771 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
772 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
773 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
774 time_reduce=time_reduce+MPI_Wtime()-time00
776 write (iout,*) "gloc_sc after reduce"
779 write (iout,*) i,j,gloc_sc(j,i,icg)
784 write (iout,*) "gloc after reduce"
786 write (iout,*) i,gloc(i,icg)
791 if (gnorm_check) then
793 c Compute the maximum elements of the gradient
803 gcorr3_turn_max=0.0d0
804 gcorr4_turn_max=0.0d0
807 gcorr6_turn_max=0.0d0
817 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
818 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
820 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
821 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
823 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
824 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
825 & gvdwc_scp_max=gvdwc_scp_norm
826 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
827 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
828 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
829 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
830 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
831 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
832 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
833 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
834 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
835 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
836 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
837 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
838 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
840 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
841 & gcorr3_turn_max=gcorr3_turn_norm
842 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
844 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
845 & gcorr4_turn_max=gcorr4_turn_norm
846 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
847 if (gradcorr5_norm.gt.gradcorr5_max)
848 & gradcorr5_max=gradcorr5_norm
849 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
850 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
851 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
853 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
854 & gcorr6_turn_max=gcorr6_turn_norm
855 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
856 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
857 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
858 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
859 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
860 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
862 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
863 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
865 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
866 if (gradx_scp_norm.gt.gradx_scp_max)
867 & gradx_scp_max=gradx_scp_norm
868 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
869 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
870 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
871 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
872 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
873 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
874 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
875 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
879 open(istat,file=statname,position="append")
881 open(istat,file=statname,access="append")
883 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
884 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
885 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
886 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
887 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
888 & gsccorx_max,gsclocx_max
890 if (gvdwc_max.gt.1.0d4) then
891 write (iout,*) "gvdwc gvdwx gradb gradbx"
893 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
894 & gradb(j,i),gradbx(j,i),j=1,3)
896 call pdbout(0.0d0,'cipiszcze',iout)
902 write (iout,*) "gradc gradx gloc"
904 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
905 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
910 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
912 time_sumgradient=time_sumgradient+tcpu()-time01
917 c-------------------------------------------------------------------------------
918 subroutine rescale_weights(t_bath)
919 implicit real*8 (a-h,o-z)
921 include 'COMMON.IOUNITS'
922 include 'COMMON.FFIELD'
923 include 'COMMON.SBRIDGE'
924 double precision kfac /2.4d0/
925 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
927 c facT=2*temp0/(t_bath+temp0)
928 if (rescale_mode.eq.0) then
934 else if (rescale_mode.eq.1) then
935 facT=kfac/(kfac-1.0d0+t_bath/temp0)
936 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
937 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
938 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
939 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
940 else if (rescale_mode.eq.2) then
946 facT=licznik/dlog(dexp(x)+dexp(-x))
947 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
948 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
949 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
950 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
952 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
953 write (*,*) "Wrong RESCALE_MODE",rescale_mode
955 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
959 welec=weights(3)*fact
960 wcorr=weights(4)*fact3
961 wcorr5=weights(5)*fact4
962 wcorr6=weights(6)*fact5
963 wel_loc=weights(7)*fact2
964 wturn3=weights(8)*fact2
965 wturn4=weights(9)*fact3
966 wturn6=weights(10)*fact5
967 wtor=weights(13)*fact
968 wtor_d=weights(14)*fact2
969 wsccor=weights(21)*fact
972 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
976 C------------------------------------------------------------------------
977 subroutine enerprint(energia)
978 implicit real*8 (a-h,o-z)
980 include 'COMMON.IOUNITS'
981 include 'COMMON.FFIELD'
982 include 'COMMON.SBRIDGE'
984 double precision energia(0:n_ene)
987 evdw=energia(22)+wsct*energia(23)
993 evdw2=energia(2)+energia(18)
1005 eello_turn3=energia(8)
1006 eello_turn4=energia(9)
1007 eello_turn6=energia(10)
1013 edihcnstr=energia(19)
1018 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1019 & estr,wbond,ebe,wang,
1020 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1022 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1023 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1024 & edihcnstr,ebr*nss,
1026 10 format (/'Virtual-chain energies:'//
1027 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1028 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1029 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1030 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1031 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1032 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1033 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1034 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1035 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1036 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1037 & ' (SS bridges & dist. cnstr.)'/
1038 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1039 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1040 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1041 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1042 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1043 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1044 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1045 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1046 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1047 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1048 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1049 & 'ETOT= ',1pE16.6,' (total)')
1051 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1052 & estr,wbond,ebe,wang,
1053 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1055 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1056 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1057 & ebr*nss,Uconst,etot
1058 10 format (/'Virtual-chain energies:'//
1059 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1060 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1061 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1062 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1063 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1064 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1065 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1066 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1067 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1068 & ' (SS bridges & dist. cnstr.)'/
1069 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1070 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1071 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1072 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1073 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1074 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1075 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1076 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1077 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1078 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1079 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1080 & 'ETOT= ',1pE16.6,' (total)')
1084 C-----------------------------------------------------------------------
1085 subroutine elj(evdw,evdw_p,evdw_m)
1087 C This subroutine calculates the interaction energy of nonbonded side chains
1088 C assuming the LJ potential of interaction.
1090 implicit real*8 (a-h,o-z)
1091 include 'DIMENSIONS'
1092 parameter (accur=1.0d-10)
1093 include 'COMMON.GEO'
1094 include 'COMMON.VAR'
1095 include 'COMMON.LOCAL'
1096 include 'COMMON.CHAIN'
1097 include 'COMMON.DERIV'
1098 include 'COMMON.INTERACT'
1099 include 'COMMON.TORSION'
1100 include 'COMMON.SBRIDGE'
1101 include 'COMMON.NAMES'
1102 include 'COMMON.IOUNITS'
1103 include 'COMMON.CONTACTS'
1105 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1107 do i=iatsc_s,iatsc_e
1116 C Calculate SC interaction energy.
1118 do iint=1,nint_gr(i)
1119 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1120 cd & 'iend=',iend(i,iint)
1121 do j=istart(i,iint),iend(i,iint)
1126 C Change 12/1/95 to calculate four-body interactions
1127 rij=xj*xj+yj*yj+zj*zj
1129 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1130 eps0ij=eps(itypi,itypj)
1132 e1=fac*fac*aa(itypi,itypj)
1133 e2=fac*bb(itypi,itypj)
1135 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1136 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1137 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1138 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1139 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1140 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1142 if (bb(itypi,itypj).gt.0) then
1143 evdw_p=evdw_p+evdwij
1145 evdw_m=evdw_m+evdwij
1151 C Calculate the components of the gradient in DC and X
1153 fac=-rrij*(e1+evdwij)
1158 if (bb(itypi,itypj).gt.0.0d0) then
1160 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1161 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1162 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1163 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1167 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1168 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1169 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1170 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1175 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1176 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1177 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1178 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1183 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1187 C 12/1/95, revised on 5/20/97
1189 C Calculate the contact function. The ith column of the array JCONT will
1190 C contain the numbers of atoms that make contacts with the atom I (of numbers
1191 C greater than I). The arrays FACONT and GACONT will contain the values of
1192 C the contact function and its derivative.
1194 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1195 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1196 C Uncomment next line, if the correlation interactions are contact function only
1197 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1199 sigij=sigma(itypi,itypj)
1200 r0ij=rs0(itypi,itypj)
1202 C Check whether the SC's are not too far to make a contact.
1205 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1206 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1208 if (fcont.gt.0.0D0) then
1209 C If the SC-SC distance if close to sigma, apply spline.
1210 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1211 cAdam & fcont1,fprimcont1)
1212 cAdam fcont1=1.0d0-fcont1
1213 cAdam if (fcont1.gt.0.0d0) then
1214 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1215 cAdam fcont=fcont*fcont1
1217 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1218 cga eps0ij=1.0d0/dsqrt(eps0ij)
1220 cga gg(k)=gg(k)*eps0ij
1222 cga eps0ij=-evdwij*eps0ij
1223 C Uncomment for AL's type of SC correlation interactions.
1224 cadam eps0ij=-evdwij
1225 num_conti=num_conti+1
1226 jcont(num_conti,i)=j
1227 facont(num_conti,i)=fcont*eps0ij
1228 fprimcont=eps0ij*fprimcont/rij
1230 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1231 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1232 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1233 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1234 gacont(1,num_conti,i)=-fprimcont*xj
1235 gacont(2,num_conti,i)=-fprimcont*yj
1236 gacont(3,num_conti,i)=-fprimcont*zj
1237 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1238 cd write (iout,'(2i3,3f10.5)')
1239 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1245 num_cont(i)=num_conti
1249 gvdwc(j,i)=expon*gvdwc(j,i)
1250 gvdwx(j,i)=expon*gvdwx(j,i)
1253 C******************************************************************************
1257 C To save time, the factor of EXPON has been extracted from ALL components
1258 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1261 C******************************************************************************
1264 C-----------------------------------------------------------------------------
1265 subroutine eljk(evdw,evdw_p,evdw_m)
1267 C This subroutine calculates the interaction energy of nonbonded side chains
1268 C assuming the LJK potential of interaction.
1270 implicit real*8 (a-h,o-z)
1271 include 'DIMENSIONS'
1272 include 'COMMON.GEO'
1273 include 'COMMON.VAR'
1274 include 'COMMON.LOCAL'
1275 include 'COMMON.CHAIN'
1276 include 'COMMON.DERIV'
1277 include 'COMMON.INTERACT'
1278 include 'COMMON.IOUNITS'
1279 include 'COMMON.NAMES'
1282 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1284 do i=iatsc_s,iatsc_e
1291 C Calculate SC interaction energy.
1293 do iint=1,nint_gr(i)
1294 do j=istart(i,iint),iend(i,iint)
1299 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1300 fac_augm=rrij**expon
1301 e_augm=augm(itypi,itypj)*fac_augm
1302 r_inv_ij=dsqrt(rrij)
1304 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1305 fac=r_shift_inv**expon
1306 e1=fac*fac*aa(itypi,itypj)
1307 e2=fac*bb(itypi,itypj)
1309 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1310 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1311 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1312 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1313 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1314 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1315 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1317 if (bb(itypi,itypj).gt.0) then
1318 evdw_p=evdw_p+evdwij
1320 evdw_m=evdw_m+evdwij
1326 C Calculate the components of the gradient in DC and X
1328 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1333 if (bb(itypi,itypj).gt.0.0d0) then
1335 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1336 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1337 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1338 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1342 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1343 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1344 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1345 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1350 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1351 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1352 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1353 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1358 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1366 gvdwc(j,i)=expon*gvdwc(j,i)
1367 gvdwx(j,i)=expon*gvdwx(j,i)
1372 C-----------------------------------------------------------------------------
1373 subroutine ebp(evdw,evdw_p,evdw_m)
1375 C This subroutine calculates the interaction energy of nonbonded side chains
1376 C assuming the Berne-Pechukas potential of interaction.
1378 implicit real*8 (a-h,o-z)
1379 include 'DIMENSIONS'
1380 include 'COMMON.GEO'
1381 include 'COMMON.VAR'
1382 include 'COMMON.LOCAL'
1383 include 'COMMON.CHAIN'
1384 include 'COMMON.DERIV'
1385 include 'COMMON.NAMES'
1386 include 'COMMON.INTERACT'
1387 include 'COMMON.IOUNITS'
1388 include 'COMMON.CALC'
1389 common /srutu/ icall
1390 c double precision rrsave(maxdim)
1393 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1395 c if (icall.eq.0) then
1401 do i=iatsc_s,iatsc_e
1407 dxi=dc_norm(1,nres+i)
1408 dyi=dc_norm(2,nres+i)
1409 dzi=dc_norm(3,nres+i)
1410 c dsci_inv=dsc_inv(itypi)
1411 dsci_inv=vbld_inv(i+nres)
1413 C Calculate SC interaction energy.
1415 do iint=1,nint_gr(i)
1416 do j=istart(i,iint),iend(i,iint)
1419 c dscj_inv=dsc_inv(itypj)
1420 dscj_inv=vbld_inv(j+nres)
1421 chi1=chi(itypi,itypj)
1422 chi2=chi(itypj,itypi)
1429 alf12=0.5D0*(alf1+alf2)
1430 C For diagnostics only!!!
1443 dxj=dc_norm(1,nres+j)
1444 dyj=dc_norm(2,nres+j)
1445 dzj=dc_norm(3,nres+j)
1446 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1447 cd if (icall.eq.0) then
1453 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1455 C Calculate whole angle-dependent part of epsilon and contributions
1456 C to its derivatives
1457 fac=(rrij*sigsq)**expon2
1458 e1=fac*fac*aa(itypi,itypj)
1459 e2=fac*bb(itypi,itypj)
1460 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1461 eps2der=evdwij*eps3rt
1462 eps3der=evdwij*eps2rt
1463 evdwij=evdwij*eps2rt*eps3rt
1465 if (bb(itypi,itypj).gt.0) then
1466 evdw_p=evdw_p+evdwij
1468 evdw_m=evdw_m+evdwij
1474 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1475 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1476 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1477 cd & restyp(itypi),i,restyp(itypj),j,
1478 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1479 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1480 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1483 C Calculate gradient components.
1484 e1=e1*eps1*eps2rt**2*eps3rt**2
1485 fac=-expon*(e1+evdwij)
1488 C Calculate radial part of the gradient
1492 C Calculate the angular part of the gradient and sum add the contributions
1493 C to the appropriate components of the Cartesian gradient.
1495 if (bb(itypi,itypj).gt.0) then
1509 C-----------------------------------------------------------------------------
1510 subroutine egb(evdw,evdw_p,evdw_m)
1512 C This subroutine calculates the interaction energy of nonbonded side chains
1513 C assuming the Gay-Berne potential of interaction.
1515 implicit real*8 (a-h,o-z)
1516 include 'DIMENSIONS'
1517 include 'COMMON.GEO'
1518 include 'COMMON.VAR'
1519 include 'COMMON.LOCAL'
1520 include 'COMMON.CHAIN'
1521 include 'COMMON.DERIV'
1522 include 'COMMON.NAMES'
1523 include 'COMMON.INTERACT'
1524 include 'COMMON.IOUNITS'
1525 include 'COMMON.CALC'
1526 include 'COMMON.CONTROL'
1529 ccccc energy_dec=.false.
1530 c write(iout,*) 'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1535 c if (icall.eq.0) lprn=.false.
1537 do i=iatsc_s,iatsc_e
1543 dxi=dc_norm(1,nres+i)
1544 dyi=dc_norm(2,nres+i)
1545 dzi=dc_norm(3,nres+i)
1546 c dsci_inv=dsc_inv(itypi)
1547 dsci_inv=vbld_inv(i+nres)
1548 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1549 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1551 C Calculate SC interaction energy.
1553 do iint=1,nint_gr(i)
1554 do j=istart(i,iint),iend(i,iint)
1557 c dscj_inv=dsc_inv(itypj)
1558 dscj_inv=vbld_inv(j+nres)
1559 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1560 c & 1.0d0/vbld(j+nres)
1561 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1562 sig0ij=sigma(itypi,itypj)
1563 chi1=chi(itypi,itypj)
1564 chi2=chi(itypj,itypi)
1571 alf12=0.5D0*(alf1+alf2)
1572 C For diagnostics only!!!
1585 dxj=dc_norm(1,nres+j)
1586 dyj=dc_norm(2,nres+j)
1587 dzj=dc_norm(3,nres+j)
1588 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1589 c write (iout,*) "j",j," dc_norm",
1590 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1591 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1593 C Calculate angle-dependent terms of energy and contributions to their
1597 sig=sig0ij*dsqrt(sigsq)
1598 rij_shift=1.0D0/rij-sig+sig0ij
1599 c for diagnostics; uncomment
1600 c rij_shift=1.2*sig0ij
1601 C I hate to put IF's in the loops, but here don't have another choice!!!!
1602 if (rij_shift.le.0.0D0) then
1604 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1605 cd & restyp(itypi),i,restyp(itypj),j,
1606 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1610 c---------------------------------------------------------------
1611 rij_shift=1.0D0/rij_shift
1612 fac=rij_shift**expon
1613 e1=fac*fac*aa(itypi,itypj)
1614 e2=fac*bb(itypi,itypj)
1615 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1616 eps2der=evdwij*eps3rt
1617 eps3der=evdwij*eps2rt
1618 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1619 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1620 evdwij=evdwij*eps2rt*eps3rt
1622 if (bb(itypi,itypj).gt.0) then
1623 evdw_p=evdw_p+evdwij
1625 evdw_m=evdw_m+evdwij
1631 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1632 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1633 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1634 & restyp(itypi),i,restyp(itypj),j,
1635 & epsi,sigm,chi1,chi2,chip1,chip2,
1636 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1637 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1641 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1644 C Calculate gradient components.
1645 e1=e1*eps1*eps2rt**2*eps3rt**2
1646 fac=-expon*(e1+evdwij)*rij_shift
1650 C Calculate the radial part of the gradient
1654 C Calculate angular part of the gradient.
1656 if (bb(itypi,itypj).gt.0) then
1667 c write (iout,*) "Number of loop steps in EGB:",ind
1668 cccc energy_dec=.false.
1671 C-----------------------------------------------------------------------------
1672 subroutine egbv(evdw,evdw_p,evdw_m)
1674 C This subroutine calculates the interaction energy of nonbonded side chains
1675 C assuming the Gay-Berne-Vorobjev potential of interaction.
1677 implicit real*8 (a-h,o-z)
1678 include 'DIMENSIONS'
1679 include 'COMMON.GEO'
1680 include 'COMMON.VAR'
1681 include 'COMMON.LOCAL'
1682 include 'COMMON.CHAIN'
1683 include 'COMMON.DERIV'
1684 include 'COMMON.NAMES'
1685 include 'COMMON.INTERACT'
1686 include 'COMMON.IOUNITS'
1687 include 'COMMON.CALC'
1688 common /srutu/ icall
1691 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1694 c if (icall.eq.0) lprn=.true.
1696 do i=iatsc_s,iatsc_e
1702 dxi=dc_norm(1,nres+i)
1703 dyi=dc_norm(2,nres+i)
1704 dzi=dc_norm(3,nres+i)
1705 c dsci_inv=dsc_inv(itypi)
1706 dsci_inv=vbld_inv(i+nres)
1708 C Calculate SC interaction energy.
1710 do iint=1,nint_gr(i)
1711 do j=istart(i,iint),iend(i,iint)
1714 c dscj_inv=dsc_inv(itypj)
1715 dscj_inv=vbld_inv(j+nres)
1716 sig0ij=sigma(itypi,itypj)
1717 r0ij=r0(itypi,itypj)
1718 chi1=chi(itypi,itypj)
1719 chi2=chi(itypj,itypi)
1726 alf12=0.5D0*(alf1+alf2)
1727 C For diagnostics only!!!
1740 dxj=dc_norm(1,nres+j)
1741 dyj=dc_norm(2,nres+j)
1742 dzj=dc_norm(3,nres+j)
1743 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1745 C Calculate angle-dependent terms of energy and contributions to their
1749 sig=sig0ij*dsqrt(sigsq)
1750 rij_shift=1.0D0/rij-sig+r0ij
1751 C I hate to put IF's in the loops, but here don't have another choice!!!!
1752 if (rij_shift.le.0.0D0) then
1757 c---------------------------------------------------------------
1758 rij_shift=1.0D0/rij_shift
1759 fac=rij_shift**expon
1760 e1=fac*fac*aa(itypi,itypj)
1761 e2=fac*bb(itypi,itypj)
1762 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1763 eps2der=evdwij*eps3rt
1764 eps3der=evdwij*eps2rt
1765 fac_augm=rrij**expon
1766 e_augm=augm(itypi,itypj)*fac_augm
1767 evdwij=evdwij*eps2rt*eps3rt
1769 if (bb(itypi,itypj).gt.0) then
1770 evdw_p=evdw_p+evdwij+e_augm
1772 evdw_m=evdw_m+evdwij+e_augm
1775 evdw=evdw+evdwij+e_augm
1778 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1779 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1780 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1781 & restyp(itypi),i,restyp(itypj),j,
1782 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1783 & chi1,chi2,chip1,chip2,
1784 & eps1,eps2rt**2,eps3rt**2,
1785 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1788 C Calculate gradient components.
1789 e1=e1*eps1*eps2rt**2*eps3rt**2
1790 fac=-expon*(e1+evdwij)*rij_shift
1792 fac=rij*fac-2*expon*rrij*e_augm
1793 C Calculate the radial part of the gradient
1797 C Calculate angular part of the gradient.
1799 if (bb(itypi,itypj).gt.0) then
1811 C-----------------------------------------------------------------------------
1812 subroutine sc_angular
1813 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1814 C om12. Called by ebp, egb, and egbv.
1816 include 'COMMON.CALC'
1817 include 'COMMON.IOUNITS'
1821 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1822 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1823 om12=dxi*dxj+dyi*dyj+dzi*dzj
1825 C Calculate eps1(om12) and its derivative in om12
1826 faceps1=1.0D0-om12*chiom12
1827 faceps1_inv=1.0D0/faceps1
1828 eps1=dsqrt(faceps1_inv)
1829 C Following variable is eps1*deps1/dom12
1830 eps1_om12=faceps1_inv*chiom12
1835 c write (iout,*) "om12",om12," eps1",eps1
1836 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1841 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1842 sigsq=1.0D0-facsig*faceps1_inv
1843 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1844 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1845 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1851 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1852 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1854 C Calculate eps2 and its derivatives in om1, om2, and om12.
1857 chipom12=chip12*om12
1858 facp=1.0D0-om12*chipom12
1860 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1861 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1862 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1863 C Following variable is the square root of eps2
1864 eps2rt=1.0D0-facp1*facp_inv
1865 C Following three variables are the derivatives of the square root of eps
1866 C in om1, om2, and om12.
1867 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1868 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1869 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1870 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1871 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1872 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1873 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1874 c & " eps2rt_om12",eps2rt_om12
1875 C Calculate whole angle-dependent part of epsilon and contributions
1876 C to its derivatives
1880 C----------------------------------------------------------------------------
1881 subroutine sc_grad_T
1882 implicit real*8 (a-h,o-z)
1883 include 'DIMENSIONS'
1884 include 'COMMON.CHAIN'
1885 include 'COMMON.DERIV'
1886 include 'COMMON.CALC'
1887 include 'COMMON.IOUNITS'
1888 double precision dcosom1(3),dcosom2(3)
1889 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1890 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1891 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1892 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1896 c eom12=evdwij*eps1_om12
1898 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1899 c & " sigder",sigder
1900 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1901 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1903 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1904 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1907 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1909 c write (iout,*) "gg",(gg(k),k=1,3)
1911 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1912 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1913 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1914 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1915 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1916 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1917 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1918 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1919 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1920 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1923 C Calculate the components of the gradient in DC and X
1927 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1931 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1932 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1937 C----------------------------------------------------------------------------
1939 implicit real*8 (a-h,o-z)
1940 include 'DIMENSIONS'
1941 include 'COMMON.CHAIN'
1942 include 'COMMON.DERIV'
1943 include 'COMMON.CALC'
1944 include 'COMMON.IOUNITS'
1945 double precision dcosom1(3),dcosom2(3)
1946 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1947 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1948 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1949 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1953 c eom12=evdwij*eps1_om12
1955 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1956 c & " sigder",sigder
1957 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1958 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1960 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1961 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1964 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1966 c write (iout,*) "gg",(gg(k),k=1,3)
1968 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1969 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1970 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1971 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1972 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1973 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1974 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1975 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1977 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1980 C Calculate the components of the gradient in DC and X
1984 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1988 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1989 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1993 C-----------------------------------------------------------------------
1994 subroutine e_softsphere(evdw)
1996 C This subroutine calculates the interaction energy of nonbonded side chains
1997 C assuming the LJ potential of interaction.
1999 implicit real*8 (a-h,o-z)
2000 include 'DIMENSIONS'
2001 parameter (accur=1.0d-10)
2002 include 'COMMON.GEO'
2003 include 'COMMON.VAR'
2004 include 'COMMON.LOCAL'
2005 include 'COMMON.CHAIN'
2006 include 'COMMON.DERIV'
2007 include 'COMMON.INTERACT'
2008 include 'COMMON.TORSION'
2009 include 'COMMON.SBRIDGE'
2010 include 'COMMON.NAMES'
2011 include 'COMMON.IOUNITS'
2012 include 'COMMON.CONTACTS'
2014 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2016 do i=iatsc_s,iatsc_e
2023 C Calculate SC interaction energy.
2025 do iint=1,nint_gr(i)
2026 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2027 cd & 'iend=',iend(i,iint)
2028 do j=istart(i,iint),iend(i,iint)
2033 rij=xj*xj+yj*yj+zj*zj
2034 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2035 r0ij=r0(itypi,itypj)
2037 c print *,i,j,r0ij,dsqrt(rij)
2038 if (rij.lt.r0ijsq) then
2039 evdwij=0.25d0*(rij-r0ijsq)**2
2047 C Calculate the components of the gradient in DC and X
2053 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2054 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2055 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2056 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2060 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2068 C--------------------------------------------------------------------------
2069 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2072 C Soft-sphere potential of p-p interaction
2074 implicit real*8 (a-h,o-z)
2075 include 'DIMENSIONS'
2076 include 'COMMON.CONTROL'
2077 include 'COMMON.IOUNITS'
2078 include 'COMMON.GEO'
2079 include 'COMMON.VAR'
2080 include 'COMMON.LOCAL'
2081 include 'COMMON.CHAIN'
2082 include 'COMMON.DERIV'
2083 include 'COMMON.INTERACT'
2084 include 'COMMON.CONTACTS'
2085 include 'COMMON.TORSION'
2086 include 'COMMON.VECTORS'
2087 include 'COMMON.FFIELD'
2089 cd write(iout,*) 'In EELEC_soft_sphere'
2096 do i=iatel_s,iatel_e
2100 xmedi=c(1,i)+0.5d0*dxi
2101 ymedi=c(2,i)+0.5d0*dyi
2102 zmedi=c(3,i)+0.5d0*dzi
2104 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2105 do j=ielstart(i),ielend(i)
2109 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2110 r0ij=rpp(iteli,itelj)
2115 xj=c(1,j)+0.5D0*dxj-xmedi
2116 yj=c(2,j)+0.5D0*dyj-ymedi
2117 zj=c(3,j)+0.5D0*dzj-zmedi
2118 rij=xj*xj+yj*yj+zj*zj
2119 if (rij.lt.r0ijsq) then
2120 evdw1ij=0.25d0*(rij-r0ijsq)**2
2128 C Calculate contributions to the Cartesian gradient.
2134 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2135 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2138 * Loop over residues i+1 thru j-1.
2142 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2147 cgrad do i=nnt,nct-1
2149 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2151 cgrad do j=i+1,nct-1
2153 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2159 c------------------------------------------------------------------------------
2160 subroutine vec_and_deriv
2161 implicit real*8 (a-h,o-z)
2162 include 'DIMENSIONS'
2166 include 'COMMON.IOUNITS'
2167 include 'COMMON.GEO'
2168 include 'COMMON.VAR'
2169 include 'COMMON.LOCAL'
2170 include 'COMMON.CHAIN'
2171 include 'COMMON.VECTORS'
2172 include 'COMMON.SETUP'
2173 include 'COMMON.TIME1'
2174 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2175 C Compute the local reference systems. For reference system (i), the
2176 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2177 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2179 do i=ivec_start,ivec_end
2183 if (i.eq.nres-1) then
2184 C Case of the last full residue
2185 C Compute the Z-axis
2186 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2187 costh=dcos(pi-theta(nres))
2188 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2192 C Compute the derivatives of uz
2194 uzder(2,1,1)=-dc_norm(3,i-1)
2195 uzder(3,1,1)= dc_norm(2,i-1)
2196 uzder(1,2,1)= dc_norm(3,i-1)
2198 uzder(3,2,1)=-dc_norm(1,i-1)
2199 uzder(1,3,1)=-dc_norm(2,i-1)
2200 uzder(2,3,1)= dc_norm(1,i-1)
2203 uzder(2,1,2)= dc_norm(3,i)
2204 uzder(3,1,2)=-dc_norm(2,i)
2205 uzder(1,2,2)=-dc_norm(3,i)
2207 uzder(3,2,2)= dc_norm(1,i)
2208 uzder(1,3,2)= dc_norm(2,i)
2209 uzder(2,3,2)=-dc_norm(1,i)
2211 C Compute the Y-axis
2214 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2216 C Compute the derivatives of uy
2219 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2220 & -dc_norm(k,i)*dc_norm(j,i-1)
2221 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2223 uyder(j,j,1)=uyder(j,j,1)-costh
2224 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2229 uygrad(l,k,j,i)=uyder(l,k,j)
2230 uzgrad(l,k,j,i)=uzder(l,k,j)
2234 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2235 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2236 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2237 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2240 C Compute the Z-axis
2241 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2242 costh=dcos(pi-theta(i+2))
2243 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2247 C Compute the derivatives of uz
2249 uzder(2,1,1)=-dc_norm(3,i+1)
2250 uzder(3,1,1)= dc_norm(2,i+1)
2251 uzder(1,2,1)= dc_norm(3,i+1)
2253 uzder(3,2,1)=-dc_norm(1,i+1)
2254 uzder(1,3,1)=-dc_norm(2,i+1)
2255 uzder(2,3,1)= dc_norm(1,i+1)
2258 uzder(2,1,2)= dc_norm(3,i)
2259 uzder(3,1,2)=-dc_norm(2,i)
2260 uzder(1,2,2)=-dc_norm(3,i)
2262 uzder(3,2,2)= dc_norm(1,i)
2263 uzder(1,3,2)= dc_norm(2,i)
2264 uzder(2,3,2)=-dc_norm(1,i)
2266 C Compute the Y-axis
2269 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2271 C Compute the derivatives of uy
2274 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2275 & -dc_norm(k,i)*dc_norm(j,i+1)
2276 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2278 uyder(j,j,1)=uyder(j,j,1)-costh
2279 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2284 uygrad(l,k,j,i)=uyder(l,k,j)
2285 uzgrad(l,k,j,i)=uzder(l,k,j)
2289 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2290 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2291 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2292 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2296 vbld_inv_temp(1)=vbld_inv(i+1)
2297 if (i.lt.nres-1) then
2298 vbld_inv_temp(2)=vbld_inv(i+2)
2300 vbld_inv_temp(2)=vbld_inv(i)
2305 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2306 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2311 #if defined(PARVEC) && defined(MPI)
2312 if (nfgtasks1.gt.1) then
2314 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2315 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2316 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2317 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2318 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2320 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2321 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2323 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2324 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2325 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2326 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2327 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2328 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2329 time_gather=time_gather+MPI_Wtime()-time00
2331 c if (fg_rank.eq.0) then
2332 c write (iout,*) "Arrays UY and UZ"
2334 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2341 C-----------------------------------------------------------------------------
2342 subroutine check_vecgrad
2343 implicit real*8 (a-h,o-z)
2344 include 'DIMENSIONS'
2345 include 'COMMON.IOUNITS'
2346 include 'COMMON.GEO'
2347 include 'COMMON.VAR'
2348 include 'COMMON.LOCAL'
2349 include 'COMMON.CHAIN'
2350 include 'COMMON.VECTORS'
2351 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2352 dimension uyt(3,maxres),uzt(3,maxres)
2353 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2354 double precision delta /1.0d-7/
2357 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2358 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2359 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2360 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2361 cd & (dc_norm(if90,i),if90=1,3)
2362 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2363 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2364 cd write(iout,'(a)')
2370 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2371 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2384 cd write (iout,*) 'i=',i
2386 erij(k)=dc_norm(k,i)
2390 dc_norm(k,i)=erij(k)
2392 dc_norm(j,i)=dc_norm(j,i)+delta
2393 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2395 c dc_norm(k,i)=dc_norm(k,i)/fac
2397 c write (iout,*) (dc_norm(k,i),k=1,3)
2398 c write (iout,*) (erij(k),k=1,3)
2401 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2402 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2403 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2404 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2406 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2407 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2408 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2411 dc_norm(k,i)=erij(k)
2414 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2415 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2416 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2417 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2418 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2419 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2420 cd write (iout,'(a)')
2425 C--------------------------------------------------------------------------
2426 subroutine set_matrices
2427 implicit real*8 (a-h,o-z)
2428 include 'DIMENSIONS'
2431 include "COMMON.SETUP"
2433 integer status(MPI_STATUS_SIZE)
2435 include 'COMMON.IOUNITS'
2436 include 'COMMON.GEO'
2437 include 'COMMON.VAR'
2438 include 'COMMON.LOCAL'
2439 include 'COMMON.CHAIN'
2440 include 'COMMON.DERIV'
2441 include 'COMMON.INTERACT'
2442 include 'COMMON.CONTACTS'
2443 include 'COMMON.TORSION'
2444 include 'COMMON.VECTORS'
2445 include 'COMMON.FFIELD'
2446 double precision auxvec(2),auxmat(2,2)
2448 C Compute the virtual-bond-torsional-angle dependent quantities needed
2449 C to calculate the el-loc multibody terms of various order.
2452 do i=ivec_start+2,ivec_end+2
2456 if (i .lt. nres+1) then
2493 if (i .gt. 3 .and. i .lt. nres+1) then
2494 obrot_der(1,i-2)=-sin1
2495 obrot_der(2,i-2)= cos1
2496 Ugder(1,1,i-2)= sin1
2497 Ugder(1,2,i-2)=-cos1
2498 Ugder(2,1,i-2)=-cos1
2499 Ugder(2,2,i-2)=-sin1
2502 obrot2_der(1,i-2)=-dwasin2
2503 obrot2_der(2,i-2)= dwacos2
2504 Ug2der(1,1,i-2)= dwasin2
2505 Ug2der(1,2,i-2)=-dwacos2
2506 Ug2der(2,1,i-2)=-dwacos2
2507 Ug2der(2,2,i-2)=-dwasin2
2509 obrot_der(1,i-2)=0.0d0
2510 obrot_der(2,i-2)=0.0d0
2511 Ugder(1,1,i-2)=0.0d0
2512 Ugder(1,2,i-2)=0.0d0
2513 Ugder(2,1,i-2)=0.0d0
2514 Ugder(2,2,i-2)=0.0d0
2515 obrot2_der(1,i-2)=0.0d0
2516 obrot2_der(2,i-2)=0.0d0
2517 Ug2der(1,1,i-2)=0.0d0
2518 Ug2der(1,2,i-2)=0.0d0
2519 Ug2der(2,1,i-2)=0.0d0
2520 Ug2der(2,2,i-2)=0.0d0
2522 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2523 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2524 iti = itortyp(itype(i-2))
2528 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2529 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2530 iti1 = itortyp(itype(i-1))
2534 cd write (iout,*) '*******i',i,' iti1',iti
2535 cd write (iout,*) 'b1',b1(:,iti)
2536 cd write (iout,*) 'b2',b2(:,iti)
2537 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2538 c if (i .gt. iatel_s+2) then
2539 if (i .gt. nnt+2) then
2540 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2541 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2542 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2544 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2545 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2546 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2547 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2548 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2559 DtUg2(l,k,i-2)=0.0d0
2563 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2564 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2566 muder(k,i-2)=Ub2der(k,i-2)
2568 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2569 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2570 iti1 = itortyp(itype(i-1))
2575 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2577 cd write (iout,*) 'mu ',mu(:,i-2)
2578 cd write (iout,*) 'mu1',mu1(:,i-2)
2579 cd write (iout,*) 'mu2',mu2(:,i-2)
2580 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2582 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2583 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2584 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2585 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2586 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2587 C Vectors and matrices dependent on a single virtual-bond dihedral.
2588 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2589 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2590 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2591 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2592 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2593 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2594 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2595 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2596 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2599 C Matrices dependent on two consecutive virtual-bond dihedrals.
2600 C The order of matrices is from left to right.
2601 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2603 c do i=max0(ivec_start,2),ivec_end
2605 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2606 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2607 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2608 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2609 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2610 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2611 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2612 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2615 #if defined(MPI) && defined(PARMAT)
2617 c if (fg_rank.eq.0) then
2618 write (iout,*) "Arrays UG and UGDER before GATHER"
2620 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2621 & ((ug(l,k,i),l=1,2),k=1,2),
2622 & ((ugder(l,k,i),l=1,2),k=1,2)
2624 write (iout,*) "Arrays UG2 and UG2DER"
2626 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2627 & ((ug2(l,k,i),l=1,2),k=1,2),
2628 & ((ug2der(l,k,i),l=1,2),k=1,2)
2630 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2632 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2633 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2634 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2636 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2638 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2639 & costab(i),sintab(i),costab2(i),sintab2(i)
2641 write (iout,*) "Array MUDER"
2643 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2647 if (nfgtasks.gt.1) then
2649 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2650 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2651 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2653 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2654 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2656 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2657 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2659 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2660 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2662 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2663 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2665 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2666 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2668 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2669 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2671 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2672 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2673 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2674 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2675 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2676 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2677 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2678 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2679 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2680 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2681 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2682 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2683 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2685 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2686 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2688 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2689 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2691 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2692 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2694 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2695 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2700 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2701 & ivec_count(fg_rank1),
2702 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2704 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2705 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2707 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2708 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2710 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2713 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2714 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2716 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2717 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2719 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2726 & ivec_count(fg_rank1),
2727 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2729 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2730 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2732 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2733 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2735 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2736 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2738 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2739 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2741 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2742 & ivec_count(fg_rank1),
2743 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2745 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2746 & ivec_count(fg_rank1),
2747 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2749 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2750 & ivec_count(fg_rank1),
2751 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2752 & MPI_MAT2,FG_COMM1,IERR)
2753 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2754 & ivec_count(fg_rank1),
2755 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2756 & MPI_MAT2,FG_COMM1,IERR)
2759 c Passes matrix info through the ring
2762 if (irecv.lt.0) irecv=nfgtasks1-1
2765 if (inext.ge.nfgtasks1) inext=0
2767 c write (iout,*) "isend",isend," irecv",irecv
2769 lensend=lentyp(isend)
2770 lenrecv=lentyp(irecv)
2771 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2772 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2773 c & MPI_ROTAT1(lensend),inext,2200+isend,
2774 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2775 c & iprev,2200+irecv,FG_COMM,status,IERR)
2776 c write (iout,*) "Gather ROTAT1"
2778 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2779 c & MPI_ROTAT2(lensend),inext,3300+isend,
2780 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2781 c & iprev,3300+irecv,FG_COMM,status,IERR)
2782 c write (iout,*) "Gather ROTAT2"
2784 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2785 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2786 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2787 & iprev,4400+irecv,FG_COMM,status,IERR)
2788 c write (iout,*) "Gather ROTAT_OLD"
2790 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2791 & MPI_PRECOMP11(lensend),inext,5500+isend,
2792 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2793 & iprev,5500+irecv,FG_COMM,status,IERR)
2794 c write (iout,*) "Gather PRECOMP11"
2796 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2797 & MPI_PRECOMP12(lensend),inext,6600+isend,
2798 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2799 & iprev,6600+irecv,FG_COMM,status,IERR)
2800 c write (iout,*) "Gather PRECOMP12"
2802 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2804 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2805 & MPI_ROTAT2(lensend),inext,7700+isend,
2806 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2807 & iprev,7700+irecv,FG_COMM,status,IERR)
2808 c write (iout,*) "Gather PRECOMP21"
2810 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2811 & MPI_PRECOMP22(lensend),inext,8800+isend,
2812 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2813 & iprev,8800+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather PRECOMP22"
2816 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2817 & MPI_PRECOMP23(lensend),inext,9900+isend,
2818 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2819 & MPI_PRECOMP23(lenrecv),
2820 & iprev,9900+irecv,FG_COMM,status,IERR)
2821 c write (iout,*) "Gather PRECOMP23"
2826 if (irecv.lt.0) irecv=nfgtasks1-1
2829 time_gather=time_gather+MPI_Wtime()-time00
2832 c if (fg_rank.eq.0) then
2833 write (iout,*) "Arrays UG and UGDER"
2835 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2836 & ((ug(l,k,i),l=1,2),k=1,2),
2837 & ((ugder(l,k,i),l=1,2),k=1,2)
2839 write (iout,*) "Arrays UG2 and UG2DER"
2841 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2842 & ((ug2(l,k,i),l=1,2),k=1,2),
2843 & ((ug2der(l,k,i),l=1,2),k=1,2)
2845 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2847 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2848 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2849 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2851 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2853 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2854 & costab(i),sintab(i),costab2(i),sintab2(i)
2856 write (iout,*) "Array MUDER"
2858 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2864 cd iti = itortyp(itype(i))
2867 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2868 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2873 C--------------------------------------------------------------------------
2874 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2876 C This subroutine calculates the average interaction energy and its gradient
2877 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2878 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2879 C The potential depends both on the distance of peptide-group centers and on
2880 C the orientation of the CA-CA virtual bonds.
2882 implicit real*8 (a-h,o-z)
2886 include 'DIMENSIONS'
2887 include 'COMMON.CONTROL'
2888 include 'COMMON.SETUP'
2889 include 'COMMON.IOUNITS'
2890 include 'COMMON.GEO'
2891 include 'COMMON.VAR'
2892 include 'COMMON.LOCAL'
2893 include 'COMMON.CHAIN'
2894 include 'COMMON.DERIV'
2895 include 'COMMON.INTERACT'
2896 include 'COMMON.CONTACTS'
2897 include 'COMMON.TORSION'
2898 include 'COMMON.VECTORS'
2899 include 'COMMON.FFIELD'
2900 include 'COMMON.TIME1'
2901 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2902 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2903 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2904 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2905 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2906 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2908 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2910 double precision scal_el /1.0d0/
2912 double precision scal_el /0.5d0/
2915 C 13-go grudnia roku pamietnego...
2916 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2917 & 0.0d0,1.0d0,0.0d0,
2918 & 0.0d0,0.0d0,1.0d0/
2919 cd write(iout,*) 'In EELEC'
2921 cd write(iout,*) 'Type',i
2922 cd write(iout,*) 'B1',B1(:,i)
2923 cd write(iout,*) 'B2',B2(:,i)
2924 cd write(iout,*) 'CC',CC(:,:,i)
2925 cd write(iout,*) 'DD',DD(:,:,i)
2926 cd write(iout,*) 'EE',EE(:,:,i)
2928 cd call check_vecgrad
2930 if (icheckgrad.eq.1) then
2932 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2934 dc_norm(k,i)=dc(k,i)*fac
2936 c write (iout,*) 'i',i,' fac',fac
2939 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2940 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2941 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2942 c call vec_and_deriv
2948 time_mat=time_mat+MPI_Wtime()-time01
2952 cd write (iout,*) 'i=',i
2954 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2957 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2958 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2971 cd print '(a)','Enter EELEC'
2972 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2974 gel_loc_loc(i)=0.0d0
2979 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2981 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2983 do i=iturn3_start,iturn3_end
2987 dx_normi=dc_norm(1,i)
2988 dy_normi=dc_norm(2,i)
2989 dz_normi=dc_norm(3,i)
2990 xmedi=c(1,i)+0.5d0*dxi
2991 ymedi=c(2,i)+0.5d0*dyi
2992 zmedi=c(3,i)+0.5d0*dzi
2994 call eelecij(i,i+2,ees,evdw1,eel_loc)
2995 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2996 num_cont_hb(i)=num_conti
2998 do i=iturn4_start,iturn4_end
3002 dx_normi=dc_norm(1,i)
3003 dy_normi=dc_norm(2,i)
3004 dz_normi=dc_norm(3,i)
3005 xmedi=c(1,i)+0.5d0*dxi
3006 ymedi=c(2,i)+0.5d0*dyi
3007 zmedi=c(3,i)+0.5d0*dzi
3008 num_conti=num_cont_hb(i)
3009 call eelecij(i,i+3,ees,evdw1,eel_loc)
3010 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3011 num_cont_hb(i)=num_conti
3014 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3016 do i=iatel_s,iatel_e
3020 dx_normi=dc_norm(1,i)
3021 dy_normi=dc_norm(2,i)
3022 dz_normi=dc_norm(3,i)
3023 xmedi=c(1,i)+0.5d0*dxi
3024 ymedi=c(2,i)+0.5d0*dyi
3025 zmedi=c(3,i)+0.5d0*dzi
3026 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3027 num_conti=num_cont_hb(i)
3028 do j=ielstart(i),ielend(i)
3029 call eelecij(i,j,ees,evdw1,eel_loc)
3031 num_cont_hb(i)=num_conti
3033 c write (iout,*) "Number of loop steps in EELEC:",ind
3035 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3036 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3038 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3039 ccc eel_loc=eel_loc+eello_turn3
3040 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3043 C-------------------------------------------------------------------------------
3044 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3045 implicit real*8 (a-h,o-z)
3046 include 'DIMENSIONS'
3050 include 'COMMON.CONTROL'
3051 include 'COMMON.IOUNITS'
3052 include 'COMMON.GEO'
3053 include 'COMMON.VAR'
3054 include 'COMMON.LOCAL'
3055 include 'COMMON.CHAIN'
3056 include 'COMMON.DERIV'
3057 include 'COMMON.INTERACT'
3058 include 'COMMON.CONTACTS'
3059 include 'COMMON.TORSION'
3060 include 'COMMON.VECTORS'
3061 include 'COMMON.FFIELD'
3062 include 'COMMON.TIME1'
3063 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3064 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3065 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3066 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3067 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3068 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3070 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3072 double precision scal_el /1.0d0/
3074 double precision scal_el /0.5d0/
3077 C 13-go grudnia roku pamietnego...
3078 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3079 & 0.0d0,1.0d0,0.0d0,
3080 & 0.0d0,0.0d0,1.0d0/
3081 c time00=MPI_Wtime()
3082 cd write (iout,*) "eelecij",i,j
3086 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3087 aaa=app(iteli,itelj)
3088 bbb=bpp(iteli,itelj)
3089 ael6i=ael6(iteli,itelj)
3090 ael3i=ael3(iteli,itelj)
3094 dx_normj=dc_norm(1,j)
3095 dy_normj=dc_norm(2,j)
3096 dz_normj=dc_norm(3,j)
3097 xj=c(1,j)+0.5D0*dxj-xmedi
3098 yj=c(2,j)+0.5D0*dyj-ymedi
3099 zj=c(3,j)+0.5D0*dzj-zmedi
3100 rij=xj*xj+yj*yj+zj*zj
3106 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3107 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3108 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3109 fac=cosa-3.0D0*cosb*cosg
3111 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3112 if (j.eq.i+2) ev1=scal_el*ev1
3117 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3120 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3121 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3124 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3125 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3126 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3127 cd & xmedi,ymedi,zmedi,xj,yj,zj
3129 if (energy_dec) then
3130 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3131 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3135 C Calculate contributions to the Cartesian gradient.
3138 facvdw=-6*rrmij*(ev1+evdwij)
3139 facel=-3*rrmij*(el1+eesij)
3145 * Radial derivatives. First process both termini of the fragment (i,j)
3151 c ghalf=0.5D0*ggg(k)
3152 c gelc(k,i)=gelc(k,i)+ghalf
3153 c gelc(k,j)=gelc(k,j)+ghalf
3155 c 9/28/08 AL Gradient compotents will be summed only at the end
3157 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3158 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3161 * Loop over residues i+1 thru j-1.
3165 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3172 c ghalf=0.5D0*ggg(k)
3173 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3174 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3176 c 9/28/08 AL Gradient compotents will be summed only at the end
3178 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3179 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3182 * Loop over residues i+1 thru j-1.
3186 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3193 fac=-3*rrmij*(facvdw+facvdw+facel)
3198 * Radial derivatives. First process both termini of the fragment (i,j)
3204 c ghalf=0.5D0*ggg(k)
3205 c gelc(k,i)=gelc(k,i)+ghalf
3206 c gelc(k,j)=gelc(k,j)+ghalf
3208 c 9/28/08 AL Gradient compotents will be summed only at the end
3210 gelc_long(k,j)=gelc(k,j)+ggg(k)
3211 gelc_long(k,i)=gelc(k,i)-ggg(k)
3214 * Loop over residues i+1 thru j-1.
3218 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3221 c 9/28/08 AL Gradient compotents will be summed only at the end
3226 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3227 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3233 ecosa=2.0D0*fac3*fac1+fac4
3236 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3237 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3239 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3240 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3242 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3243 cd & (dcosg(k),k=1,3)
3245 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3248 c ghalf=0.5D0*ggg(k)
3249 c gelc(k,i)=gelc(k,i)+ghalf
3250 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3251 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3252 c gelc(k,j)=gelc(k,j)+ghalf
3253 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3254 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3258 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3263 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3264 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3266 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3267 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3268 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3269 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3271 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3272 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3273 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3275 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3276 C energy of a peptide unit is assumed in the form of a second-order
3277 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3278 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3279 C are computed for EVERY pair of non-contiguous peptide groups.
3281 if (j.lt.nres-1) then
3292 muij(kkk)=mu(k,i)*mu(l,j)
3295 cd write (iout,*) 'EELEC: i',i,' j',j
3296 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3297 cd write(iout,*) 'muij',muij
3298 ury=scalar(uy(1,i),erij)
3299 urz=scalar(uz(1,i),erij)
3300 vry=scalar(uy(1,j),erij)
3301 vrz=scalar(uz(1,j),erij)
3302 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3303 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3304 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3305 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3306 fac=dsqrt(-ael6i)*r3ij
3311 cd write (iout,'(4i5,4f10.5)')
3312 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3313 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3314 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3315 cd & uy(:,j),uz(:,j)
3316 cd write (iout,'(4f10.5)')
3317 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3318 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3319 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3320 cd write (iout,'(9f10.5/)')
3321 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3322 C Derivatives of the elements of A in virtual-bond vectors
3323 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3325 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3326 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3327 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3328 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3329 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3330 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3331 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3332 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3333 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3334 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3335 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3336 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3338 C Compute radial contributions to the gradient
3356 C Add the contributions coming from er
3359 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3360 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3361 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3362 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3365 C Derivatives in DC(i)
3366 cgrad ghalf1=0.5d0*agg(k,1)
3367 cgrad ghalf2=0.5d0*agg(k,2)
3368 cgrad ghalf3=0.5d0*agg(k,3)
3369 cgrad ghalf4=0.5d0*agg(k,4)
3370 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3371 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3372 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3373 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3374 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3375 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3376 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3377 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3378 C Derivatives in DC(i+1)
3379 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3380 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3381 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3382 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3383 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3384 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3385 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3386 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3387 C Derivatives in DC(j)
3388 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3389 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3390 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3391 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3392 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3393 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3394 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3395 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3396 C Derivatives in DC(j+1) or DC(nres-1)
3397 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3398 & -3.0d0*vryg(k,3)*ury)
3399 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3400 & -3.0d0*vrzg(k,3)*ury)
3401 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3402 & -3.0d0*vryg(k,3)*urz)
3403 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3404 & -3.0d0*vrzg(k,3)*urz)
3405 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3407 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3420 aggi(k,l)=-aggi(k,l)
3421 aggi1(k,l)=-aggi1(k,l)
3422 aggj(k,l)=-aggj(k,l)
3423 aggj1(k,l)=-aggj1(k,l)
3426 if (j.lt.nres-1) then
3432 aggi(k,l)=-aggi(k,l)
3433 aggi1(k,l)=-aggi1(k,l)
3434 aggj(k,l)=-aggj(k,l)
3435 aggj1(k,l)=-aggj1(k,l)
3446 aggi(k,l)=-aggi(k,l)
3447 aggi1(k,l)=-aggi1(k,l)
3448 aggj(k,l)=-aggj(k,l)
3449 aggj1(k,l)=-aggj1(k,l)
3454 IF (wel_loc.gt.0.0d0) THEN
3455 C Contribution to the local-electrostatic energy coming from the i-j pair
3456 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3458 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3460 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3461 & 'eelloc',i,j,eel_loc_ij
3463 eel_loc=eel_loc+eel_loc_ij
3464 C Partial derivatives in virtual-bond dihedral angles gamma
3466 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3467 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3468 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3469 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3470 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3471 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3472 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3474 ggg(l)=agg(l,1)*muij(1)+
3475 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3476 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3477 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3478 cgrad ghalf=0.5d0*ggg(l)
3479 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3480 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3484 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3487 C Remaining derivatives of eello
3489 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3490 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3491 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3492 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3493 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3494 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3495 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3496 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3499 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3500 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3501 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3502 & .and. num_conti.le.maxconts) then
3503 c write (iout,*) i,j," entered corr"
3505 C Calculate the contact function. The ith column of the array JCONT will
3506 C contain the numbers of atoms that make contacts with the atom I (of numbers
3507 C greater than I). The arrays FACONT and GACONT will contain the values of
3508 C the contact function and its derivative.
3509 c r0ij=1.02D0*rpp(iteli,itelj)
3510 c r0ij=1.11D0*rpp(iteli,itelj)
3511 r0ij=2.20D0*rpp(iteli,itelj)
3512 c r0ij=1.55D0*rpp(iteli,itelj)
3513 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3514 if (fcont.gt.0.0D0) then
3515 num_conti=num_conti+1
3516 if (num_conti.gt.maxconts) then
3517 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3518 & ' will skip next contacts for this conf.'
3520 jcont_hb(num_conti,i)=j
3521 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3522 cd & " jcont_hb",jcont_hb(num_conti,i)
3523 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3524 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3525 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3527 d_cont(num_conti,i)=rij
3528 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3529 C --- Electrostatic-interaction matrix ---
3530 a_chuj(1,1,num_conti,i)=a22
3531 a_chuj(1,2,num_conti,i)=a23
3532 a_chuj(2,1,num_conti,i)=a32
3533 a_chuj(2,2,num_conti,i)=a33
3534 C --- Gradient of rij
3536 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3543 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3544 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3545 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3546 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3547 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3552 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3553 C Calculate contact energies
3555 wij=cosa-3.0D0*cosb*cosg
3558 c fac3=dsqrt(-ael6i)/r0ij**3
3559 fac3=dsqrt(-ael6i)*r3ij
3560 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3561 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3562 if (ees0tmp.gt.0) then
3563 ees0pij=dsqrt(ees0tmp)
3567 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3568 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3569 if (ees0tmp.gt.0) then
3570 ees0mij=dsqrt(ees0tmp)
3575 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3576 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3577 C Diagnostics. Comment out or remove after debugging!
3578 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3579 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3580 c ees0m(num_conti,i)=0.0D0
3582 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3583 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3584 C Angular derivatives of the contact function
3585 ees0pij1=fac3/ees0pij
3586 ees0mij1=fac3/ees0mij
3587 fac3p=-3.0D0*fac3*rrmij
3588 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3589 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3591 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3592 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3593 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3594 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3595 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3596 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3597 ecosap=ecosa1+ecosa2
3598 ecosbp=ecosb1+ecosb2
3599 ecosgp=ecosg1+ecosg2
3600 ecosam=ecosa1-ecosa2
3601 ecosbm=ecosb1-ecosb2
3602 ecosgm=ecosg1-ecosg2
3611 facont_hb(num_conti,i)=fcont
3612 fprimcont=fprimcont/rij
3613 cd facont_hb(num_conti,i)=1.0D0
3614 C Following line is for diagnostics.
3617 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3618 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3621 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3622 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3624 gggp(1)=gggp(1)+ees0pijp*xj
3625 gggp(2)=gggp(2)+ees0pijp*yj
3626 gggp(3)=gggp(3)+ees0pijp*zj
3627 gggm(1)=gggm(1)+ees0mijp*xj
3628 gggm(2)=gggm(2)+ees0mijp*yj
3629 gggm(3)=gggm(3)+ees0mijp*zj
3630 C Derivatives due to the contact function
3631 gacont_hbr(1,num_conti,i)=fprimcont*xj
3632 gacont_hbr(2,num_conti,i)=fprimcont*yj
3633 gacont_hbr(3,num_conti,i)=fprimcont*zj
3636 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3637 c following the change of gradient-summation algorithm.
3639 cgrad ghalfp=0.5D0*gggp(k)
3640 cgrad ghalfm=0.5D0*gggm(k)
3641 gacontp_hb1(k,num_conti,i)=!ghalfp
3642 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3643 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3644 gacontp_hb2(k,num_conti,i)=!ghalfp
3645 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3646 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3647 gacontp_hb3(k,num_conti,i)=gggp(k)
3648 gacontm_hb1(k,num_conti,i)=!ghalfm
3649 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3650 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3651 gacontm_hb2(k,num_conti,i)=!ghalfm
3652 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3653 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3654 gacontm_hb3(k,num_conti,i)=gggm(k)
3656 C Diagnostics. Comment out or remove after debugging!
3658 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3659 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3660 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3661 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3662 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3663 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3666 endif ! num_conti.le.maxconts
3669 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3672 ghalf=0.5d0*agg(l,k)
3673 aggi(l,k)=aggi(l,k)+ghalf
3674 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3675 aggj(l,k)=aggj(l,k)+ghalf
3678 if (j.eq.nres-1 .and. i.lt.j-2) then
3681 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3686 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3689 C-----------------------------------------------------------------------------
3690 subroutine eturn3(i,eello_turn3)
3691 C Third- and fourth-order contributions from turns
3692 implicit real*8 (a-h,o-z)
3693 include 'DIMENSIONS'
3694 include 'COMMON.IOUNITS'
3695 include 'COMMON.GEO'
3696 include 'COMMON.VAR'
3697 include 'COMMON.LOCAL'
3698 include 'COMMON.CHAIN'
3699 include 'COMMON.DERIV'
3700 include 'COMMON.INTERACT'
3701 include 'COMMON.CONTACTS'
3702 include 'COMMON.TORSION'
3703 include 'COMMON.VECTORS'
3704 include 'COMMON.FFIELD'
3705 include 'COMMON.CONTROL'
3707 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3708 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3709 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3710 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3711 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3712 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3713 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3716 c write (iout,*) "eturn3",i,j,j1,j2
3721 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3723 C Third-order contributions
3730 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3731 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3732 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3733 call transpose2(auxmat(1,1),auxmat1(1,1))
3734 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3735 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3736 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3737 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3738 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3739 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3740 cd & ' eello_turn3_num',4*eello_turn3_num
3741 C Derivatives in gamma(i)
3742 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3743 call transpose2(auxmat2(1,1),auxmat3(1,1))
3744 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3745 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3746 C Derivatives in gamma(i+1)
3747 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3748 call transpose2(auxmat2(1,1),auxmat3(1,1))
3749 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3750 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3751 & +0.5d0*(pizda(1,1)+pizda(2,2))
3752 C Cartesian derivatives
3754 c ghalf1=0.5d0*agg(l,1)
3755 c ghalf2=0.5d0*agg(l,2)
3756 c ghalf3=0.5d0*agg(l,3)
3757 c ghalf4=0.5d0*agg(l,4)
3758 a_temp(1,1)=aggi(l,1)!+ghalf1
3759 a_temp(1,2)=aggi(l,2)!+ghalf2
3760 a_temp(2,1)=aggi(l,3)!+ghalf3
3761 a_temp(2,2)=aggi(l,4)!+ghalf4
3762 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3763 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3764 & +0.5d0*(pizda(1,1)+pizda(2,2))
3765 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3766 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3767 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3768 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3769 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3770 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3771 & +0.5d0*(pizda(1,1)+pizda(2,2))
3772 a_temp(1,1)=aggj(l,1)!+ghalf1
3773 a_temp(1,2)=aggj(l,2)!+ghalf2
3774 a_temp(2,1)=aggj(l,3)!+ghalf3
3775 a_temp(2,2)=aggj(l,4)!+ghalf4
3776 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3777 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3778 & +0.5d0*(pizda(1,1)+pizda(2,2))
3779 a_temp(1,1)=aggj1(l,1)
3780 a_temp(1,2)=aggj1(l,2)
3781 a_temp(2,1)=aggj1(l,3)
3782 a_temp(2,2)=aggj1(l,4)
3783 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3784 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3785 & +0.5d0*(pizda(1,1)+pizda(2,2))
3789 C-------------------------------------------------------------------------------
3790 subroutine eturn4(i,eello_turn4)
3791 C Third- and fourth-order contributions from turns
3792 implicit real*8 (a-h,o-z)
3793 include 'DIMENSIONS'
3794 include 'COMMON.IOUNITS'
3795 include 'COMMON.GEO'
3796 include 'COMMON.VAR'
3797 include 'COMMON.LOCAL'
3798 include 'COMMON.CHAIN'
3799 include 'COMMON.DERIV'
3800 include 'COMMON.INTERACT'
3801 include 'COMMON.CONTACTS'
3802 include 'COMMON.TORSION'
3803 include 'COMMON.VECTORS'
3804 include 'COMMON.FFIELD'
3805 include 'COMMON.CONTROL'
3807 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3808 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3809 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3810 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3811 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3812 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3813 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3816 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3818 C Fourth-order contributions
3826 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3827 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3828 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3833 iti1=itortyp(itype(i+1))
3834 iti2=itortyp(itype(i+2))
3835 iti3=itortyp(itype(i+3))
3836 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3837 call transpose2(EUg(1,1,i+1),e1t(1,1))
3838 call transpose2(Eug(1,1,i+2),e2t(1,1))
3839 call transpose2(Eug(1,1,i+3),e3t(1,1))
3840 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3841 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3842 s1=scalar2(b1(1,iti2),auxvec(1))
3843 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3844 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3845 s2=scalar2(b1(1,iti1),auxvec(1))
3846 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3847 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3848 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3849 eello_turn4=eello_turn4-(s1+s2+s3)
3850 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3851 & 'eturn4',i,j,-(s1+s2+s3)
3852 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3853 cd & ' eello_turn4_num',8*eello_turn4_num
3854 C Derivatives in gamma(i)
3855 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3856 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3857 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3858 s1=scalar2(b1(1,iti2),auxvec(1))
3859 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3860 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3861 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3862 C Derivatives in gamma(i+1)
3863 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3864 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3865 s2=scalar2(b1(1,iti1),auxvec(1))
3866 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3867 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3868 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3869 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3870 C Derivatives in gamma(i+2)
3871 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3872 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3873 s1=scalar2(b1(1,iti2),auxvec(1))
3874 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3875 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3876 s2=scalar2(b1(1,iti1),auxvec(1))
3877 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3878 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3879 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3880 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3881 C Cartesian derivatives
3882 C Derivatives of this turn contributions in DC(i+2)
3883 if (j.lt.nres-1) then
3885 a_temp(1,1)=agg(l,1)
3886 a_temp(1,2)=agg(l,2)
3887 a_temp(2,1)=agg(l,3)
3888 a_temp(2,2)=agg(l,4)
3889 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3890 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3891 s1=scalar2(b1(1,iti2),auxvec(1))
3892 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3893 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3894 s2=scalar2(b1(1,iti1),auxvec(1))
3895 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3896 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3897 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3899 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3902 C Remaining derivatives of this turn contribution
3904 a_temp(1,1)=aggi(l,1)
3905 a_temp(1,2)=aggi(l,2)
3906 a_temp(2,1)=aggi(l,3)
3907 a_temp(2,2)=aggi(l,4)
3908 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3909 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3910 s1=scalar2(b1(1,iti2),auxvec(1))
3911 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3912 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3913 s2=scalar2(b1(1,iti1),auxvec(1))
3914 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3915 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3916 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3917 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3918 a_temp(1,1)=aggi1(l,1)
3919 a_temp(1,2)=aggi1(l,2)
3920 a_temp(2,1)=aggi1(l,3)
3921 a_temp(2,2)=aggi1(l,4)
3922 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3923 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3924 s1=scalar2(b1(1,iti2),auxvec(1))
3925 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3926 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3927 s2=scalar2(b1(1,iti1),auxvec(1))
3928 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3929 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3930 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3931 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3932 a_temp(1,1)=aggj(l,1)
3933 a_temp(1,2)=aggj(l,2)
3934 a_temp(2,1)=aggj(l,3)
3935 a_temp(2,2)=aggj(l,4)
3936 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3937 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3938 s1=scalar2(b1(1,iti2),auxvec(1))
3939 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3940 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3941 s2=scalar2(b1(1,iti1),auxvec(1))
3942 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3943 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3944 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3945 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3946 a_temp(1,1)=aggj1(l,1)
3947 a_temp(1,2)=aggj1(l,2)
3948 a_temp(2,1)=aggj1(l,3)
3949 a_temp(2,2)=aggj1(l,4)
3950 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3951 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3952 s1=scalar2(b1(1,iti2),auxvec(1))
3953 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3954 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3955 s2=scalar2(b1(1,iti1),auxvec(1))
3956 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3957 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3958 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3959 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3960 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3964 C-----------------------------------------------------------------------------
3965 subroutine vecpr(u,v,w)
3966 implicit real*8(a-h,o-z)
3967 dimension u(3),v(3),w(3)
3968 w(1)=u(2)*v(3)-u(3)*v(2)
3969 w(2)=-u(1)*v(3)+u(3)*v(1)
3970 w(3)=u(1)*v(2)-u(2)*v(1)
3973 C-----------------------------------------------------------------------------
3974 subroutine unormderiv(u,ugrad,unorm,ungrad)
3975 C This subroutine computes the derivatives of a normalized vector u, given
3976 C the derivatives computed without normalization conditions, ugrad. Returns
3979 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3980 double precision vec(3)
3981 double precision scalar
3983 c write (2,*) 'ugrad',ugrad
3986 vec(i)=scalar(ugrad(1,i),u(1))
3988 c write (2,*) 'vec',vec
3991 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3994 c write (2,*) 'ungrad',ungrad
3997 C-----------------------------------------------------------------------------
3998 subroutine escp_soft_sphere(evdw2,evdw2_14)
4000 C This subroutine calculates the excluded-volume interaction energy between
4001 C peptide-group centers and side chains and its gradient in virtual-bond and
4002 C side-chain vectors.
4004 implicit real*8 (a-h,o-z)
4005 include 'DIMENSIONS'
4006 include 'COMMON.GEO'
4007 include 'COMMON.VAR'
4008 include 'COMMON.LOCAL'
4009 include 'COMMON.CHAIN'
4010 include 'COMMON.DERIV'
4011 include 'COMMON.INTERACT'
4012 include 'COMMON.FFIELD'
4013 include 'COMMON.IOUNITS'
4014 include 'COMMON.CONTROL'
4019 cd print '(a)','Enter ESCP'
4020 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4021 do i=iatscp_s,iatscp_e
4023 xi=0.5D0*(c(1,i)+c(1,i+1))
4024 yi=0.5D0*(c(2,i)+c(2,i+1))
4025 zi=0.5D0*(c(3,i)+c(3,i+1))
4027 do iint=1,nscp_gr(i)
4029 do j=iscpstart(i,iint),iscpend(i,iint)
4031 C Uncomment following three lines for SC-p interactions
4035 C Uncomment following three lines for Ca-p interactions
4039 rij=xj*xj+yj*yj+zj*zj
4042 if (rij.lt.r0ijsq) then
4043 evdwij=0.25d0*(rij-r0ijsq)**2
4051 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4056 cgrad if (j.lt.i) then
4057 cd write (iout,*) 'j<i'
4058 C Uncomment following three lines for SC-p interactions
4060 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4063 cd write (iout,*) 'j>i'
4065 cgrad ggg(k)=-ggg(k)
4066 C Uncomment following line for SC-p interactions
4067 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4071 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4073 cgrad kstart=min0(i+1,j)
4074 cgrad kend=max0(i-1,j-1)
4075 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4076 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4077 cgrad do k=kstart,kend
4079 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4083 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4084 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4092 C-----------------------------------------------------------------------------
4093 subroutine escp(evdw2,evdw2_14)
4095 C This subroutine calculates the excluded-volume interaction energy between
4096 C peptide-group centers and side chains and its gradient in virtual-bond and
4097 C side-chain vectors.
4099 implicit real*8 (a-h,o-z)
4100 include 'DIMENSIONS'
4101 include 'COMMON.GEO'
4102 include 'COMMON.VAR'
4103 include 'COMMON.LOCAL'
4104 include 'COMMON.CHAIN'
4105 include 'COMMON.DERIV'
4106 include 'COMMON.INTERACT'
4107 include 'COMMON.FFIELD'
4108 include 'COMMON.IOUNITS'
4109 include 'COMMON.CONTROL'
4113 cd print '(a)','Enter ESCP'
4114 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4115 do i=iatscp_s,iatscp_e
4117 xi=0.5D0*(c(1,i)+c(1,i+1))
4118 yi=0.5D0*(c(2,i)+c(2,i+1))
4119 zi=0.5D0*(c(3,i)+c(3,i+1))
4121 do iint=1,nscp_gr(i)
4123 do j=iscpstart(i,iint),iscpend(i,iint)
4125 C Uncomment following three lines for SC-p interactions
4129 C Uncomment following three lines for Ca-p interactions
4133 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4135 e1=fac*fac*aad(itypj,iteli)
4136 e2=fac*bad(itypj,iteli)
4137 if (iabs(j-i) .le. 2) then
4140 evdw2_14=evdw2_14+e1+e2
4144 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4145 & 'evdw2',i,j,evdwij
4147 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4149 fac=-(evdwij+e1)*rrij
4153 cgrad if (j.lt.i) then
4154 cd write (iout,*) 'j<i'
4155 C Uncomment following three lines for SC-p interactions
4157 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4160 cd write (iout,*) 'j>i'
4162 cgrad ggg(k)=-ggg(k)
4163 C Uncomment following line for SC-p interactions
4164 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4165 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4169 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4171 cgrad kstart=min0(i+1,j)
4172 cgrad kend=max0(i-1,j-1)
4173 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4174 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4175 cgrad do k=kstart,kend
4177 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4181 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4182 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4190 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4191 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4192 gradx_scp(j,i)=expon*gradx_scp(j,i)
4195 C******************************************************************************
4199 C To save time the factor EXPON has been extracted from ALL components
4200 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4203 C******************************************************************************
4206 C--------------------------------------------------------------------------
4207 subroutine edis(ehpb)
4209 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4211 implicit real*8 (a-h,o-z)
4212 include 'DIMENSIONS'
4213 include 'COMMON.SBRIDGE'
4214 include 'COMMON.CHAIN'
4215 include 'COMMON.DERIV'
4216 include 'COMMON.VAR'
4217 include 'COMMON.INTERACT'
4218 include 'COMMON.IOUNITS'
4221 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4222 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4223 if (link_end.eq.0) return
4224 do i=link_start,link_end
4225 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4226 C CA-CA distance used in regularization of structure.
4229 C iii and jjj point to the residues for which the distance is assigned.
4230 if (ii.gt.nres) then
4237 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4238 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4239 C distance and angle dependent SS bond potential.
4240 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4241 call ssbond_ene(iii,jjj,eij)
4243 cd write (iout,*) "eij",eij
4245 C Calculate the distance between the two points and its difference from the
4249 C Get the force constant corresponding to this distance.
4251 C Calculate the contribution to energy.
4252 ehpb=ehpb+waga*rdis*rdis
4254 C Evaluate gradient.
4257 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4258 cd & ' waga=',waga,' fac=',fac
4260 ggg(j)=fac*(c(j,jj)-c(j,ii))
4262 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4263 C If this is a SC-SC distance, we need to calculate the contributions to the
4264 C Cartesian gradient in the SC vectors (ghpbx).
4267 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4268 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4271 cgrad do j=iii,jjj-1
4273 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4277 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4278 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4285 C--------------------------------------------------------------------------
4286 subroutine ssbond_ene(i,j,eij)
4288 C Calculate the distance and angle dependent SS-bond potential energy
4289 C using a free-energy function derived based on RHF/6-31G** ab initio
4290 C calculations of diethyl disulfide.
4292 C A. Liwo and U. Kozlowska, 11/24/03
4294 implicit real*8 (a-h,o-z)
4295 include 'DIMENSIONS'
4296 include 'COMMON.SBRIDGE'
4297 include 'COMMON.CHAIN'
4298 include 'COMMON.DERIV'
4299 include 'COMMON.LOCAL'
4300 include 'COMMON.INTERACT'
4301 include 'COMMON.VAR'
4302 include 'COMMON.IOUNITS'
4303 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4308 dxi=dc_norm(1,nres+i)
4309 dyi=dc_norm(2,nres+i)
4310 dzi=dc_norm(3,nres+i)
4311 c dsci_inv=dsc_inv(itypi)
4312 dsci_inv=vbld_inv(nres+i)
4314 c dscj_inv=dsc_inv(itypj)
4315 dscj_inv=vbld_inv(nres+j)
4319 dxj=dc_norm(1,nres+j)
4320 dyj=dc_norm(2,nres+j)
4321 dzj=dc_norm(3,nres+j)
4322 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4327 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4328 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4329 om12=dxi*dxj+dyi*dyj+dzi*dzj
4331 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4332 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4338 deltat12=om2-om1+2.0d0
4340 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4341 & +akct*deltad*deltat12
4342 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4343 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4344 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4345 c & " deltat12",deltat12," eij",eij
4346 ed=2*akcm*deltad+akct*deltat12
4348 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4349 eom1=-2*akth*deltat1-pom1-om2*pom2
4350 eom2= 2*akth*deltat2+pom1-om1*pom2
4353 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4354 ghpbx(k,i)=ghpbx(k,i)-ggk
4355 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4356 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4357 ghpbx(k,j)=ghpbx(k,j)+ggk
4358 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4359 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4360 ghpbc(k,i)=ghpbc(k,i)-ggk
4361 ghpbc(k,j)=ghpbc(k,j)+ggk
4364 C Calculate the components of the gradient in DC and X
4368 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4373 C--------------------------------------------------------------------------
4374 subroutine ebond(estr)
4376 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4378 implicit real*8 (a-h,o-z)
4379 include 'DIMENSIONS'
4380 include 'COMMON.LOCAL'
4381 include 'COMMON.GEO'
4382 include 'COMMON.INTERACT'
4383 include 'COMMON.DERIV'
4384 include 'COMMON.VAR'
4385 include 'COMMON.CHAIN'
4386 include 'COMMON.IOUNITS'
4387 include 'COMMON.NAMES'
4388 include 'COMMON.FFIELD'
4389 include 'COMMON.CONTROL'
4390 include 'COMMON.SETUP'
4391 double precision u(3),ud(3)
4393 do i=ibondp_start,ibondp_end
4394 diff = vbld(i)-vbldp0
4395 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4396 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4397 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4400 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4402 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4406 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4408 do i=ibond_start,ibond_end
4413 diff=vbld(i+nres)-vbldsc0(1,iti)
4414 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4415 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4416 if (energy_dec) then
4418 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4419 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4422 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4424 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4428 diff=vbld(i+nres)-vbldsc0(j,iti)
4429 ud(j)=aksc(j,iti)*diff
4430 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4444 uprod2=uprod2*u(k)*u(k)
4448 usumsqder=usumsqder+ud(j)*uprod2
4450 estr=estr+uprod/usum
4452 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4460 C--------------------------------------------------------------------------
4461 subroutine ebend(etheta)
4463 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4464 C angles gamma and its derivatives in consecutive thetas and gammas.
4466 implicit real*8 (a-h,o-z)
4467 include 'DIMENSIONS'
4468 include 'COMMON.LOCAL'
4469 include 'COMMON.GEO'
4470 include 'COMMON.INTERACT'
4471 include 'COMMON.DERIV'
4472 include 'COMMON.VAR'
4473 include 'COMMON.CHAIN'
4474 include 'COMMON.IOUNITS'
4475 include 'COMMON.NAMES'
4476 include 'COMMON.FFIELD'
4477 include 'COMMON.CONTROL'
4478 common /calcthet/ term1,term2,termm,diffak,ratak,
4479 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4480 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4481 double precision y(2),z(2)
4483 c time11=dexp(-2*time)
4486 c write (*,'(a,i2)') 'EBEND ICG=',icg
4487 do i=ithet_start,ithet_end
4488 C Zero the energy function and its derivative at 0 or pi.
4489 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4494 if (phii.ne.phii) phii=150.0
4507 if (phii1.ne.phii1) phii1=150.0
4519 C Calculate the "mean" value of theta from the part of the distribution
4520 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4521 C In following comments this theta will be referred to as t_c.
4522 thet_pred_mean=0.0d0
4526 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4528 dthett=thet_pred_mean*ssd
4529 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4530 C Derivatives of the "mean" values in gamma1 and gamma2.
4531 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4532 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4533 if (theta(i).gt.pi-delta) then
4534 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4536 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4537 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4538 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4540 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4542 else if (theta(i).lt.delta) then
4543 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4544 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4545 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4547 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4548 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4551 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4554 etheta=etheta+ethetai
4555 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4557 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4558 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4559 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4561 C Ufff.... We've done all this!!!
4564 C---------------------------------------------------------------------------
4565 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4567 implicit real*8 (a-h,o-z)
4568 include 'DIMENSIONS'
4569 include 'COMMON.LOCAL'
4570 include 'COMMON.IOUNITS'
4571 common /calcthet/ term1,term2,termm,diffak,ratak,
4572 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4573 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4574 C Calculate the contributions to both Gaussian lobes.
4575 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4576 C The "polynomial part" of the "standard deviation" of this part of
4580 sig=sig*thet_pred_mean+polthet(j,it)
4582 C Derivative of the "interior part" of the "standard deviation of the"
4583 C gamma-dependent Gaussian lobe in t_c.
4584 sigtc=3*polthet(3,it)
4586 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4589 C Set the parameters of both Gaussian lobes of the distribution.
4590 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4591 fac=sig*sig+sigc0(it)
4594 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4595 sigsqtc=-4.0D0*sigcsq*sigtc
4596 c print *,i,sig,sigtc,sigsqtc
4597 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4598 sigtc=-sigtc/(fac*fac)
4599 C Following variable is sigma(t_c)**(-2)
4600 sigcsq=sigcsq*sigcsq
4602 sig0inv=1.0D0/sig0i**2
4603 delthec=thetai-thet_pred_mean
4604 delthe0=thetai-theta0i
4605 term1=-0.5D0*sigcsq*delthec*delthec
4606 term2=-0.5D0*sig0inv*delthe0*delthe0
4607 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4608 C NaNs in taking the logarithm. We extract the largest exponent which is added
4609 C to the energy (this being the log of the distribution) at the end of energy
4610 C term evaluation for this virtual-bond angle.
4611 if (term1.gt.term2) then
4613 term2=dexp(term2-termm)
4617 term1=dexp(term1-termm)
4620 C The ratio between the gamma-independent and gamma-dependent lobes of
4621 C the distribution is a Gaussian function of thet_pred_mean too.
4622 diffak=gthet(2,it)-thet_pred_mean
4623 ratak=diffak/gthet(3,it)**2
4624 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4625 C Let's differentiate it in thet_pred_mean NOW.
4627 C Now put together the distribution terms to make complete distribution.
4628 termexp=term1+ak*term2
4629 termpre=sigc+ak*sig0i
4630 C Contribution of the bending energy from this theta is just the -log of
4631 C the sum of the contributions from the two lobes and the pre-exponential
4632 C factor. Simple enough, isn't it?
4633 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4634 C NOW the derivatives!!!
4635 C 6/6/97 Take into account the deformation.
4636 E_theta=(delthec*sigcsq*term1
4637 & +ak*delthe0*sig0inv*term2)/termexp
4638 E_tc=((sigtc+aktc*sig0i)/termpre
4639 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4640 & aktc*term2)/termexp)
4643 c-----------------------------------------------------------------------------
4644 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4645 implicit real*8 (a-h,o-z)
4646 include 'DIMENSIONS'
4647 include 'COMMON.LOCAL'
4648 include 'COMMON.IOUNITS'
4649 common /calcthet/ term1,term2,termm,diffak,ratak,
4650 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4651 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4652 delthec=thetai-thet_pred_mean
4653 delthe0=thetai-theta0i
4654 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4655 t3 = thetai-thet_pred_mean
4659 t14 = t12+t6*sigsqtc
4661 t21 = thetai-theta0i
4667 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4668 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4669 & *(-t12*t9-ak*sig0inv*t27)
4673 C--------------------------------------------------------------------------
4674 subroutine ebend(etheta)
4676 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4677 C angles gamma and its derivatives in consecutive thetas and gammas.
4678 C ab initio-derived potentials from
4679 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4681 implicit real*8 (a-h,o-z)
4682 include 'DIMENSIONS'
4683 include 'COMMON.LOCAL'
4684 include 'COMMON.GEO'
4685 include 'COMMON.INTERACT'
4686 include 'COMMON.DERIV'
4687 include 'COMMON.VAR'
4688 include 'COMMON.CHAIN'
4689 include 'COMMON.IOUNITS'
4690 include 'COMMON.NAMES'
4691 include 'COMMON.FFIELD'
4692 include 'COMMON.CONTROL'
4693 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4694 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4695 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4696 & sinph1ph2(maxdouble,maxdouble)
4697 logical lprn /.false./, lprn1 /.false./
4699 do i=ithet_start,ithet_end
4700 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4701 &(itype(i).eq.ntyp1)) cycle
4705 theti2=0.5d0*theta(i)
4706 ityp2=ithetyp(itype(i-1))
4708 coskt(k)=dcos(k*theti2)
4709 sinkt(k)=dsin(k*theti2)
4712 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
4715 if (phii.ne.phii) phii=150.0
4719 ityp1=ithetyp(itype(i-2))
4721 cosph1(k)=dcos(k*phii)
4722 sinph1(k)=dsin(k*phii)
4726 ityp1=ithetyp(itype(i-2))
4732 if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then
4735 if (phii1.ne.phii1) phii1=150.0
4740 ityp3=ithetyp(itype(i))
4742 cosph2(k)=dcos(k*phii1)
4743 sinph2(k)=dsin(k*phii1)
4747 ityp3=ithetyp(itype(i))
4753 ethetai=aa0thet(ityp1,ityp2,ityp3)
4756 ccl=cosph1(l)*cosph2(k-l)
4757 ssl=sinph1(l)*sinph2(k-l)
4758 scl=sinph1(l)*cosph2(k-l)
4759 csl=cosph1(l)*sinph2(k-l)
4760 cosph1ph2(l,k)=ccl-ssl
4761 cosph1ph2(k,l)=ccl+ssl
4762 sinph1ph2(l,k)=scl+csl
4763 sinph1ph2(k,l)=scl-csl
4767 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4768 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4769 write (iout,*) "coskt and sinkt"
4771 write (iout,*) k,coskt(k),sinkt(k)
4775 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4776 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4779 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4780 & " ethetai",ethetai
4783 write (iout,*) "cosph and sinph"
4785 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4787 write (iout,*) "cosph1ph2 and sinph2ph2"
4790 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4791 & sinph1ph2(l,k),sinph1ph2(k,l)
4794 write(iout,*) "ethetai",ethetai
4798 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4799 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4800 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4801 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4802 ethetai=ethetai+sinkt(m)*aux
4803 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4804 dephii=dephii+k*sinkt(m)*(
4805 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4806 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4807 dephii1=dephii1+k*sinkt(m)*(
4808 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4809 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4811 & write (iout,*) "m",m," k",k," bbthet",
4812 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4813 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4814 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4815 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4819 & write(iout,*) "ethetai",ethetai
4823 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4824 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4825 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4826 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4827 ethetai=ethetai+sinkt(m)*aux
4828 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4829 dephii=dephii+l*sinkt(m)*(
4830 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4831 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4832 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4833 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4834 dephii1=dephii1+(k-l)*sinkt(m)*(
4835 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4836 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4837 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4838 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4840 write (iout,*) "m",m," k",k," l",l," ffthet",
4841 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4842 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4843 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4844 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4845 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4846 & cosph1ph2(k,l)*sinkt(m),
4847 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4853 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4854 & i,theta(i)*rad2deg,phii*rad2deg,
4855 & phii1*rad2deg,ethetai
4856 etheta=etheta+ethetai
4857 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4859 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4860 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4861 gloc(nphi+i-2,icg)=wang*dethetai
4867 c-----------------------------------------------------------------------------
4868 subroutine esc(escloc)
4869 C Calculate the local energy of a side chain and its derivatives in the
4870 C corresponding virtual-bond valence angles THETA and the spherical angles
4872 implicit real*8 (a-h,o-z)
4873 include 'DIMENSIONS'
4874 include 'COMMON.GEO'
4875 include 'COMMON.LOCAL'
4876 include 'COMMON.VAR'
4877 include 'COMMON.INTERACT'
4878 include 'COMMON.DERIV'
4879 include 'COMMON.CHAIN'
4880 include 'COMMON.IOUNITS'
4881 include 'COMMON.NAMES'
4882 include 'COMMON.FFIELD'
4883 include 'COMMON.CONTROL'
4884 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4885 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4886 common /sccalc/ time11,time12,time112,theti,it,nlobit
4889 c write (iout,'(a)') 'ESC'
4890 do i=loc_start,loc_end
4892 if (it.eq.10) goto 1
4894 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4895 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4896 theti=theta(i+1)-pipol
4901 if (x(2).gt.pi-delta) then
4905 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4907 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4908 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4910 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4911 & ddersc0(1),dersc(1))
4912 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4913 & ddersc0(3),dersc(3))
4915 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4917 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4918 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4919 & dersc0(2),esclocbi,dersc02)
4920 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4922 call splinthet(x(2),0.5d0*delta,ss,ssd)
4927 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4929 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4930 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4932 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4934 c write (iout,*) escloci
4935 else if (x(2).lt.delta) then
4939 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4941 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4942 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4944 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4945 & ddersc0(1),dersc(1))
4946 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4947 & ddersc0(3),dersc(3))
4949 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4951 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4952 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4953 & dersc0(2),esclocbi,dersc02)
4954 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4959 call splinthet(x(2),0.5d0*delta,ss,ssd)
4961 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4963 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4964 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4966 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4967 c write (iout,*) escloci
4969 call enesc(x,escloci,dersc,ddummy,.false.)
4972 escloc=escloc+escloci
4973 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4974 & 'escloc',i,escloci
4975 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4977 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4979 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4980 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4985 C---------------------------------------------------------------------------
4986 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4987 implicit real*8 (a-h,o-z)
4988 include 'DIMENSIONS'
4989 include 'COMMON.GEO'
4990 include 'COMMON.LOCAL'
4991 include 'COMMON.IOUNITS'
4992 common /sccalc/ time11,time12,time112,theti,it,nlobit
4993 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4994 double precision contr(maxlob,-1:1)
4996 c write (iout,*) 'it=',it,' nlobit=',nlobit
5000 if (mixed) ddersc(j)=0.0d0
5004 C Because of periodicity of the dependence of the SC energy in omega we have
5005 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5006 C To avoid underflows, first compute & store the exponents.
5014 z(k)=x(k)-censc(k,j,it)
5019 Axk=Axk+gaussc(l,k,j,it)*z(l)
5025 expfac=expfac+Ax(k,j,iii)*z(k)
5033 C As in the case of ebend, we want to avoid underflows in exponentiation and
5034 C subsequent NaNs and INFs in energy calculation.
5035 C Find the largest exponent
5039 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5043 cd print *,'it=',it,' emin=',emin
5045 C Compute the contribution to SC energy and derivatives
5050 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5051 if(adexp.ne.adexp) adexp=1.0
5054 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5056 cd print *,'j=',j,' expfac=',expfac
5057 escloc_i=escloc_i+expfac
5059 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5063 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5064 & +gaussc(k,2,j,it))*expfac
5071 dersc(1)=dersc(1)/cos(theti)**2
5072 ddersc(1)=ddersc(1)/cos(theti)**2
5075 escloci=-(dlog(escloc_i)-emin)
5077 dersc(j)=dersc(j)/escloc_i
5081 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5086 C------------------------------------------------------------------------------
5087 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5088 implicit real*8 (a-h,o-z)
5089 include 'DIMENSIONS'
5090 include 'COMMON.GEO'
5091 include 'COMMON.LOCAL'
5092 include 'COMMON.IOUNITS'
5093 common /sccalc/ time11,time12,time112,theti,it,nlobit
5094 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5095 double precision contr(maxlob)
5106 z(k)=x(k)-censc(k,j,it)
5112 Axk=Axk+gaussc(l,k,j,it)*z(l)
5118 expfac=expfac+Ax(k,j)*z(k)
5123 C As in the case of ebend, we want to avoid underflows in exponentiation and
5124 C subsequent NaNs and INFs in energy calculation.
5125 C Find the largest exponent
5128 if (emin.gt.contr(j)) emin=contr(j)
5132 C Compute the contribution to SC energy and derivatives
5136 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5137 escloc_i=escloc_i+expfac
5139 dersc(k)=dersc(k)+Ax(k,j)*expfac
5141 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5142 & +gaussc(1,2,j,it))*expfac
5146 dersc(1)=dersc(1)/cos(theti)**2
5147 dersc12=dersc12/cos(theti)**2
5148 escloci=-(dlog(escloc_i)-emin)
5150 dersc(j)=dersc(j)/escloc_i
5152 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5156 c----------------------------------------------------------------------------------
5157 subroutine esc(escloc)
5158 C Calculate the local energy of a side chain and its derivatives in the
5159 C corresponding virtual-bond valence angles THETA and the spherical angles
5160 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5161 C added by Urszula Kozlowska. 07/11/2007
5163 implicit real*8 (a-h,o-z)
5164 include 'DIMENSIONS'
5165 include 'COMMON.GEO'
5166 include 'COMMON.LOCAL'
5167 include 'COMMON.VAR'
5168 include 'COMMON.SCROT'
5169 include 'COMMON.INTERACT'
5170 include 'COMMON.DERIV'
5171 include 'COMMON.CHAIN'
5172 include 'COMMON.IOUNITS'
5173 include 'COMMON.NAMES'
5174 include 'COMMON.FFIELD'
5175 include 'COMMON.CONTROL'
5176 include 'COMMON.VECTORS'
5177 double precision x_prime(3),y_prime(3),z_prime(3)
5178 & , sumene,dsc_i,dp2_i,x(65),
5179 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5180 & de_dxx,de_dyy,de_dzz,de_dt
5181 double precision s1_t,s1_6_t,s2_t,s2_6_t
5183 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5184 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5185 & dt_dCi(3),dt_dCi1(3)
5186 common /sccalc/ time11,time12,time112,theti,it,nlobit
5189 do i=loc_start,loc_end
5190 costtab(i+1) =dcos(theta(i+1))
5191 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5192 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5193 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5194 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5195 cosfac=dsqrt(cosfac2)
5196 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5197 sinfac=dsqrt(sinfac2)
5199 if (it.eq.10) goto 1
5201 C Compute the axes of tghe local cartesian coordinates system; store in
5202 c x_prime, y_prime and z_prime
5209 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5210 C & dc_norm(3,i+nres)
5212 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5213 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5216 z_prime(j) = -uz(j,i-1)
5219 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5220 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5221 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5222 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5223 c & " xy",scalar(x_prime(1),y_prime(1)),
5224 c & " xz",scalar(x_prime(1),z_prime(1)),
5225 c & " yy",scalar(y_prime(1),y_prime(1)),
5226 c & " yz",scalar(y_prime(1),z_prime(1)),
5227 c & " zz",scalar(z_prime(1),z_prime(1))
5229 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5230 C to local coordinate system. Store in xx, yy, zz.
5236 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5237 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5238 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5245 C Compute the energy of the ith side cbain
5247 c write (2,*) "xx",xx," yy",yy," zz",zz
5250 x(j) = sc_parmin(j,it)
5253 Cc diagnostics - remove later
5255 yy1 = dsin(alph(2))*dcos(omeg(2))
5256 zz1 = -dsin(alph(2))*dsin(omeg(2))
5257 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5258 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5260 C," --- ", xx_w,yy_w,zz_w
5263 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5264 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5266 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5267 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5269 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5270 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5271 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5272 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5273 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5275 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5276 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5277 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5278 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5279 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5281 dsc_i = 0.743d0+x(61)
5283 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5284 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5285 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5286 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5287 s1=(1+x(63))/(0.1d0 + dscp1)
5288 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5289 s2=(1+x(65))/(0.1d0 + dscp2)
5290 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5291 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5292 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5293 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5295 c & dscp1,dscp2,sumene
5296 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5297 escloc = escloc + sumene
5298 c write (2,*) "i",i," escloc",sumene,escloc
5301 C This section to check the numerical derivatives of the energy of ith side
5302 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5303 C #define DEBUG in the code to turn it on.
5305 write (2,*) "sumene =",sumene
5309 write (2,*) xx,yy,zz
5310 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5311 de_dxx_num=(sumenep-sumene)/aincr
5313 write (2,*) "xx+ sumene from enesc=",sumenep
5316 write (2,*) xx,yy,zz
5317 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5318 de_dyy_num=(sumenep-sumene)/aincr
5320 write (2,*) "yy+ sumene from enesc=",sumenep
5323 write (2,*) xx,yy,zz
5324 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5325 de_dzz_num=(sumenep-sumene)/aincr
5327 write (2,*) "zz+ sumene from enesc=",sumenep
5328 costsave=cost2tab(i+1)
5329 sintsave=sint2tab(i+1)
5330 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5331 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5332 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5333 de_dt_num=(sumenep-sumene)/aincr
5334 write (2,*) " t+ sumene from enesc=",sumenep
5335 cost2tab(i+1)=costsave
5336 sint2tab(i+1)=sintsave
5337 C End of diagnostics section.
5340 C Compute the gradient of esc
5342 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5343 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5344 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5345 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5346 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5347 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5348 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5349 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5350 pom1=(sumene3*sint2tab(i+1)+sumene1)
5351 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5352 pom2=(sumene4*cost2tab(i+1)+sumene2)
5353 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5354 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5355 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5356 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5358 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5359 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5360 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5362 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5363 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5364 & +(pom1+pom2)*pom_dx
5366 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5369 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5370 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5371 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5373 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5374 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5375 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5376 & +x(59)*zz**2 +x(60)*xx*zz
5377 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5378 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5379 & +(pom1-pom2)*pom_dy
5381 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5384 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5385 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5386 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5387 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5388 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5389 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5390 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5391 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5393 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5396 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5397 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5398 & +pom1*pom_dt1+pom2*pom_dt2
5400 write(2,*), "de_dt = ", de_dt,de_dt_num
5404 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5405 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5406 cosfac2xx=cosfac2*xx
5407 sinfac2yy=sinfac2*yy
5409 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5411 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5413 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5414 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5415 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5416 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5417 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5418 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5419 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5420 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5421 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5422 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5426 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5427 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5430 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5431 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5432 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5434 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5435 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5439 dXX_Ctab(k,i)=dXX_Ci(k)
5440 dXX_C1tab(k,i)=dXX_Ci1(k)
5441 dYY_Ctab(k,i)=dYY_Ci(k)
5442 dYY_C1tab(k,i)=dYY_Ci1(k)
5443 dZZ_Ctab(k,i)=dZZ_Ci(k)
5444 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5445 dXX_XYZtab(k,i)=dXX_XYZ(k)
5446 dYY_XYZtab(k,i)=dYY_XYZ(k)
5447 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5451 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5452 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5453 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5454 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5455 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5457 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5458 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5459 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5460 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5461 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5462 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5463 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5464 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5466 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5467 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5469 C to check gradient call subroutine check_grad
5475 c------------------------------------------------------------------------------
5476 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5478 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5479 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5480 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5481 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5483 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5484 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5486 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5487 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5488 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5489 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5490 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5492 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5493 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5494 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5495 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5496 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5498 dsc_i = 0.743d0+x(61)
5500 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5501 & *(xx*cost2+yy*sint2))
5502 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5503 & *(xx*cost2-yy*sint2))
5504 s1=(1+x(63))/(0.1d0 + dscp1)
5505 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5506 s2=(1+x(65))/(0.1d0 + dscp2)
5507 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5508 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5509 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5514 c------------------------------------------------------------------------------
5515 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5517 C This procedure calculates two-body contact function g(rij) and its derivative:
5520 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5523 C where x=(rij-r0ij)/delta
5525 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5528 double precision rij,r0ij,eps0ij,fcont,fprimcont
5529 double precision x,x2,x4,delta
5533 if (x.lt.-1.0D0) then
5536 else if (x.le.1.0D0) then
5539 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5540 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5547 c------------------------------------------------------------------------------
5548 subroutine splinthet(theti,delta,ss,ssder)
5549 implicit real*8 (a-h,o-z)
5550 include 'DIMENSIONS'
5551 include 'COMMON.VAR'
5552 include 'COMMON.GEO'
5555 if (theti.gt.pipol) then
5556 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5558 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5563 c------------------------------------------------------------------------------
5564 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5566 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5567 double precision ksi,ksi2,ksi3,a1,a2,a3
5568 a1=fprim0*delta/(f1-f0)
5574 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5575 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5578 c------------------------------------------------------------------------------
5579 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5581 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5582 double precision ksi,ksi2,ksi3,a1,a2,a3
5587 a2=3*(f1x-f0x)-2*fprim0x*delta
5588 a3=fprim0x*delta-2*(f1x-f0x)
5589 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5592 C-----------------------------------------------------------------------------
5594 C-----------------------------------------------------------------------------
5595 subroutine etor(etors,edihcnstr)
5596 implicit real*8 (a-h,o-z)
5597 include 'DIMENSIONS'
5598 include 'COMMON.VAR'
5599 include 'COMMON.GEO'
5600 include 'COMMON.LOCAL'
5601 include 'COMMON.TORSION'
5602 include 'COMMON.INTERACT'
5603 include 'COMMON.DERIV'
5604 include 'COMMON.CHAIN'
5605 include 'COMMON.NAMES'
5606 include 'COMMON.IOUNITS'
5607 include 'COMMON.FFIELD'
5608 include 'COMMON.TORCNSTR'
5609 include 'COMMON.CONTROL'
5611 C Set lprn=.true. for debugging
5615 do i=iphi_start,iphi_end
5617 itori=itortyp(itype(i-2))
5618 itori1=itortyp(itype(i-1))
5621 C Proline-Proline pair is a special case...
5622 if (itori.eq.3 .and. itori1.eq.3) then
5623 if (phii.gt.-dwapi3) then
5625 fac=1.0D0/(1.0D0-cosphi)
5626 etorsi=v1(1,3,3)*fac
5627 etorsi=etorsi+etorsi
5628 etors=etors+etorsi-v1(1,3,3)
5629 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5630 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5633 v1ij=v1(j+1,itori,itori1)
5634 v2ij=v2(j+1,itori,itori1)
5637 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5638 if (energy_dec) etors_ii=etors_ii+
5639 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5640 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5644 v1ij=v1(j,itori,itori1)
5645 v2ij=v2(j,itori,itori1)
5648 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5649 if (energy_dec) etors_ii=etors_ii+
5650 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5651 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5654 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5657 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5658 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5659 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5660 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5661 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5663 ! 6/20/98 - dihedral angle constraints
5666 itori=idih_constr(i)
5669 if (difi.gt.drange(i)) then
5671 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5672 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5673 else if (difi.lt.-drange(i)) then
5675 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5676 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5678 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5679 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5681 ! write (iout,*) 'edihcnstr',edihcnstr
5684 c------------------------------------------------------------------------------
5685 subroutine etor_d(etors_d)
5689 c----------------------------------------------------------------------------
5691 subroutine etor(etors,edihcnstr)
5692 implicit real*8 (a-h,o-z)
5693 include 'DIMENSIONS'
5694 include 'COMMON.VAR'
5695 include 'COMMON.GEO'
5696 include 'COMMON.LOCAL'
5697 include 'COMMON.TORSION'
5698 include 'COMMON.INTERACT'
5699 include 'COMMON.DERIV'
5700 include 'COMMON.CHAIN'
5701 include 'COMMON.NAMES'
5702 include 'COMMON.IOUNITS'
5703 include 'COMMON.FFIELD'
5704 include 'COMMON.TORCNSTR'
5705 include 'COMMON.CONTROL'
5707 C Set lprn=.true. for debugging
5711 do i=iphi_start,iphi_end
5713 itori=itortyp(itype(i-2))
5714 itori1=itortyp(itype(i-1))
5717 C Regular cosine and sine terms
5718 do j=1,nterm(itori,itori1)
5719 v1ij=v1(j,itori,itori1)
5720 v2ij=v2(j,itori,itori1)
5723 etors=etors+v1ij*cosphi+v2ij*sinphi
5724 if (energy_dec) etors_ii=etors_ii+
5725 & v1ij*cosphi+v2ij*sinphi
5726 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5730 C E = SUM ----------------------------------- - v1
5731 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5733 cosphi=dcos(0.5d0*phii)
5734 sinphi=dsin(0.5d0*phii)
5735 do j=1,nlor(itori,itori1)
5736 vl1ij=vlor1(j,itori,itori1)
5737 vl2ij=vlor2(j,itori,itori1)
5738 vl3ij=vlor3(j,itori,itori1)
5739 pom=vl2ij*cosphi+vl3ij*sinphi
5740 pom1=1.0d0/(pom*pom+1.0d0)
5741 etors=etors+vl1ij*pom1
5742 if (energy_dec) etors_ii=etors_ii+
5745 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5747 C Subtract the constant term
5748 etors=etors-v0(itori,itori1)
5749 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5750 & 'etor',i,etors_ii-v0(itori,itori1)
5752 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5753 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5754 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5755 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5756 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5758 ! 6/20/98 - dihedral angle constraints
5760 c do i=1,ndih_constr
5761 do i=idihconstr_start,idihconstr_end
5762 itori=idih_constr(i)
5764 difi=pinorm(phii-phi0(i))
5765 if (difi.gt.drange(i)) then
5767 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5768 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5769 else if (difi.lt.-drange(i)) then
5771 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5772 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5776 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5777 cd & rad2deg*phi0(i), rad2deg*drange(i),
5778 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5780 cd write (iout,*) 'edihcnstr',edihcnstr
5783 c----------------------------------------------------------------------------
5784 subroutine etor_d(etors_d)
5785 C 6/23/01 Compute double torsional energy
5786 implicit real*8 (a-h,o-z)
5787 include 'DIMENSIONS'
5788 include 'COMMON.VAR'
5789 include 'COMMON.GEO'
5790 include 'COMMON.LOCAL'
5791 include 'COMMON.TORSION'
5792 include 'COMMON.INTERACT'
5793 include 'COMMON.DERIV'
5794 include 'COMMON.CHAIN'
5795 include 'COMMON.NAMES'
5796 include 'COMMON.IOUNITS'
5797 include 'COMMON.FFIELD'
5798 include 'COMMON.TORCNSTR'
5799 include 'COMMON.CONTROL'
5801 C Set lprn=.true. for debugging
5805 do i=iphid_start,iphid_end
5807 itori=itortyp(itype(i-2))
5808 itori1=itortyp(itype(i-1))
5809 itori2=itortyp(itype(i))
5814 C Regular cosine and sine terms
5815 do j=1,ntermd_1(itori,itori1,itori2)
5816 v1cij=v1c(1,j,itori,itori1,itori2)
5817 v1sij=v1s(1,j,itori,itori1,itori2)
5818 v2cij=v1c(2,j,itori,itori1,itori2)
5819 v2sij=v1s(2,j,itori,itori1,itori2)
5820 cosphi1=dcos(j*phii)
5821 sinphi1=dsin(j*phii)
5822 cosphi2=dcos(j*phii1)
5823 sinphi2=dsin(j*phii1)
5824 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5825 & v2cij*cosphi2+v2sij*sinphi2
5826 if (energy_dec) etors_d_ii=etors_d_ii+
5827 & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
5828 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5829 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5831 do k=2,ntermd_2(itori,itori1,itori2)
5833 v1cdij = v2c(k,l,itori,itori1,itori2)
5834 v2cdij = v2c(l,k,itori,itori1,itori2)
5835 v1sdij = v2s(k,l,itori,itori1,itori2)
5836 v2sdij = v2s(l,k,itori,itori1,itori2)
5837 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5838 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5839 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5840 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5841 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5842 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5843 if (energy_dec) etors_d_ii=etors_d_ii+
5844 & v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5845 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5846 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5847 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5848 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5849 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5852 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5853 & 'etor_d',i,etors_d_ii
5854 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5855 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5860 c------------------------------------------------------------------------------
5861 subroutine eback_sc_corr(esccor)
5862 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5863 c conformational states; temporarily implemented as differences
5864 c between UNRES torsional potentials (dependent on three types of
5865 c residues) and the torsional potentials dependent on all 20 types
5866 c of residues computed from AM1 energy surfaces of terminally-blocked
5867 c amino-acid residues.
5868 implicit real*8 (a-h,o-z)
5869 include 'DIMENSIONS'
5870 include 'COMMON.VAR'
5871 include 'COMMON.GEO'
5872 include 'COMMON.LOCAL'
5873 include 'COMMON.TORSION'
5874 include 'COMMON.SCCOR'
5875 include 'COMMON.INTERACT'
5876 include 'COMMON.DERIV'
5877 include 'COMMON.CHAIN'
5878 include 'COMMON.NAMES'
5879 include 'COMMON.IOUNITS'
5880 include 'COMMON.FFIELD'
5881 include 'COMMON.CONTROL'
5883 C Set lprn=.true. for debugging
5884 C Set lprn=.true. for debugging
5887 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5889 do i=itau_start,itau_end
5891 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5892 isccori=isccortyp(itype(i-2))
5893 isccori1=isccortyp(itype(i-1))
5894 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5897 cccc Added 9 May 2012
5898 cc Tauangle is torsional engle depending on the value of first digit
5899 c(see comment below)
5900 cc Omicron is flat angle depending on the value of first digit
5901 c(see comment below)
5902 C print *,i,tauangle(1,i)
5904 do intertyp=1,3 !intertyp
5905 cc Added 09 May 2012 (Adasko)
5906 cc Intertyp means interaction type of backbone mainchain correlation:
5907 c 1 = SC...Ca...Ca...Ca
5908 c 2 = Ca...Ca...Ca...SC
5909 c 3 = SC...Ca...Ca...SCi
5911 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5912 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
5913 & (itype(i-1).eq.21)))
5914 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5915 & .or.(itype(i-2).eq.21)))
5916 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5917 & (itype(i-1).eq.21)))) cycle
5918 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
5919 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
5921 do j=1,nterm_sccor(isccori,isccori1)
5922 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5923 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5924 cosphi=dcos(j*tauangle(intertyp,i))
5925 sinphi=dsin(j*tauangle(intertyp,i))
5926 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5927 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5929 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5930 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5931 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
5932 c &gloc_sc(intertyp,i-3,icg)
5934 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5935 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5936 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
5937 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
5938 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5942 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc_sc(2,i,icg),
5943 c & gloc_sc(3,i,icg)
5947 c----------------------------------------------------------------------------
5948 subroutine multibody(ecorr)
5949 C This subroutine calculates multi-body contributions to energy following
5950 C the idea of Skolnick et al. If side chains I and J make a contact and
5951 C at the same time side chains I+1 and J+1 make a contact, an extra
5952 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5953 implicit real*8 (a-h,o-z)
5954 include 'DIMENSIONS'
5955 include 'COMMON.IOUNITS'
5956 include 'COMMON.DERIV'
5957 include 'COMMON.INTERACT'
5958 include 'COMMON.CONTACTS'
5959 double precision gx(3),gx1(3)
5962 C Set lprn=.true. for debugging
5966 write (iout,'(a)') 'Contact function values:'
5968 write (iout,'(i2,20(1x,i2,f10.5))')
5969 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5984 num_conti=num_cont(i)
5985 num_conti1=num_cont(i1)
5990 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5991 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5992 cd & ' ishift=',ishift
5993 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5994 C The system gains extra energy.
5995 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5996 endif ! j1==j+-ishift
6005 c------------------------------------------------------------------------------
6006 double precision function esccorr(i,j,k,l,jj,kk)
6007 implicit real*8 (a-h,o-z)
6008 include 'DIMENSIONS'
6009 include 'COMMON.IOUNITS'
6010 include 'COMMON.DERIV'
6011 include 'COMMON.INTERACT'
6012 include 'COMMON.CONTACTS'
6013 double precision gx(3),gx1(3)
6018 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6019 C Calculate the multi-body contribution to energy.
6020 C Calculate multi-body contributions to the gradient.
6021 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6022 cd & k,l,(gacont(m,kk,k),m=1,3)
6024 gx(m) =ekl*gacont(m,jj,i)
6025 gx1(m)=eij*gacont(m,kk,k)
6026 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6027 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6028 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6029 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6033 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6038 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6044 c------------------------------------------------------------------------------
6045 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6046 C This subroutine calculates multi-body contributions to hydrogen-bonding
6047 implicit real*8 (a-h,o-z)
6048 include 'DIMENSIONS'
6049 include 'COMMON.IOUNITS'
6052 parameter (max_cont=maxconts)
6053 parameter (max_dim=26)
6054 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6055 double precision zapas(max_dim,maxconts,max_fg_procs),
6056 & zapas_recv(max_dim,maxconts,max_fg_procs)
6057 common /przechowalnia/ zapas
6058 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6059 & status_array(MPI_STATUS_SIZE,maxconts*2)
6061 include 'COMMON.SETUP'
6062 include 'COMMON.FFIELD'
6063 include 'COMMON.DERIV'
6064 include 'COMMON.INTERACT'
6065 include 'COMMON.CONTACTS'
6066 include 'COMMON.CONTROL'
6067 include 'COMMON.LOCAL'
6068 double precision gx(3),gx1(3),time00
6071 C Set lprn=.true. for debugging
6076 if (nfgtasks.le.1) goto 30
6078 write (iout,'(a)') 'Contact function values before RECEIVE:'
6080 write (iout,'(2i3,50(1x,i2,f5.2))')
6081 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6082 & j=1,num_cont_hb(i))
6086 do i=1,ntask_cont_from
6089 do i=1,ntask_cont_to
6092 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6094 C Make the list of contacts to send to send to other procesors
6095 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6097 do i=iturn3_start,iturn3_end
6098 c write (iout,*) "make contact list turn3",i," num_cont",
6100 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6102 do i=iturn4_start,iturn4_end
6103 c write (iout,*) "make contact list turn4",i," num_cont",
6105 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6109 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6111 do j=1,num_cont_hb(i)
6114 iproc=iint_sent_local(k,jjc,ii)
6115 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6116 if (iproc.gt.0) then
6117 ncont_sent(iproc)=ncont_sent(iproc)+1
6118 nn=ncont_sent(iproc)
6120 zapas(2,nn,iproc)=jjc
6121 zapas(3,nn,iproc)=facont_hb(j,i)
6122 zapas(4,nn,iproc)=ees0p(j,i)
6123 zapas(5,nn,iproc)=ees0m(j,i)
6124 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6125 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6126 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6127 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6128 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6129 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6130 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6131 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6132 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6133 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6134 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6135 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6136 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6137 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6138 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6139 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6140 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6141 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6142 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6143 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6144 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6151 & "Numbers of contacts to be sent to other processors",
6152 & (ncont_sent(i),i=1,ntask_cont_to)
6153 write (iout,*) "Contacts sent"
6154 do ii=1,ntask_cont_to
6156 iproc=itask_cont_to(ii)
6157 write (iout,*) nn," contacts to processor",iproc,
6158 & " of CONT_TO_COMM group"
6160 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6168 CorrelID1=nfgtasks+fg_rank+1
6170 C Receive the numbers of needed contacts from other processors
6171 do ii=1,ntask_cont_from
6172 iproc=itask_cont_from(ii)
6174 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6175 & FG_COMM,req(ireq),IERR)
6177 c write (iout,*) "IRECV ended"
6179 C Send the number of contacts needed by other processors
6180 do ii=1,ntask_cont_to
6181 iproc=itask_cont_to(ii)
6183 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6184 & FG_COMM,req(ireq),IERR)
6186 c write (iout,*) "ISEND ended"
6187 c write (iout,*) "number of requests (nn)",ireq
6190 & call MPI_Waitall(ireq,req,status_array,ierr)
6192 c & "Numbers of contacts to be received from other processors",
6193 c & (ncont_recv(i),i=1,ntask_cont_from)
6197 do ii=1,ntask_cont_from
6198 iproc=itask_cont_from(ii)
6200 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6201 c & " of CONT_TO_COMM group"
6205 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6206 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6207 c write (iout,*) "ireq,req",ireq,req(ireq)
6210 C Send the contacts to processors that need them
6211 do ii=1,ntask_cont_to
6212 iproc=itask_cont_to(ii)
6214 c write (iout,*) nn," contacts to processor",iproc,
6215 c & " of CONT_TO_COMM group"
6218 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6219 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6220 c write (iout,*) "ireq,req",ireq,req(ireq)
6222 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6226 c write (iout,*) "number of requests (contacts)",ireq
6227 c write (iout,*) "req",(req(i),i=1,4)
6230 & call MPI_Waitall(ireq,req,status_array,ierr)
6231 do iii=1,ntask_cont_from
6232 iproc=itask_cont_from(iii)
6235 write (iout,*) "Received",nn," contacts from processor",iproc,
6236 & " of CONT_FROM_COMM group"
6239 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6244 ii=zapas_recv(1,i,iii)
6245 c Flag the received contacts to prevent double-counting
6246 jj=-zapas_recv(2,i,iii)
6247 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6249 nnn=num_cont_hb(ii)+1
6252 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6253 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6254 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6255 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6256 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6257 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6258 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6259 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6260 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6261 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6262 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6263 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6264 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6265 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6266 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6267 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6268 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6269 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6270 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6271 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6272 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6273 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6274 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6275 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6280 write (iout,'(a)') 'Contact function values after receive:'
6282 write (iout,'(2i3,50(1x,i3,f5.2))')
6283 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6284 & j=1,num_cont_hb(i))
6291 write (iout,'(a)') 'Contact function values:'
6293 write (iout,'(2i3,50(1x,i3,f5.2))')
6294 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6295 & j=1,num_cont_hb(i))
6299 C Remove the loop below after debugging !!!
6306 C Calculate the local-electrostatic correlation terms
6307 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6309 num_conti=num_cont_hb(i)
6310 num_conti1=num_cont_hb(i+1)
6317 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6318 c & ' jj=',jj,' kk=',kk
6319 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6320 & .or. j.lt.0 .and. j1.gt.0) .and.
6321 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6322 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6323 C The system gains extra energy.
6324 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6325 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6326 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6328 else if (j1.eq.j) then
6329 C Contacts I-J and I-(J+1) occur simultaneously.
6330 C The system loses extra energy.
6331 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6336 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6337 c & ' jj=',jj,' kk=',kk
6339 C Contacts I-J and (I+1)-J occur simultaneously.
6340 C The system loses extra energy.
6341 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6348 c------------------------------------------------------------------------------
6349 subroutine add_hb_contact(ii,jj,itask)
6350 implicit real*8 (a-h,o-z)
6351 include "DIMENSIONS"
6352 include "COMMON.IOUNITS"
6355 parameter (max_cont=maxconts)
6356 parameter (max_dim=26)
6357 include "COMMON.CONTACTS"
6358 double precision zapas(max_dim,maxconts,max_fg_procs),
6359 & zapas_recv(max_dim,maxconts,max_fg_procs)
6360 common /przechowalnia/ zapas
6361 integer i,j,ii,jj,iproc,itask(4),nn
6362 c write (iout,*) "itask",itask
6365 if (iproc.gt.0) then
6366 do j=1,num_cont_hb(ii)
6368 c write (iout,*) "i",ii," j",jj," jjc",jjc
6370 ncont_sent(iproc)=ncont_sent(iproc)+1
6371 nn=ncont_sent(iproc)
6372 zapas(1,nn,iproc)=ii
6373 zapas(2,nn,iproc)=jjc
6374 zapas(3,nn,iproc)=facont_hb(j,ii)
6375 zapas(4,nn,iproc)=ees0p(j,ii)
6376 zapas(5,nn,iproc)=ees0m(j,ii)
6377 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6378 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6379 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6380 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6381 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6382 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6383 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6384 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6385 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6386 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6387 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6388 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6389 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6390 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6391 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6392 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6393 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6394 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6395 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6396 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6397 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6405 c------------------------------------------------------------------------------
6406 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6408 C This subroutine calculates multi-body contributions to hydrogen-bonding
6409 implicit real*8 (a-h,o-z)
6410 include 'DIMENSIONS'
6411 include 'COMMON.IOUNITS'
6414 parameter (max_cont=maxconts)
6415 parameter (max_dim=70)
6416 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6417 double precision zapas(max_dim,maxconts,max_fg_procs),
6418 & zapas_recv(max_dim,maxconts,max_fg_procs)
6419 common /przechowalnia/ zapas
6420 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6421 & status_array(MPI_STATUS_SIZE,maxconts*2)
6423 include 'COMMON.SETUP'
6424 include 'COMMON.FFIELD'
6425 include 'COMMON.DERIV'
6426 include 'COMMON.LOCAL'
6427 include 'COMMON.INTERACT'
6428 include 'COMMON.CONTACTS'
6429 include 'COMMON.CHAIN'
6430 include 'COMMON.CONTROL'
6431 double precision gx(3),gx1(3)
6432 integer num_cont_hb_old(maxres)
6434 double precision eello4,eello5,eelo6,eello_turn6
6435 external eello4,eello5,eello6,eello_turn6
6436 C Set lprn=.true. for debugging
6441 num_cont_hb_old(i)=num_cont_hb(i)
6445 if (nfgtasks.le.1) goto 30
6447 write (iout,'(a)') 'Contact function values before RECEIVE:'
6449 write (iout,'(2i3,50(1x,i2,f5.2))')
6450 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6451 & j=1,num_cont_hb(i))
6455 do i=1,ntask_cont_from
6458 do i=1,ntask_cont_to
6461 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6463 C Make the list of contacts to send to send to other procesors
6464 do i=iturn3_start,iturn3_end
6465 c write (iout,*) "make contact list turn3",i," num_cont",
6467 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6469 do i=iturn4_start,iturn4_end
6470 c write (iout,*) "make contact list turn4",i," num_cont",
6472 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6476 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6478 do j=1,num_cont_hb(i)
6481 iproc=iint_sent_local(k,jjc,ii)
6482 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6483 if (iproc.ne.0) then
6484 ncont_sent(iproc)=ncont_sent(iproc)+1
6485 nn=ncont_sent(iproc)
6487 zapas(2,nn,iproc)=jjc
6488 zapas(3,nn,iproc)=d_cont(j,i)
6492 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6497 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6505 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6516 & "Numbers of contacts to be sent to other processors",
6517 & (ncont_sent(i),i=1,ntask_cont_to)
6518 write (iout,*) "Contacts sent"
6519 do ii=1,ntask_cont_to
6521 iproc=itask_cont_to(ii)
6522 write (iout,*) nn," contacts to processor",iproc,
6523 & " of CONT_TO_COMM group"
6525 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6533 CorrelID1=nfgtasks+fg_rank+1
6535 C Receive the numbers of needed contacts from other processors
6536 do ii=1,ntask_cont_from
6537 iproc=itask_cont_from(ii)
6539 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6540 & FG_COMM,req(ireq),IERR)
6542 c write (iout,*) "IRECV ended"
6544 C Send the number of contacts needed by other processors
6545 do ii=1,ntask_cont_to
6546 iproc=itask_cont_to(ii)
6548 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6549 & FG_COMM,req(ireq),IERR)
6551 c write (iout,*) "ISEND ended"
6552 c write (iout,*) "number of requests (nn)",ireq
6555 & call MPI_Waitall(ireq,req,status_array,ierr)
6557 c & "Numbers of contacts to be received from other processors",
6558 c & (ncont_recv(i),i=1,ntask_cont_from)
6562 do ii=1,ntask_cont_from
6563 iproc=itask_cont_from(ii)
6565 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6566 c & " of CONT_TO_COMM group"
6570 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6571 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6572 c write (iout,*) "ireq,req",ireq,req(ireq)
6575 C Send the contacts to processors that need them
6576 do ii=1,ntask_cont_to
6577 iproc=itask_cont_to(ii)
6579 c write (iout,*) nn," contacts to processor",iproc,
6580 c & " of CONT_TO_COMM group"
6583 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6584 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6585 c write (iout,*) "ireq,req",ireq,req(ireq)
6587 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6591 c write (iout,*) "number of requests (contacts)",ireq
6592 c write (iout,*) "req",(req(i),i=1,4)
6595 & call MPI_Waitall(ireq,req,status_array,ierr)
6596 do iii=1,ntask_cont_from
6597 iproc=itask_cont_from(iii)
6600 write (iout,*) "Received",nn," contacts from processor",iproc,
6601 & " of CONT_FROM_COMM group"
6604 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6609 ii=zapas_recv(1,i,iii)
6610 c Flag the received contacts to prevent double-counting
6611 jj=-zapas_recv(2,i,iii)
6612 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6614 nnn=num_cont_hb(ii)+1
6617 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6621 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6626 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6634 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6643 write (iout,'(a)') 'Contact function values after receive:'
6645 write (iout,'(2i3,50(1x,i3,5f6.3))')
6646 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6647 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6654 write (iout,'(a)') 'Contact function values:'
6656 write (iout,'(2i3,50(1x,i2,5f6.3))')
6657 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6658 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6664 C Remove the loop below after debugging !!!
6671 C Calculate the dipole-dipole interaction energies
6672 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6673 do i=iatel_s,iatel_e+1
6674 num_conti=num_cont_hb(i)
6683 C Calculate the local-electrostatic correlation terms
6684 c write (iout,*) "gradcorr5 in eello5 before loop"
6686 c write (iout,'(i5,3f10.5)')
6687 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6689 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6690 c write (iout,*) "corr loop i",i
6692 num_conti=num_cont_hb(i)
6693 num_conti1=num_cont_hb(i+1)
6700 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6701 c & ' jj=',jj,' kk=',kk
6702 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6703 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6704 & .or. j.lt.0 .and. j1.gt.0) .and.
6705 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6706 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6707 C The system gains extra energy.
6709 sqd1=dsqrt(d_cont(jj,i))
6710 sqd2=dsqrt(d_cont(kk,i1))
6711 sred_geom = sqd1*sqd2
6712 IF (sred_geom.lt.cutoff_corr) THEN
6713 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6715 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6716 cd & ' jj=',jj,' kk=',kk
6717 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6718 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6720 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6721 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6724 cd write (iout,*) 'sred_geom=',sred_geom,
6725 cd & ' ekont=',ekont,' fprim=',fprimcont,
6726 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6727 cd write (iout,*) "g_contij",g_contij
6728 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6729 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6730 call calc_eello(i,jp,i+1,jp1,jj,kk)
6731 if (wcorr4.gt.0.0d0)
6732 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6733 if (energy_dec.and.wcorr4.gt.0.0d0)
6734 1 write (iout,'(a6,4i5,0pf7.3)')
6735 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6736 c write (iout,*) "gradcorr5 before eello5"
6738 c write (iout,'(i5,3f10.5)')
6739 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6741 if (wcorr5.gt.0.0d0)
6742 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6743 c write (iout,*) "gradcorr5 after eello5"
6745 c write (iout,'(i5,3f10.5)')
6746 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6748 if (energy_dec.and.wcorr5.gt.0.0d0)
6749 1 write (iout,'(a6,4i5,0pf7.3)')
6750 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6751 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6752 cd write(2,*)'ijkl',i,jp,i+1,jp1
6753 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6754 & .or. wturn6.eq.0.0d0))then
6755 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6756 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6757 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6758 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6759 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6760 cd & 'ecorr6=',ecorr6
6761 cd write (iout,'(4e15.5)') sred_geom,
6762 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6763 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6764 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6765 else if (wturn6.gt.0.0d0
6766 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6767 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6768 eturn6=eturn6+eello_turn6(i,jj,kk)
6769 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6770 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6771 cd write (2,*) 'multibody_eello:eturn6',eturn6
6780 num_cont_hb(i)=num_cont_hb_old(i)
6782 c write (iout,*) "gradcorr5 in eello5"
6784 c write (iout,'(i5,3f10.5)')
6785 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6789 c------------------------------------------------------------------------------
6790 subroutine add_hb_contact_eello(ii,jj,itask)
6791 implicit real*8 (a-h,o-z)
6792 include "DIMENSIONS"
6793 include "COMMON.IOUNITS"
6796 parameter (max_cont=maxconts)
6797 parameter (max_dim=70)
6798 include "COMMON.CONTACTS"
6799 double precision zapas(max_dim,maxconts,max_fg_procs),
6800 & zapas_recv(max_dim,maxconts,max_fg_procs)
6801 common /przechowalnia/ zapas
6802 integer i,j,ii,jj,iproc,itask(4),nn
6803 c write (iout,*) "itask",itask
6806 if (iproc.gt.0) then
6807 do j=1,num_cont_hb(ii)
6809 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6811 ncont_sent(iproc)=ncont_sent(iproc)+1
6812 nn=ncont_sent(iproc)
6813 zapas(1,nn,iproc)=ii
6814 zapas(2,nn,iproc)=jjc
6815 zapas(3,nn,iproc)=d_cont(j,ii)
6819 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6824 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6832 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6844 c------------------------------------------------------------------------------
6845 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6846 implicit real*8 (a-h,o-z)
6847 include 'DIMENSIONS'
6848 include 'COMMON.IOUNITS'
6849 include 'COMMON.DERIV'
6850 include 'COMMON.INTERACT'
6851 include 'COMMON.CONTACTS'
6852 double precision gx(3),gx1(3)
6862 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6863 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6864 C Following 4 lines for diagnostics.
6869 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6870 c & 'Contacts ',i,j,
6871 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6872 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6874 C Calculate the multi-body contribution to energy.
6875 c ecorr=ecorr+ekont*ees
6876 C Calculate multi-body contributions to the gradient.
6877 coeffpees0pij=coeffp*ees0pij
6878 coeffmees0mij=coeffm*ees0mij
6879 coeffpees0pkl=coeffp*ees0pkl
6880 coeffmees0mkl=coeffm*ees0mkl
6882 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6883 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6884 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6885 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6886 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6887 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6888 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6889 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6890 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6891 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6892 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6893 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6894 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6895 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6896 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6897 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6898 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6899 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6900 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6901 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6902 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6903 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6904 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6905 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6906 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6911 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6912 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6913 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6914 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6919 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6920 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6921 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6922 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6925 c write (iout,*) "ehbcorr",ekont*ees
6930 C---------------------------------------------------------------------------
6931 subroutine dipole(i,j,jj)
6932 implicit real*8 (a-h,o-z)
6933 include 'DIMENSIONS'
6934 include 'COMMON.IOUNITS'
6935 include 'COMMON.CHAIN'
6936 include 'COMMON.FFIELD'
6937 include 'COMMON.DERIV'
6938 include 'COMMON.INTERACT'
6939 include 'COMMON.CONTACTS'
6940 include 'COMMON.TORSION'
6941 include 'COMMON.VAR'
6942 include 'COMMON.GEO'
6943 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6945 iti1 = itortyp(itype(i+1))
6946 if (j.lt.nres-1) then
6947 itj1 = itortyp(itype(j+1))
6952 dipi(iii,1)=Ub2(iii,i)
6953 dipderi(iii)=Ub2der(iii,i)
6954 dipi(iii,2)=b1(iii,iti1)
6955 dipj(iii,1)=Ub2(iii,j)
6956 dipderj(iii)=Ub2der(iii,j)
6957 dipj(iii,2)=b1(iii,itj1)
6961 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6964 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6971 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6975 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6980 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6981 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6983 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6985 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6987 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6992 C---------------------------------------------------------------------------
6993 subroutine calc_eello(i,j,k,l,jj,kk)
6995 C This subroutine computes matrices and vectors needed to calculate
6996 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6998 implicit real*8 (a-h,o-z)
6999 include 'DIMENSIONS'
7000 include 'COMMON.IOUNITS'
7001 include 'COMMON.CHAIN'
7002 include 'COMMON.DERIV'
7003 include 'COMMON.INTERACT'
7004 include 'COMMON.CONTACTS'
7005 include 'COMMON.TORSION'
7006 include 'COMMON.VAR'
7007 include 'COMMON.GEO'
7008 include 'COMMON.FFIELD'
7009 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7010 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7013 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7014 cd & ' jj=',jj,' kk=',kk
7015 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7016 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7017 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7020 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7021 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7024 call transpose2(aa1(1,1),aa1t(1,1))
7025 call transpose2(aa2(1,1),aa2t(1,1))
7028 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7029 & aa1tder(1,1,lll,kkk))
7030 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7031 & aa2tder(1,1,lll,kkk))
7035 C parallel orientation of the two CA-CA-CA frames.
7037 iti=itortyp(itype(i))
7041 itk1=itortyp(itype(k+1))
7042 itj=itortyp(itype(j))
7043 if (l.lt.nres-1) then
7044 itl1=itortyp(itype(l+1))
7048 C A1 kernel(j+1) A2T
7050 cd write (iout,'(3f10.5,5x,3f10.5)')
7051 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7053 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7054 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7055 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7056 C Following matrices are needed only for 6-th order cumulants
7057 IF (wcorr6.gt.0.0d0) THEN
7058 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7059 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7060 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7061 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7062 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7063 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7064 & ADtEAderx(1,1,1,1,1,1))
7066 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7067 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7068 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7069 & ADtEA1derx(1,1,1,1,1,1))
7071 C End 6-th order cumulants
7074 cd write (2,*) 'In calc_eello6'
7076 cd write (2,*) 'iii=',iii
7078 cd write (2,*) 'kkk=',kkk
7080 cd write (2,'(3(2f10.5),5x)')
7081 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7086 call transpose2(EUgder(1,1,k),auxmat(1,1))
7087 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7088 call transpose2(EUg(1,1,k),auxmat(1,1))
7089 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7090 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7094 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7095 & EAEAderx(1,1,lll,kkk,iii,1))
7099 C A1T kernel(i+1) A2
7100 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7101 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7102 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7103 C Following matrices are needed only for 6-th order cumulants
7104 IF (wcorr6.gt.0.0d0) THEN
7105 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7106 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7107 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7108 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7109 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7110 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7111 & ADtEAderx(1,1,1,1,1,2))
7112 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7113 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7114 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7115 & ADtEA1derx(1,1,1,1,1,2))
7117 C End 6-th order cumulants
7118 call transpose2(EUgder(1,1,l),auxmat(1,1))
7119 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7120 call transpose2(EUg(1,1,l),auxmat(1,1))
7121 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7122 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7126 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7127 & EAEAderx(1,1,lll,kkk,iii,2))
7132 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7133 C They are needed only when the fifth- or the sixth-order cumulants are
7135 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7136 call transpose2(AEA(1,1,1),auxmat(1,1))
7137 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7138 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7139 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7140 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7142 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7143 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7144 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7145 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7146 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7147 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7148 call transpose2(AEA(1,1,2),auxmat(1,1))
7149 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7150 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7151 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7152 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7153 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7154 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7155 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7156 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7157 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7158 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7159 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7160 C Calculate the Cartesian derivatives of the vectors.
7164 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7165 call matvec2(auxmat(1,1),b1(1,iti),
7166 & AEAb1derx(1,lll,kkk,iii,1,1))
7167 call matvec2(auxmat(1,1),Ub2(1,i),
7168 & AEAb2derx(1,lll,kkk,iii,1,1))
7169 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7170 & AEAb1derx(1,lll,kkk,iii,2,1))
7171 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7172 & AEAb2derx(1,lll,kkk,iii,2,1))
7173 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7174 call matvec2(auxmat(1,1),b1(1,itj),
7175 & AEAb1derx(1,lll,kkk,iii,1,2))
7176 call matvec2(auxmat(1,1),Ub2(1,j),
7177 & AEAb2derx(1,lll,kkk,iii,1,2))
7178 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7179 & AEAb1derx(1,lll,kkk,iii,2,2))
7180 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7181 & AEAb2derx(1,lll,kkk,iii,2,2))
7188 C Antiparallel orientation of the two CA-CA-CA frames.
7190 iti=itortyp(itype(i))
7194 itk1=itortyp(itype(k+1))
7195 itl=itortyp(itype(l))
7196 itj=itortyp(itype(j))
7197 if (j.lt.nres-1) then
7198 itj1=itortyp(itype(j+1))
7202 C A2 kernel(j-1)T A1T
7203 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7204 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7205 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7206 C Following matrices are needed only for 6-th order cumulants
7207 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7208 & j.eq.i+4 .and. l.eq.i+3)) THEN
7209 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7210 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7211 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7212 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7213 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7214 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7215 & ADtEAderx(1,1,1,1,1,1))
7216 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7217 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7218 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7219 & ADtEA1derx(1,1,1,1,1,1))
7221 C End 6-th order cumulants
7222 call transpose2(EUgder(1,1,k),auxmat(1,1))
7223 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7224 call transpose2(EUg(1,1,k),auxmat(1,1))
7225 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7226 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7230 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7231 & EAEAderx(1,1,lll,kkk,iii,1))
7235 C A2T kernel(i+1)T A1
7236 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7237 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7238 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7239 C Following matrices are needed only for 6-th order cumulants
7240 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7241 & j.eq.i+4 .and. l.eq.i+3)) THEN
7242 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7243 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7244 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7245 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7246 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7247 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7248 & ADtEAderx(1,1,1,1,1,2))
7249 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7250 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7251 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7252 & ADtEA1derx(1,1,1,1,1,2))
7254 C End 6-th order cumulants
7255 call transpose2(EUgder(1,1,j),auxmat(1,1))
7256 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7257 call transpose2(EUg(1,1,j),auxmat(1,1))
7258 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7259 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7263 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7264 & EAEAderx(1,1,lll,kkk,iii,2))
7269 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7270 C They are needed only when the fifth- or the sixth-order cumulants are
7272 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7273 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7274 call transpose2(AEA(1,1,1),auxmat(1,1))
7275 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7276 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7277 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7278 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7279 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7280 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7281 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7282 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7283 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7284 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7285 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7286 call transpose2(AEA(1,1,2),auxmat(1,1))
7287 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7288 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7289 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7290 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7291 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7292 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7293 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7294 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7295 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7296 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7297 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7298 C Calculate the Cartesian derivatives of the vectors.
7302 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7303 call matvec2(auxmat(1,1),b1(1,iti),
7304 & AEAb1derx(1,lll,kkk,iii,1,1))
7305 call matvec2(auxmat(1,1),Ub2(1,i),
7306 & AEAb2derx(1,lll,kkk,iii,1,1))
7307 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7308 & AEAb1derx(1,lll,kkk,iii,2,1))
7309 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7310 & AEAb2derx(1,lll,kkk,iii,2,1))
7311 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7312 call matvec2(auxmat(1,1),b1(1,itl),
7313 & AEAb1derx(1,lll,kkk,iii,1,2))
7314 call matvec2(auxmat(1,1),Ub2(1,l),
7315 & AEAb2derx(1,lll,kkk,iii,1,2))
7316 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7317 & AEAb1derx(1,lll,kkk,iii,2,2))
7318 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7319 & AEAb2derx(1,lll,kkk,iii,2,2))
7328 C---------------------------------------------------------------------------
7329 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7330 & KK,KKderg,AKA,AKAderg,AKAderx)
7334 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7335 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7336 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7341 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7343 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7346 cd if (lprn) write (2,*) 'In kernel'
7348 cd if (lprn) write (2,*) 'kkk=',kkk
7350 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7351 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7353 cd write (2,*) 'lll=',lll
7354 cd write (2,*) 'iii=1'
7356 cd write (2,'(3(2f10.5),5x)')
7357 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7360 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7361 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7363 cd write (2,*) 'lll=',lll
7364 cd write (2,*) 'iii=2'
7366 cd write (2,'(3(2f10.5),5x)')
7367 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7374 C---------------------------------------------------------------------------
7375 double precision function eello4(i,j,k,l,jj,kk)
7376 implicit real*8 (a-h,o-z)
7377 include 'DIMENSIONS'
7378 include 'COMMON.IOUNITS'
7379 include 'COMMON.CHAIN'
7380 include 'COMMON.DERIV'
7381 include 'COMMON.INTERACT'
7382 include 'COMMON.CONTACTS'
7383 include 'COMMON.TORSION'
7384 include 'COMMON.VAR'
7385 include 'COMMON.GEO'
7386 double precision pizda(2,2),ggg1(3),ggg2(3)
7387 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7391 cd print *,'eello4:',i,j,k,l,jj,kk
7392 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7393 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7394 cold eij=facont_hb(jj,i)
7395 cold ekl=facont_hb(kk,k)
7397 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7398 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7399 gcorr_loc(k-1)=gcorr_loc(k-1)
7400 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7402 gcorr_loc(l-1)=gcorr_loc(l-1)
7403 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7405 gcorr_loc(j-1)=gcorr_loc(j-1)
7406 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7411 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7412 & -EAEAderx(2,2,lll,kkk,iii,1)
7413 cd derx(lll,kkk,iii)=0.0d0
7417 cd gcorr_loc(l-1)=0.0d0
7418 cd gcorr_loc(j-1)=0.0d0
7419 cd gcorr_loc(k-1)=0.0d0
7421 cd write (iout,*)'Contacts have occurred for peptide groups',
7422 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7423 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7424 if (j.lt.nres-1) then
7431 if (l.lt.nres-1) then
7439 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7440 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7441 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7442 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7443 cgrad ghalf=0.5d0*ggg1(ll)
7444 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7445 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7446 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7447 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7448 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7449 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7450 cgrad ghalf=0.5d0*ggg2(ll)
7451 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7452 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7453 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7454 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7455 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7456 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7460 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7465 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7470 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7475 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7479 cd write (2,*) iii,gcorr_loc(iii)
7482 cd write (2,*) 'ekont',ekont
7483 cd write (iout,*) 'eello4',ekont*eel4
7486 C---------------------------------------------------------------------------
7487 double precision function eello5(i,j,k,l,jj,kk)
7488 implicit real*8 (a-h,o-z)
7489 include 'DIMENSIONS'
7490 include 'COMMON.IOUNITS'
7491 include 'COMMON.CHAIN'
7492 include 'COMMON.DERIV'
7493 include 'COMMON.INTERACT'
7494 include 'COMMON.CONTACTS'
7495 include 'COMMON.TORSION'
7496 include 'COMMON.VAR'
7497 include 'COMMON.GEO'
7498 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7499 double precision ggg1(3),ggg2(3)
7500 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7505 C /l\ / \ \ / \ / \ / C
7506 C / \ / \ \ / \ / \ / C
7507 C j| o |l1 | o | o| o | | o |o C
7508 C \ |/k\| |/ \| / |/ \| |/ \| C
7509 C \i/ \ / \ / / \ / \ C
7511 C (I) (II) (III) (IV) C
7513 C eello5_1 eello5_2 eello5_3 eello5_4 C
7515 C Antiparallel chains C
7518 C /j\ / \ \ / \ / \ / C
7519 C / \ / \ \ / \ / \ / C
7520 C j1| o |l | o | o| o | | o |o C
7521 C \ |/k\| |/ \| / |/ \| |/ \| C
7522 C \i/ \ / \ / / \ / \ C
7524 C (I) (II) (III) (IV) C
7526 C eello5_1 eello5_2 eello5_3 eello5_4 C
7528 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7530 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7531 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7536 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7538 itk=itortyp(itype(k))
7539 itl=itortyp(itype(l))
7540 itj=itortyp(itype(j))
7545 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7546 cd & eel5_3_num,eel5_4_num)
7550 derx(lll,kkk,iii)=0.0d0
7554 cd eij=facont_hb(jj,i)
7555 cd ekl=facont_hb(kk,k)
7557 cd write (iout,*)'Contacts have occurred for peptide groups',
7558 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7560 C Contribution from the graph I.
7561 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7562 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7563 call transpose2(EUg(1,1,k),auxmat(1,1))
7564 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7565 vv(1)=pizda(1,1)-pizda(2,2)
7566 vv(2)=pizda(1,2)+pizda(2,1)
7567 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7568 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7569 C Explicit gradient in virtual-dihedral angles.
7570 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7571 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7572 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7573 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7574 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7575 vv(1)=pizda(1,1)-pizda(2,2)
7576 vv(2)=pizda(1,2)+pizda(2,1)
7577 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7578 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7579 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7580 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7581 vv(1)=pizda(1,1)-pizda(2,2)
7582 vv(2)=pizda(1,2)+pizda(2,1)
7584 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7585 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7586 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7588 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7589 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7590 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7592 C Cartesian gradient
7596 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7598 vv(1)=pizda(1,1)-pizda(2,2)
7599 vv(2)=pizda(1,2)+pizda(2,1)
7600 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7601 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7602 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7608 C Contribution from graph II
7609 call transpose2(EE(1,1,itk),auxmat(1,1))
7610 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7611 vv(1)=pizda(1,1)+pizda(2,2)
7612 vv(2)=pizda(2,1)-pizda(1,2)
7613 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7614 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7615 C Explicit gradient in virtual-dihedral angles.
7616 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7617 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7618 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7619 vv(1)=pizda(1,1)+pizda(2,2)
7620 vv(2)=pizda(2,1)-pizda(1,2)
7622 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7623 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7624 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7626 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7627 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7628 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7630 C Cartesian gradient
7634 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7636 vv(1)=pizda(1,1)+pizda(2,2)
7637 vv(2)=pizda(2,1)-pizda(1,2)
7638 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7639 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7640 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7648 C Parallel orientation
7649 C Contribution from graph III
7650 call transpose2(EUg(1,1,l),auxmat(1,1))
7651 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7652 vv(1)=pizda(1,1)-pizda(2,2)
7653 vv(2)=pizda(1,2)+pizda(2,1)
7654 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7655 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7656 C Explicit gradient in virtual-dihedral angles.
7657 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7658 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7659 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7660 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7661 vv(1)=pizda(1,1)-pizda(2,2)
7662 vv(2)=pizda(1,2)+pizda(2,1)
7663 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7664 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7665 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7666 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7667 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7668 vv(1)=pizda(1,1)-pizda(2,2)
7669 vv(2)=pizda(1,2)+pizda(2,1)
7670 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7671 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7672 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7673 C Cartesian gradient
7677 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7679 vv(1)=pizda(1,1)-pizda(2,2)
7680 vv(2)=pizda(1,2)+pizda(2,1)
7681 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7682 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7683 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7688 C Contribution from graph IV
7690 call transpose2(EE(1,1,itl),auxmat(1,1))
7691 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7692 vv(1)=pizda(1,1)+pizda(2,2)
7693 vv(2)=pizda(2,1)-pizda(1,2)
7694 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7695 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7696 C Explicit gradient in virtual-dihedral angles.
7697 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7698 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7699 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7700 vv(1)=pizda(1,1)+pizda(2,2)
7701 vv(2)=pizda(2,1)-pizda(1,2)
7702 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7703 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7704 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7705 C Cartesian gradient
7709 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7711 vv(1)=pizda(1,1)+pizda(2,2)
7712 vv(2)=pizda(2,1)-pizda(1,2)
7713 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7714 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7715 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7720 C Antiparallel orientation
7721 C Contribution from graph III
7723 call transpose2(EUg(1,1,j),auxmat(1,1))
7724 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7725 vv(1)=pizda(1,1)-pizda(2,2)
7726 vv(2)=pizda(1,2)+pizda(2,1)
7727 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7728 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7729 C Explicit gradient in virtual-dihedral angles.
7730 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7731 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7732 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7733 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7734 vv(1)=pizda(1,1)-pizda(2,2)
7735 vv(2)=pizda(1,2)+pizda(2,1)
7736 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7737 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7738 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7739 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7740 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7741 vv(1)=pizda(1,1)-pizda(2,2)
7742 vv(2)=pizda(1,2)+pizda(2,1)
7743 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7744 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7745 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7746 C Cartesian gradient
7750 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7752 vv(1)=pizda(1,1)-pizda(2,2)
7753 vv(2)=pizda(1,2)+pizda(2,1)
7754 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7755 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7756 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7761 C Contribution from graph IV
7763 call transpose2(EE(1,1,itj),auxmat(1,1))
7764 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7765 vv(1)=pizda(1,1)+pizda(2,2)
7766 vv(2)=pizda(2,1)-pizda(1,2)
7767 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7768 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7769 C Explicit gradient in virtual-dihedral angles.
7770 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7771 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7772 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7773 vv(1)=pizda(1,1)+pizda(2,2)
7774 vv(2)=pizda(2,1)-pizda(1,2)
7775 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7776 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7777 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7778 C Cartesian gradient
7782 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7784 vv(1)=pizda(1,1)+pizda(2,2)
7785 vv(2)=pizda(2,1)-pizda(1,2)
7786 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7787 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7788 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7794 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7795 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7796 cd write (2,*) 'ijkl',i,j,k,l
7797 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7798 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7800 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7801 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7802 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7803 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7804 if (j.lt.nres-1) then
7811 if (l.lt.nres-1) then
7821 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7822 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7823 C summed up outside the subrouine as for the other subroutines
7824 C handling long-range interactions. The old code is commented out
7825 C with "cgrad" to keep track of changes.
7827 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7828 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7829 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7830 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7831 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7832 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7833 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7834 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7835 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7836 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7838 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7839 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7840 cgrad ghalf=0.5d0*ggg1(ll)
7842 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7843 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7844 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7845 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7846 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7847 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7848 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7849 cgrad ghalf=0.5d0*ggg2(ll)
7851 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7852 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7853 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7854 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7855 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7856 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7861 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7862 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7867 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7868 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7874 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7879 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7883 cd write (2,*) iii,g_corr5_loc(iii)
7886 cd write (2,*) 'ekont',ekont
7887 cd write (iout,*) 'eello5',ekont*eel5
7890 c--------------------------------------------------------------------------
7891 double precision function eello6(i,j,k,l,jj,kk)
7892 implicit real*8 (a-h,o-z)
7893 include 'DIMENSIONS'
7894 include 'COMMON.IOUNITS'
7895 include 'COMMON.CHAIN'
7896 include 'COMMON.DERIV'
7897 include 'COMMON.INTERACT'
7898 include 'COMMON.CONTACTS'
7899 include 'COMMON.TORSION'
7900 include 'COMMON.VAR'
7901 include 'COMMON.GEO'
7902 include 'COMMON.FFIELD'
7903 double precision ggg1(3),ggg2(3)
7904 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7909 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7917 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7918 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7922 derx(lll,kkk,iii)=0.0d0
7926 cd eij=facont_hb(jj,i)
7927 cd ekl=facont_hb(kk,k)
7933 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7934 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7935 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7936 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7937 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7938 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7940 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7941 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7942 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7943 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7944 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7945 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7949 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7951 C If turn contributions are considered, they will be handled separately.
7952 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7953 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7954 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7955 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7956 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7957 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7958 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7960 if (j.lt.nres-1) then
7967 if (l.lt.nres-1) then
7975 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7976 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7977 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7978 cgrad ghalf=0.5d0*ggg1(ll)
7980 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7981 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7982 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7983 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7984 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7985 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7986 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7987 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7988 cgrad ghalf=0.5d0*ggg2(ll)
7989 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7991 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7992 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7993 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7994 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7995 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7996 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8001 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8002 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8007 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8008 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8014 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8019 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8023 cd write (2,*) iii,g_corr6_loc(iii)
8026 cd write (2,*) 'ekont',ekont
8027 cd write (iout,*) 'eello6',ekont*eel6
8030 c--------------------------------------------------------------------------
8031 double precision function eello6_graph1(i,j,k,l,imat,swap)
8032 implicit real*8 (a-h,o-z)
8033 include 'DIMENSIONS'
8034 include 'COMMON.IOUNITS'
8035 include 'COMMON.CHAIN'
8036 include 'COMMON.DERIV'
8037 include 'COMMON.INTERACT'
8038 include 'COMMON.CONTACTS'
8039 include 'COMMON.TORSION'
8040 include 'COMMON.VAR'
8041 include 'COMMON.GEO'
8042 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8046 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8048 C Parallel Antiparallel C
8054 C \ j|/k\| / \ |/k\|l / C
8059 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8060 itk=itortyp(itype(k))
8061 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8062 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8063 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8064 call transpose2(EUgC(1,1,k),auxmat(1,1))
8065 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8066 vv1(1)=pizda1(1,1)-pizda1(2,2)
8067 vv1(2)=pizda1(1,2)+pizda1(2,1)
8068 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8069 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8070 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8071 s5=scalar2(vv(1),Dtobr2(1,i))
8072 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8073 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8074 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8075 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8076 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8077 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8078 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8079 & +scalar2(vv(1),Dtobr2der(1,i)))
8080 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8081 vv1(1)=pizda1(1,1)-pizda1(2,2)
8082 vv1(2)=pizda1(1,2)+pizda1(2,1)
8083 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8084 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8086 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8087 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8088 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8089 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8090 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8092 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8093 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8094 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8095 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8096 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8098 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8099 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8100 vv1(1)=pizda1(1,1)-pizda1(2,2)
8101 vv1(2)=pizda1(1,2)+pizda1(2,1)
8102 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8103 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8104 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8105 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8114 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8115 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8116 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8117 call transpose2(EUgC(1,1,k),auxmat(1,1))
8118 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8120 vv1(1)=pizda1(1,1)-pizda1(2,2)
8121 vv1(2)=pizda1(1,2)+pizda1(2,1)
8122 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8123 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8124 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8125 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8126 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8127 s5=scalar2(vv(1),Dtobr2(1,i))
8128 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8134 c----------------------------------------------------------------------------
8135 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8136 implicit real*8 (a-h,o-z)
8137 include 'DIMENSIONS'
8138 include 'COMMON.IOUNITS'
8139 include 'COMMON.CHAIN'
8140 include 'COMMON.DERIV'
8141 include 'COMMON.INTERACT'
8142 include 'COMMON.CONTACTS'
8143 include 'COMMON.TORSION'
8144 include 'COMMON.VAR'
8145 include 'COMMON.GEO'
8147 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8148 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8151 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8153 C Parallel Antiparallel C
8159 C \ j|/k\| \ |/k\|l C
8164 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8165 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8166 C AL 7/4/01 s1 would occur in the sixth-order moment,
8167 C but not in a cluster cumulant
8169 s1=dip(1,jj,i)*dip(1,kk,k)
8171 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8172 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8173 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8174 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8175 call transpose2(EUg(1,1,k),auxmat(1,1))
8176 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8177 vv(1)=pizda(1,1)-pizda(2,2)
8178 vv(2)=pizda(1,2)+pizda(2,1)
8179 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8180 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8182 eello6_graph2=-(s1+s2+s3+s4)
8184 eello6_graph2=-(s2+s3+s4)
8187 C Derivatives in gamma(i-1)
8190 s1=dipderg(1,jj,i)*dip(1,kk,k)
8192 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8193 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8194 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8195 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8197 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8199 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8201 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8203 C Derivatives in gamma(k-1)
8205 s1=dip(1,jj,i)*dipderg(1,kk,k)
8207 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8208 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8209 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8210 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8211 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8212 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8213 vv(1)=pizda(1,1)-pizda(2,2)
8214 vv(2)=pizda(1,2)+pizda(2,1)
8215 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8217 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8219 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8221 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8222 C Derivatives in gamma(j-1) or gamma(l-1)
8225 s1=dipderg(3,jj,i)*dip(1,kk,k)
8227 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8228 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8229 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8230 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8231 vv(1)=pizda(1,1)-pizda(2,2)
8232 vv(2)=pizda(1,2)+pizda(2,1)
8233 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8236 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8238 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8241 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8242 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8244 C Derivatives in gamma(l-1) or gamma(j-1)
8247 s1=dip(1,jj,i)*dipderg(3,kk,k)
8249 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8250 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8251 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8252 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8253 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8254 vv(1)=pizda(1,1)-pizda(2,2)
8255 vv(2)=pizda(1,2)+pizda(2,1)
8256 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8259 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8261 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8264 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8265 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8267 C Cartesian derivatives.
8269 write (2,*) 'In eello6_graph2'
8271 write (2,*) 'iii=',iii
8273 write (2,*) 'kkk=',kkk
8275 write (2,'(3(2f10.5),5x)')
8276 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8286 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8288 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8291 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8293 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8294 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8296 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8297 call transpose2(EUg(1,1,k),auxmat(1,1))
8298 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8300 vv(1)=pizda(1,1)-pizda(2,2)
8301 vv(2)=pizda(1,2)+pizda(2,1)
8302 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8303 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8305 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8307 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8310 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8312 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8319 c----------------------------------------------------------------------------
8320 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8321 implicit real*8 (a-h,o-z)
8322 include 'DIMENSIONS'
8323 include 'COMMON.IOUNITS'
8324 include 'COMMON.CHAIN'
8325 include 'COMMON.DERIV'
8326 include 'COMMON.INTERACT'
8327 include 'COMMON.CONTACTS'
8328 include 'COMMON.TORSION'
8329 include 'COMMON.VAR'
8330 include 'COMMON.GEO'
8331 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8333 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8335 C Parallel Antiparallel C
8341 C j|/k\| / |/k\|l / C
8346 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8348 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8349 C energy moment and not to the cluster cumulant.
8350 iti=itortyp(itype(i))
8351 if (j.lt.nres-1) then
8352 itj1=itortyp(itype(j+1))
8356 itk=itortyp(itype(k))
8357 itk1=itortyp(itype(k+1))
8358 if (l.lt.nres-1) then
8359 itl1=itortyp(itype(l+1))
8364 s1=dip(4,jj,i)*dip(4,kk,k)
8366 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8367 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8368 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8369 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8370 call transpose2(EE(1,1,itk),auxmat(1,1))
8371 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8372 vv(1)=pizda(1,1)+pizda(2,2)
8373 vv(2)=pizda(2,1)-pizda(1,2)
8374 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8375 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8376 cd & "sum",-(s2+s3+s4)
8378 eello6_graph3=-(s1+s2+s3+s4)
8380 eello6_graph3=-(s2+s3+s4)
8383 C Derivatives in gamma(k-1)
8384 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8385 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8386 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8387 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8388 C Derivatives in gamma(l-1)
8389 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8390 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8391 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8392 vv(1)=pizda(1,1)+pizda(2,2)
8393 vv(2)=pizda(2,1)-pizda(1,2)
8394 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8395 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8396 C Cartesian derivatives.
8402 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8404 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8407 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8409 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8410 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8412 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8413 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8415 vv(1)=pizda(1,1)+pizda(2,2)
8416 vv(2)=pizda(2,1)-pizda(1,2)
8417 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8419 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8421 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8424 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8426 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8428 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8434 c----------------------------------------------------------------------------
8435 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8436 implicit real*8 (a-h,o-z)
8437 include 'DIMENSIONS'
8438 include 'COMMON.IOUNITS'
8439 include 'COMMON.CHAIN'
8440 include 'COMMON.DERIV'
8441 include 'COMMON.INTERACT'
8442 include 'COMMON.CONTACTS'
8443 include 'COMMON.TORSION'
8444 include 'COMMON.VAR'
8445 include 'COMMON.GEO'
8446 include 'COMMON.FFIELD'
8447 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8448 & auxvec1(2),auxmat1(2,2)
8450 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8452 C Parallel Antiparallel C
8458 C \ j|/k\| \ |/k\|l C
8463 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8465 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8466 C energy moment and not to the cluster cumulant.
8467 cd write (2,*) 'eello_graph4: wturn6',wturn6
8468 iti=itortyp(itype(i))
8469 itj=itortyp(itype(j))
8470 if (j.lt.nres-1) then
8471 itj1=itortyp(itype(j+1))
8475 itk=itortyp(itype(k))
8476 if (k.lt.nres-1) then
8477 itk1=itortyp(itype(k+1))
8481 itl=itortyp(itype(l))
8482 if (l.lt.nres-1) then
8483 itl1=itortyp(itype(l+1))
8487 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8488 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8489 cd & ' itl',itl,' itl1',itl1
8492 s1=dip(3,jj,i)*dip(3,kk,k)
8494 s1=dip(2,jj,j)*dip(2,kk,l)
8497 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8498 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8500 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8501 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8503 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8504 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8506 call transpose2(EUg(1,1,k),auxmat(1,1))
8507 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8508 vv(1)=pizda(1,1)-pizda(2,2)
8509 vv(2)=pizda(2,1)+pizda(1,2)
8510 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8511 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8513 eello6_graph4=-(s1+s2+s3+s4)
8515 eello6_graph4=-(s2+s3+s4)
8517 C Derivatives in gamma(i-1)
8521 s1=dipderg(2,jj,i)*dip(3,kk,k)
8523 s1=dipderg(4,jj,j)*dip(2,kk,l)
8526 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8528 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8529 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8531 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8532 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8534 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8535 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8536 cd write (2,*) 'turn6 derivatives'
8538 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8540 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8544 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8546 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8550 C Derivatives in gamma(k-1)
8553 s1=dip(3,jj,i)*dipderg(2,kk,k)
8555 s1=dip(2,jj,j)*dipderg(4,kk,l)
8558 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8559 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8561 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8562 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8564 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8565 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8567 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8568 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8569 vv(1)=pizda(1,1)-pizda(2,2)
8570 vv(2)=pizda(2,1)+pizda(1,2)
8571 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8572 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8574 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8576 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8580 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8582 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8585 C Derivatives in gamma(j-1) or gamma(l-1)
8586 if (l.eq.j+1 .and. l.gt.1) then
8587 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8588 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8589 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8590 vv(1)=pizda(1,1)-pizda(2,2)
8591 vv(2)=pizda(2,1)+pizda(1,2)
8592 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8593 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8594 else if (j.gt.1) then
8595 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8596 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8597 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8598 vv(1)=pizda(1,1)-pizda(2,2)
8599 vv(2)=pizda(2,1)+pizda(1,2)
8600 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8601 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8602 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8604 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8607 C Cartesian derivatives.
8614 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8616 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8620 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8622 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8626 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8628 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8630 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8631 & b1(1,itj1),auxvec(1))
8632 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8634 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8635 & b1(1,itl1),auxvec(1))
8636 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8638 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8640 vv(1)=pizda(1,1)-pizda(2,2)
8641 vv(2)=pizda(2,1)+pizda(1,2)
8642 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8644 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8646 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8649 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8652 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8655 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8657 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8659 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8663 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8665 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8668 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8670 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8678 c----------------------------------------------------------------------------
8679 double precision function eello_turn6(i,jj,kk)
8680 implicit real*8 (a-h,o-z)
8681 include 'DIMENSIONS'
8682 include 'COMMON.IOUNITS'
8683 include 'COMMON.CHAIN'
8684 include 'COMMON.DERIV'
8685 include 'COMMON.INTERACT'
8686 include 'COMMON.CONTACTS'
8687 include 'COMMON.TORSION'
8688 include 'COMMON.VAR'
8689 include 'COMMON.GEO'
8690 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8691 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8693 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8694 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8695 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8696 C the respective energy moment and not to the cluster cumulant.
8705 iti=itortyp(itype(i))
8706 itk=itortyp(itype(k))
8707 itk1=itortyp(itype(k+1))
8708 itl=itortyp(itype(l))
8709 itj=itortyp(itype(j))
8710 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8711 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8712 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8717 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8719 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8723 derx_turn(lll,kkk,iii)=0.0d0
8730 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8732 cd write (2,*) 'eello6_5',eello6_5
8734 call transpose2(AEA(1,1,1),auxmat(1,1))
8735 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8736 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8737 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8739 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8740 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8741 s2 = scalar2(b1(1,itk),vtemp1(1))
8743 call transpose2(AEA(1,1,2),atemp(1,1))
8744 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8745 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8746 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8748 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8749 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8750 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8752 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8753 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8754 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8755 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8756 ss13 = scalar2(b1(1,itk),vtemp4(1))
8757 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8759 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8765 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8766 C Derivatives in gamma(i+2)
8770 call transpose2(AEA(1,1,1),auxmatd(1,1))
8771 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8772 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8773 call transpose2(AEAderg(1,1,2),atempd(1,1))
8774 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8775 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8777 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8778 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8779 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8785 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8786 C Derivatives in gamma(i+3)
8788 call transpose2(AEA(1,1,1),auxmatd(1,1))
8789 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8790 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8791 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8793 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8794 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8795 s2d = scalar2(b1(1,itk),vtemp1d(1))
8797 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8798 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8800 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8802 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8803 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8804 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8812 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8813 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8815 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8816 & -0.5d0*ekont*(s2d+s12d)
8818 C Derivatives in gamma(i+4)
8819 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8820 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8821 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8823 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8824 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8825 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8833 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8835 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8837 C Derivatives in gamma(i+5)
8839 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8840 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8841 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8843 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8844 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8845 s2d = scalar2(b1(1,itk),vtemp1d(1))
8847 call transpose2(AEA(1,1,2),atempd(1,1))
8848 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8849 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8851 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8852 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8854 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8855 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8856 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8864 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8865 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8867 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8868 & -0.5d0*ekont*(s2d+s12d)
8870 C Cartesian derivatives
8875 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8876 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8877 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8879 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8880 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8882 s2d = scalar2(b1(1,itk),vtemp1d(1))
8884 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8885 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8886 s8d = -(atempd(1,1)+atempd(2,2))*
8887 & scalar2(cc(1,1,itl),vtemp2(1))
8889 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8891 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8892 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8899 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8902 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8906 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8907 & - 0.5d0*(s8d+s12d)
8909 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8918 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8920 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8921 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8922 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8923 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8924 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8926 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8927 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8928 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8932 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8933 cd & 16*eel_turn6_num
8935 if (j.lt.nres-1) then
8942 if (l.lt.nres-1) then
8950 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8951 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8952 cgrad ghalf=0.5d0*ggg1(ll)
8954 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8955 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8956 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8957 & +ekont*derx_turn(ll,2,1)
8958 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8959 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8960 & +ekont*derx_turn(ll,4,1)
8961 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8962 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8963 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8964 cgrad ghalf=0.5d0*ggg2(ll)
8966 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8967 & +ekont*derx_turn(ll,2,2)
8968 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8969 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8970 & +ekont*derx_turn(ll,4,2)
8971 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8972 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8973 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8978 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8983 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8989 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8994 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8998 cd write (2,*) iii,g_corr6_loc(iii)
9000 eello_turn6=ekont*eel_turn6
9001 cd write (2,*) 'ekont',ekont
9002 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9006 C-----------------------------------------------------------------------------
9007 double precision function scalar(u,v)
9008 !DIR$ INLINEALWAYS scalar
9010 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9013 double precision u(3),v(3)
9014 cd double precision sc
9022 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9025 crc-------------------------------------------------
9026 SUBROUTINE MATVEC2(A1,V1,V2)
9027 !DIR$ INLINEALWAYS MATVEC2
9029 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9031 implicit real*8 (a-h,o-z)
9032 include 'DIMENSIONS'
9033 DIMENSION A1(2,2),V1(2),V2(2)
9037 c 3 VI=VI+A1(I,K)*V1(K)
9041 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9042 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9047 C---------------------------------------
9048 SUBROUTINE MATMAT2(A1,A2,A3)
9050 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9052 implicit real*8 (a-h,o-z)
9053 include 'DIMENSIONS'
9054 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9055 c DIMENSION AI3(2,2)
9059 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9065 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9066 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9067 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9068 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9076 c-------------------------------------------------------------------------
9077 double precision function scalar2(u,v)
9078 !DIR$ INLINEALWAYS scalar2
9080 double precision u(2),v(2)
9083 scalar2=u(1)*v(1)+u(2)*v(2)
9087 C-----------------------------------------------------------------------------
9089 subroutine transpose2(a,at)
9090 !DIR$ INLINEALWAYS transpose2
9092 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9095 double precision a(2,2),at(2,2)
9102 c--------------------------------------------------------------------------
9103 subroutine transpose(n,a,at)
9106 double precision a(n,n),at(n,n)
9114 C---------------------------------------------------------------------------
9115 subroutine prodmat3(a1,a2,kk,transp,prod)
9116 !DIR$ INLINEALWAYS prodmat3
9118 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9122 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9124 crc double precision auxmat(2,2),prod_(2,2)
9127 crc call transpose2(kk(1,1),auxmat(1,1))
9128 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9129 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9131 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9132 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9133 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9134 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9135 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9136 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9137 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9138 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9141 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9142 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9144 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9145 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9146 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9147 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9148 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9149 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9150 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9151 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9154 c call transpose2(a2(1,1),a2t(1,1))
9157 crc print *,((prod_(i,j),i=1,2),j=1,2)
9158 crc print *,((prod(i,j),i=1,2),j=1,2)