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.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
125 cmc Sep-06: egb takes care of dynamic ss bonds too
127 c if (dyn_ss) call dyn_set_nss
129 c print *,"Processor",myrank," computed USCSC"
135 time_vec=time_vec+MPI_Wtime()-time01
137 c print *,"Processor",myrank," left VEC_AND_DERIV"
140 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
146 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
147 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
148 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
150 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
159 c write (iout,*) "Soft-spheer ELEC potential"
160 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
163 c print *,"Processor",myrank," computed UELEC"
165 C Calculate excluded-volume interaction energy between peptide groups
170 call escp(evdw2,evdw2_14)
176 c write (iout,*) "Soft-sphere SCP potential"
177 call escp_soft_sphere(evdw2,evdw2_14)
180 c Calculate the bond-stretching energy
184 C Calculate the disulfide-bridge and other energy and the contributions
185 C from other distance constraints.
186 cd print *,'Calling EHPB'
188 cd print *,'EHPB exitted succesfully.'
190 C Calculate the virtual-bond-angle energy.
192 if (wang.gt.0d0) then
193 call ebend(ebe,ethetacnstr)
197 c print *,"Processor",myrank," computed UB"
199 C Calculate the SC local energy.
202 c print *,"Processor",myrank," computed USC"
204 C Calculate the virtual-bond torsional energy.
206 cd print *,'nterm=',nterm
208 call etor(etors,edihcnstr)
213 c print *,"Processor",myrank," computed Utor"
215 C 6/23/01 Calculate double-torsional energy
217 if (wtor_d.gt.0) then
222 c print *,"Processor",myrank," computed Utord"
224 C 21/5/07 Calculate local sicdechain correlation energy
226 if (wsccor.gt.0.0d0) then
227 call eback_sc_corr(esccor)
231 c print *,"Processor",myrank," computed Usccorr"
233 C 12/1/95 Multi-body terms
237 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
238 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
239 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
240 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
241 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
248 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
250 cd write (iout,*) "multibody_hb ecorr",ecorr
252 c print *,"Processor",myrank," computed Ucorr"
254 C If performing constraint dynamics, call the constraint energy
255 C after the equilibration time
256 if(usampl.and.totT.gt.eq_time) then
264 time_enecalc=time_enecalc+MPI_Wtime()-time00
266 c print *,"Processor",myrank," computed Uconstr"
275 energia(2)=evdw2-evdw2_14
292 energia(8)=eello_turn3
293 energia(9)=eello_turn4
300 energia(19)=edihcnstr
302 energia(20)=Uconst+Uconst_back
305 c Here are the energies showed per procesor if the are more processors
306 c per molecule then we sum it up in sum_energy subroutine
307 c print *," Processor",myrank," calls SUM_ENERGY"
308 call sum_energy(energia,.true.)
309 if (dyn_ss) call dyn_set_nss
310 c print *," Processor",myrank," left SUM_ENERGY"
312 time_sumene=time_sumene+MPI_Wtime()-time00
316 c-------------------------------------------------------------------------------
317 subroutine sum_energy(energia,reduce)
318 implicit real*8 (a-h,o-z)
323 cMS$ATTRIBUTES C :: proc_proc
329 include 'COMMON.SETUP'
330 include 'COMMON.IOUNITS'
331 double precision energia(0:n_ene),enebuff(0:n_ene+1)
332 include 'COMMON.FFIELD'
333 include 'COMMON.DERIV'
334 include 'COMMON.INTERACT'
335 include 'COMMON.SBRIDGE'
336 include 'COMMON.CHAIN'
338 include 'COMMON.CONTROL'
339 include 'COMMON.TIME1'
342 if (nfgtasks.gt.1 .and. reduce) then
344 write (iout,*) "energies before REDUCE"
345 call enerprint(energia)
349 enebuff(i)=energia(i)
352 call MPI_Barrier(FG_COMM,IERR)
353 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
355 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
356 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
358 write (iout,*) "energies after REDUCE"
359 call enerprint(energia)
362 time_Reduce=time_Reduce+MPI_Wtime()-time00
364 if (fg_rank.eq.0) then
368 evdw2=energia(2)+energia(18)
384 eello_turn3=energia(8)
385 eello_turn4=energia(9)
392 edihcnstr=energia(19)
397 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
404 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
405 & +wang*ebe+wtor*etors+wscloc*escloc
406 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
407 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
408 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
409 & +wbond*estr+Uconst+wsccor*esccor
415 if (isnan(etot).ne.0) energia(0)=1.0d+99
417 if (isnan(etot)) energia(0)=1.0d+99
422 idumm=proc_proc(etot,i)
424 call proc_proc(etot,i)
426 if(i.eq.1)energia(0)=1.0d+99
433 c-------------------------------------------------------------------------------
434 subroutine sum_gradient
435 implicit real*8 (a-h,o-z)
440 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)
448 include 'COMMON.SETUP'
449 include 'COMMON.IOUNITS'
450 include 'COMMON.FFIELD'
451 include 'COMMON.DERIV'
452 include 'COMMON.INTERACT'
453 include 'COMMON.SBRIDGE'
454 include 'COMMON.CHAIN'
456 include 'COMMON.CONTROL'
457 include 'COMMON.TIME1'
458 include 'COMMON.MAXGRAD'
459 include 'COMMON.SCCOR'
464 write (iout,*) "sum_gradient gvdwc, gvdwx"
466 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
467 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
472 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
473 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
474 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
477 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
478 C in virtual-bond-vector coordinates
481 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
483 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
484 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
486 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
488 c write (iout,'(i5,3f10.5,2x,f10.5)')
489 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
491 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
493 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
494 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
502 gradbufc(j,i)=wsc*gvdwc(j,i)+
503 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
504 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
505 & wel_loc*gel_loc_long(j,i)+
506 & wcorr*gradcorr_long(j,i)+
507 & wcorr5*gradcorr5_long(j,i)+
508 & wcorr6*gradcorr6_long(j,i)+
509 & wturn6*gcorr6_turn_long(j,i)+
516 gradbufc(j,i)=wsc*gvdwc(j,i)+
517 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
518 & welec*gelc_long(j,i)+
520 & wel_loc*gel_loc_long(j,i)+
521 & wcorr*gradcorr_long(j,i)+
522 & wcorr5*gradcorr5_long(j,i)+
523 & wcorr6*gradcorr6_long(j,i)+
524 & wturn6*gcorr6_turn_long(j,i)+
530 if (nfgtasks.gt.1) then
533 write (iout,*) "gradbufc before allreduce"
535 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
541 gradbufc_sum(j,i)=gradbufc(j,i)
544 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
545 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
546 c time_reduce=time_reduce+MPI_Wtime()-time00
548 c write (iout,*) "gradbufc_sum after allreduce"
550 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
555 c time_allreduce=time_allreduce+MPI_Wtime()-time00
563 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
564 write (iout,*) (i," jgrad_start",jgrad_start(i),
565 & " jgrad_end ",jgrad_end(i),
566 & i=igrad_start,igrad_end)
569 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
570 c do not parallelize this part.
572 c do i=igrad_start,igrad_end
573 c do j=jgrad_start(i),jgrad_end(i)
575 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
580 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
584 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
588 write (iout,*) "gradbufc after summing"
590 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
597 write (iout,*) "gradbufc"
599 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
605 gradbufc_sum(j,i)=gradbufc(j,i)
610 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
614 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
619 c gradbufc(k,i)=0.0d0
623 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
628 write (iout,*) "gradbufc after summing"
630 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
638 gradbufc(k,nres)=0.0d0
643 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
644 & wel_loc*gel_loc(j,i)+
645 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
646 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
647 & wel_loc*gel_loc_long(j,i)+
648 & wcorr*gradcorr_long(j,i)+
649 & wcorr5*gradcorr5_long(j,i)+
650 & wcorr6*gradcorr6_long(j,i)+
651 & wturn6*gcorr6_turn_long(j,i))+
653 & wcorr*gradcorr(j,i)+
654 & wturn3*gcorr3_turn(j,i)+
655 & wturn4*gcorr4_turn(j,i)+
656 & wcorr5*gradcorr5(j,i)+
657 & wcorr6*gradcorr6(j,i)+
658 & wturn6*gcorr6_turn(j,i)+
659 & wsccor*gsccorc(j,i)
660 & +wscloc*gscloc(j,i)
662 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
663 & wel_loc*gel_loc(j,i)+
664 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
665 & welec*gelc_long(j,i)
666 & wel_loc*gel_loc_long(j,i)+
667 & wcorr*gcorr_long(j,i)+
668 & wcorr5*gradcorr5_long(j,i)+
669 & wcorr6*gradcorr6_long(j,i)+
670 & wturn6*gcorr6_turn_long(j,i))+
672 & wcorr*gradcorr(j,i)+
673 & wturn3*gcorr3_turn(j,i)+
674 & wturn4*gcorr4_turn(j,i)+
675 & wcorr5*gradcorr5(j,i)+
676 & wcorr6*gradcorr6(j,i)+
677 & wturn6*gcorr6_turn(j,i)+
678 & wsccor*gsccorc(j,i)
679 & +wscloc*gscloc(j,i)
681 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
683 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
684 & wsccor*gsccorx(j,i)
685 & +wscloc*gsclocx(j,i)
689 write (iout,*) "gloc before adding corr"
691 write (iout,*) i,gloc(i,icg)
695 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
696 & +wcorr5*g_corr5_loc(i)
697 & +wcorr6*g_corr6_loc(i)
698 & +wturn4*gel_loc_turn4(i)
699 & +wturn3*gel_loc_turn3(i)
700 & +wturn6*gel_loc_turn6(i)
701 & +wel_loc*gel_loc_loc(i)
704 write (iout,*) "gloc after adding corr"
706 write (iout,*) i,gloc(i,icg)
710 if (nfgtasks.gt.1) then
713 gradbufc(j,i)=gradc(j,i,icg)
714 gradbufx(j,i)=gradx(j,i,icg)
718 glocbuf(i)=gloc(i,icg)
722 write (iout,*) "gloc_sc before reduce"
725 write (iout,*) i,j,gloc_sc(j,i,icg)
732 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
736 call MPI_Barrier(FG_COMM,IERR)
737 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
739 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
742 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
743 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
744 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
745 time_reduce=time_reduce+MPI_Wtime()-time00
746 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 time_reduce=time_reduce+MPI_Wtime()-time00
751 write (iout,*) "gloc_sc after reduce"
754 write (iout,*) i,j,gloc_sc(j,i,icg)
760 write (iout,*) "gloc after reduce"
762 write (iout,*) i,gloc(i,icg)
767 if (gnorm_check) then
769 c Compute the maximum elements of the gradient
779 gcorr3_turn_max=0.0d0
780 gcorr4_turn_max=0.0d0
783 gcorr6_turn_max=0.0d0
793 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
794 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
795 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
796 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
797 & gvdwc_scp_max=gvdwc_scp_norm
798 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
799 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
800 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
801 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
802 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
803 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
804 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
805 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
806 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
807 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
808 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
809 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
810 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
812 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
813 & gcorr3_turn_max=gcorr3_turn_norm
814 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
816 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
817 & gcorr4_turn_max=gcorr4_turn_norm
818 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
819 if (gradcorr5_norm.gt.gradcorr5_max)
820 & gradcorr5_max=gradcorr5_norm
821 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
822 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
823 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
825 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
826 & gcorr6_turn_max=gcorr6_turn_norm
827 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
828 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
829 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
830 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
831 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
832 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
833 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
834 if (gradx_scp_norm.gt.gradx_scp_max)
835 & gradx_scp_max=gradx_scp_norm
836 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
837 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
838 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
839 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
840 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
841 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
842 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
843 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
847 open(istat,file=statname,position="append")
849 open(istat,file=statname,access="append")
851 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
852 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
853 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
854 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
855 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
856 & gsccorx_max,gsclocx_max
858 if (gvdwc_max.gt.1.0d4) then
859 write (iout,*) "gvdwc gvdwx gradb gradbx"
861 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
862 & gradb(j,i),gradbx(j,i),j=1,3)
864 call pdbout(0.0d0,'cipiszcze',iout)
870 write (iout,*) "gradc gradx gloc"
872 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
873 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
877 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
881 c-------------------------------------------------------------------------------
882 subroutine rescale_weights(t_bath)
883 implicit real*8 (a-h,o-z)
885 include 'COMMON.IOUNITS'
886 include 'COMMON.FFIELD'
887 include 'COMMON.SBRIDGE'
888 double precision kfac /2.4d0/
889 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
891 c facT=2*temp0/(t_bath+temp0)
892 if (rescale_mode.eq.0) then
898 else if (rescale_mode.eq.1) then
899 facT=kfac/(kfac-1.0d0+t_bath/temp0)
900 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
901 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
902 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
903 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
904 else if (rescale_mode.eq.2) then
910 facT=licznik/dlog(dexp(x)+dexp(-x))
911 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
912 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
913 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
914 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
916 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
917 write (*,*) "Wrong RESCALE_MODE",rescale_mode
919 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
923 welec=weights(3)*fact
924 wcorr=weights(4)*fact3
925 wcorr5=weights(5)*fact4
926 wcorr6=weights(6)*fact5
927 wel_loc=weights(7)*fact2
928 wturn3=weights(8)*fact2
929 wturn4=weights(9)*fact3
930 wturn6=weights(10)*fact5
931 wtor=weights(13)*fact
932 wtor_d=weights(14)*fact2
933 wsccor=weights(21)*fact
937 C------------------------------------------------------------------------
938 subroutine enerprint(energia)
939 implicit real*8 (a-h,o-z)
941 include 'COMMON.IOUNITS'
942 include 'COMMON.FFIELD'
943 include 'COMMON.SBRIDGE'
945 double precision energia(0:n_ene)
950 evdw2=energia(2)+energia(18)
962 eello_turn3=energia(8)
963 eello_turn4=energia(9)
964 eello_turn6=energia(10)
970 edihcnstr=energia(19)
975 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
976 & estr,wbond,ebe,wang,
977 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
979 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
980 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
982 & ethetacnstr,ebr*nss,
984 10 format (/'Virtual-chain energies:'//
985 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
986 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
987 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
988 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
989 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
990 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
991 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
992 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
993 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
994 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
995 & ' (SS bridges & dist. cnstr.)'/
996 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
997 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
998 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
999 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1000 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1001 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1002 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1003 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1004 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1005 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1006 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1007 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1008 & 'ETOT= ',1pE16.6,' (total)')
1010 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1011 & estr,wbond,ebe,wang,
1012 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1014 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1015 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1017 & ebr*nss,Uconst,etot
1018 10 format (/'Virtual-chain energies:'//
1019 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1020 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1021 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1022 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1023 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1024 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1025 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1026 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1027 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1028 & ' (SS bridges & dist. cnstr.)'/
1029 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1030 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1031 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1032 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1033 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1034 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1035 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1036 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1037 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1038 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1039 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1040 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1041 & 'ETOT= ',1pE16.6,' (total)')
1045 C-----------------------------------------------------------------------
1046 subroutine elj(evdw)
1048 C This subroutine calculates the interaction energy of nonbonded side chains
1049 C assuming the LJ potential of interaction.
1051 implicit real*8 (a-h,o-z)
1052 include 'DIMENSIONS'
1053 parameter (accur=1.0d-10)
1054 include 'COMMON.GEO'
1055 include 'COMMON.VAR'
1056 include 'COMMON.LOCAL'
1057 include 'COMMON.CHAIN'
1058 include 'COMMON.DERIV'
1059 include 'COMMON.INTERACT'
1060 include 'COMMON.TORSION'
1061 include 'COMMON.SBRIDGE'
1062 include 'COMMON.NAMES'
1063 include 'COMMON.IOUNITS'
1064 include 'COMMON.CONTACTS'
1066 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1068 do i=iatsc_s,iatsc_e
1069 itypi=iabs(itype(i))
1070 if (itypi.eq.ntyp1) cycle
1071 itypi1=iabs(itype(i+1))
1078 C Calculate SC interaction energy.
1080 do iint=1,nint_gr(i)
1081 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1082 cd & 'iend=',iend(i,iint)
1083 do j=istart(i,iint),iend(i,iint)
1084 itypj=iabs(itype(j))
1085 if (itypj.eq.ntyp1) cycle
1089 C Change 12/1/95 to calculate four-body interactions
1090 rij=xj*xj+yj*yj+zj*zj
1092 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1093 eps0ij=eps(itypi,itypj)
1095 e1=fac*fac*aa(itypi,itypj)
1096 e2=fac*bb(itypi,itypj)
1098 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1099 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1100 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1101 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1102 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1103 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1106 C Calculate the components of the gradient in DC and X
1108 fac=-rrij*(e1+evdwij)
1113 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1114 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1115 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1116 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1120 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1124 C 12/1/95, revised on 5/20/97
1126 C Calculate the contact function. The ith column of the array JCONT will
1127 C contain the numbers of atoms that make contacts with the atom I (of numbers
1128 C greater than I). The arrays FACONT and GACONT will contain the values of
1129 C the contact function and its derivative.
1131 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1132 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1133 C Uncomment next line, if the correlation interactions are contact function only
1134 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1136 sigij=sigma(itypi,itypj)
1137 r0ij=rs0(itypi,itypj)
1139 C Check whether the SC's are not too far to make a contact.
1142 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1143 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1145 if (fcont.gt.0.0D0) then
1146 C If the SC-SC distance if close to sigma, apply spline.
1147 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1148 cAdam & fcont1,fprimcont1)
1149 cAdam fcont1=1.0d0-fcont1
1150 cAdam if (fcont1.gt.0.0d0) then
1151 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1152 cAdam fcont=fcont*fcont1
1154 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1155 cga eps0ij=1.0d0/dsqrt(eps0ij)
1157 cga gg(k)=gg(k)*eps0ij
1159 cga eps0ij=-evdwij*eps0ij
1160 C Uncomment for AL's type of SC correlation interactions.
1161 cadam eps0ij=-evdwij
1162 num_conti=num_conti+1
1163 jcont(num_conti,i)=j
1164 facont(num_conti,i)=fcont*eps0ij
1165 fprimcont=eps0ij*fprimcont/rij
1167 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1168 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1169 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1170 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1171 gacont(1,num_conti,i)=-fprimcont*xj
1172 gacont(2,num_conti,i)=-fprimcont*yj
1173 gacont(3,num_conti,i)=-fprimcont*zj
1174 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1175 cd write (iout,'(2i3,3f10.5)')
1176 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1182 num_cont(i)=num_conti
1186 gvdwc(j,i)=expon*gvdwc(j,i)
1187 gvdwx(j,i)=expon*gvdwx(j,i)
1190 C******************************************************************************
1194 C To save time, the factor of EXPON has been extracted from ALL components
1195 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1198 C******************************************************************************
1201 C-----------------------------------------------------------------------------
1202 subroutine eljk(evdw)
1204 C This subroutine calculates the interaction energy of nonbonded side chains
1205 C assuming the LJK potential of interaction.
1207 implicit real*8 (a-h,o-z)
1208 include 'DIMENSIONS'
1209 include 'COMMON.GEO'
1210 include 'COMMON.VAR'
1211 include 'COMMON.LOCAL'
1212 include 'COMMON.CHAIN'
1213 include 'COMMON.DERIV'
1214 include 'COMMON.INTERACT'
1215 include 'COMMON.IOUNITS'
1216 include 'COMMON.NAMES'
1219 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1221 do i=iatsc_s,iatsc_e
1222 itypi=iabs(itype(i))
1223 if (itypi.eq.ntyp1) cycle
1224 itypi1=iabs(itype(i+1))
1229 C Calculate SC interaction energy.
1231 do iint=1,nint_gr(i)
1232 do j=istart(i,iint),iend(i,iint)
1233 itypj=iabs(itype(j))
1234 if (itypj.eq.ntyp1) cycle
1238 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1239 fac_augm=rrij**expon
1240 e_augm=augm(itypi,itypj)*fac_augm
1241 r_inv_ij=dsqrt(rrij)
1243 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1244 fac=r_shift_inv**expon
1245 e1=fac*fac*aa(itypi,itypj)
1246 e2=fac*bb(itypi,itypj)
1248 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1249 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1250 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1251 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1252 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1253 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1254 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1257 C Calculate the components of the gradient in DC and X
1259 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1264 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1265 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1266 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1267 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1271 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1279 gvdwc(j,i)=expon*gvdwc(j,i)
1280 gvdwx(j,i)=expon*gvdwx(j,i)
1285 C-----------------------------------------------------------------------------
1286 subroutine ebp(evdw)
1288 C This subroutine calculates the interaction energy of nonbonded side chains
1289 C assuming the Berne-Pechukas potential of interaction.
1291 implicit real*8 (a-h,o-z)
1292 include 'DIMENSIONS'
1293 include 'COMMON.GEO'
1294 include 'COMMON.VAR'
1295 include 'COMMON.LOCAL'
1296 include 'COMMON.CHAIN'
1297 include 'COMMON.DERIV'
1298 include 'COMMON.NAMES'
1299 include 'COMMON.INTERACT'
1300 include 'COMMON.IOUNITS'
1301 include 'COMMON.CALC'
1302 common /srutu/ icall
1303 c double precision rrsave(maxdim)
1306 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1308 c if (icall.eq.0) then
1314 do i=iatsc_s,iatsc_e
1315 itypi=iabs(itype(i))
1316 if (itypi.eq.ntyp1) cycle
1317 itypi1=iabs(itype(i+1))
1321 dxi=dc_norm(1,nres+i)
1322 dyi=dc_norm(2,nres+i)
1323 dzi=dc_norm(3,nres+i)
1324 c dsci_inv=dsc_inv(itypi)
1325 dsci_inv=vbld_inv(i+nres)
1327 C Calculate SC interaction energy.
1329 do iint=1,nint_gr(i)
1330 do j=istart(i,iint),iend(i,iint)
1332 itypj=iabs(itype(j))
1333 if (itypj.eq.ntyp1) cycle
1334 c dscj_inv=dsc_inv(itypj)
1335 dscj_inv=vbld_inv(j+nres)
1336 chi1=chi(itypi,itypj)
1337 chi2=chi(itypj,itypi)
1344 alf12=0.5D0*(alf1+alf2)
1345 C For diagnostics only!!!
1358 dxj=dc_norm(1,nres+j)
1359 dyj=dc_norm(2,nres+j)
1360 dzj=dc_norm(3,nres+j)
1361 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1362 cd if (icall.eq.0) then
1368 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1370 C Calculate whole angle-dependent part of epsilon and contributions
1371 C to its derivatives
1372 fac=(rrij*sigsq)**expon2
1373 e1=fac*fac*aa(itypi,itypj)
1374 e2=fac*bb(itypi,itypj)
1375 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1376 eps2der=evdwij*eps3rt
1377 eps3der=evdwij*eps2rt
1378 evdwij=evdwij*eps2rt*eps3rt
1381 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1382 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1383 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1384 cd & restyp(itypi),i,restyp(itypj),j,
1385 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1386 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1387 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1390 C Calculate gradient components.
1391 e1=e1*eps1*eps2rt**2*eps3rt**2
1392 fac=-expon*(e1+evdwij)
1395 C Calculate radial part of the gradient
1399 C Calculate the angular part of the gradient and sum add the contributions
1400 C to the appropriate components of the Cartesian gradient.
1408 C-----------------------------------------------------------------------------
1409 subroutine egb(evdw)
1411 C This subroutine calculates the interaction energy of nonbonded side chains
1412 C assuming the Gay-Berne potential of interaction.
1414 implicit real*8 (a-h,o-z)
1415 include 'DIMENSIONS'
1416 include 'COMMON.GEO'
1417 include 'COMMON.VAR'
1418 include 'COMMON.LOCAL'
1419 include 'COMMON.CHAIN'
1420 include 'COMMON.DERIV'
1421 include 'COMMON.NAMES'
1422 include 'COMMON.INTERACT'
1423 include 'COMMON.IOUNITS'
1424 include 'COMMON.CALC'
1425 include 'COMMON.CONTROL'
1426 include 'COMMON.SBRIDGE'
1429 c write(iout,*) "Jestem w egb(evdw)"
1432 ccccc energy_dec=.false.
1433 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1436 c if (icall.eq.0) lprn=.false.
1438 do i=iatsc_s,iatsc_e
1439 itypi=iabs(itype(i))
1440 if (itypi.eq.ntyp1) cycle
1441 itypi1=iabs(itype(i+1))
1445 dxi=dc_norm(1,nres+i)
1446 dyi=dc_norm(2,nres+i)
1447 dzi=dc_norm(3,nres+i)
1448 c dsci_inv=dsc_inv(itypi)
1449 dsci_inv=vbld_inv(i+nres)
1450 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1451 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1453 C Calculate SC interaction energy.
1455 do iint=1,nint_gr(i)
1456 do j=istart(i,iint),iend(i,iint)
1457 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1459 c write(iout,*) "PRZED ZWYKLE", evdwij
1460 call dyn_ssbond_ene(i,j,evdwij)
1461 c write(iout,*) "PO ZWYKLE", evdwij
1464 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1465 & 'evdw',i,j,evdwij,' ss'
1466 C triple bond artifac removal
1467 do k=j+1,iend(i,iint)
1468 C search over all next residues
1469 if (dyn_ss_mask(k)) then
1470 C check if they are cysteins
1471 C write(iout,*) 'k=',k
1473 c write(iout,*) "PRZED TRI", evdwij
1474 evdwij_przed_tri=evdwij
1475 call triple_ssbond_ene(i,j,k,evdwij)
1476 c if(evdwij_przed_tri.ne.evdwij) then
1477 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1480 c write(iout,*) "PO TRI", evdwij
1481 C call the energy function that removes the artifical triple disulfide
1482 C bond the soubroutine is located in ssMD.F
1484 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1485 & 'evdw',i,j,evdwij,'tss'
1486 endif!dyn_ss_mask(k)
1490 itypj=iabs(itype(j))
1491 if (itypj.eq.ntyp1) cycle
1492 c dscj_inv=dsc_inv(itypj)
1493 dscj_inv=vbld_inv(j+nres)
1494 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1495 c & 1.0d0/vbld(j+nres)
1496 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1497 sig0ij=sigma(itypi,itypj)
1498 chi1=chi(itypi,itypj)
1499 chi2=chi(itypj,itypi)
1506 alf12=0.5D0*(alf1+alf2)
1507 C For diagnostics only!!!
1520 dxj=dc_norm(1,nres+j)
1521 dyj=dc_norm(2,nres+j)
1522 dzj=dc_norm(3,nres+j)
1523 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1524 c write (iout,*) "j",j," dc_norm",
1525 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1526 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1528 C Calculate angle-dependent terms of energy and contributions to their
1532 sig=sig0ij*dsqrt(sigsq)
1533 rij_shift=1.0D0/rij-sig+sig0ij
1534 c for diagnostics; uncomment
1535 c rij_shift=1.2*sig0ij
1536 C I hate to put IF's in the loops, but here don't have another choice!!!!
1537 if (rij_shift.le.0.0D0) then
1539 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1540 cd & restyp(itypi),i,restyp(itypj),j,
1541 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1545 c---------------------------------------------------------------
1546 rij_shift=1.0D0/rij_shift
1547 fac=rij_shift**expon
1548 e1=fac*fac*aa(itypi,itypj)
1549 e2=fac*bb(itypi,itypj)
1550 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1551 eps2der=evdwij*eps3rt
1552 eps3der=evdwij*eps2rt
1553 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1554 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1555 evdwij=evdwij*eps2rt*eps3rt
1558 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1559 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1560 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1561 & restyp(itypi),i,restyp(itypj),j,
1562 & epsi,sigm,chi1,chi2,chip1,chip2,
1563 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1564 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1568 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1571 C Calculate gradient components.
1572 e1=e1*eps1*eps2rt**2*eps3rt**2
1573 fac=-expon*(e1+evdwij)*rij_shift
1577 C Calculate the radial part of the gradient
1581 C Calculate angular part of the gradient.
1587 c write (iout,*) "Number of loop steps in EGB:",ind
1588 cccc energy_dec=.false.
1591 C-----------------------------------------------------------------------------
1592 subroutine egbv(evdw)
1594 C This subroutine calculates the interaction energy of nonbonded side chains
1595 C assuming the Gay-Berne-Vorobjev potential of interaction.
1597 implicit real*8 (a-h,o-z)
1598 include 'DIMENSIONS'
1599 include 'COMMON.GEO'
1600 include 'COMMON.VAR'
1601 include 'COMMON.LOCAL'
1602 include 'COMMON.CHAIN'
1603 include 'COMMON.DERIV'
1604 include 'COMMON.NAMES'
1605 include 'COMMON.INTERACT'
1606 include 'COMMON.IOUNITS'
1607 include 'COMMON.CALC'
1608 common /srutu/ icall
1611 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1614 c if (icall.eq.0) lprn=.true.
1616 do i=iatsc_s,iatsc_e
1617 itypi=iabs(itype(i))
1618 if (itypi.eq.ntyp1) cycle
1619 itypi1=iabs(itype(i+1))
1623 dxi=dc_norm(1,nres+i)
1624 dyi=dc_norm(2,nres+i)
1625 dzi=dc_norm(3,nres+i)
1626 c dsci_inv=dsc_inv(itypi)
1627 dsci_inv=vbld_inv(i+nres)
1629 C Calculate SC interaction energy.
1631 do iint=1,nint_gr(i)
1632 do j=istart(i,iint),iend(i,iint)
1634 itypj=iabs(itype(j))
1635 if (itypj.eq.ntyp1) cycle
1636 c dscj_inv=dsc_inv(itypj)
1637 dscj_inv=vbld_inv(j+nres)
1638 sig0ij=sigma(itypi,itypj)
1639 r0ij=r0(itypi,itypj)
1640 chi1=chi(itypi,itypj)
1641 chi2=chi(itypj,itypi)
1648 alf12=0.5D0*(alf1+alf2)
1649 C For diagnostics only!!!
1662 dxj=dc_norm(1,nres+j)
1663 dyj=dc_norm(2,nres+j)
1664 dzj=dc_norm(3,nres+j)
1665 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1667 C Calculate angle-dependent terms of energy and contributions to their
1671 sig=sig0ij*dsqrt(sigsq)
1672 rij_shift=1.0D0/rij-sig+r0ij
1673 C I hate to put IF's in the loops, but here don't have another choice!!!!
1674 if (rij_shift.le.0.0D0) then
1679 c---------------------------------------------------------------
1680 rij_shift=1.0D0/rij_shift
1681 fac=rij_shift**expon
1682 e1=fac*fac*aa(itypi,itypj)
1683 e2=fac*bb(itypi,itypj)
1684 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1685 eps2der=evdwij*eps3rt
1686 eps3der=evdwij*eps2rt
1687 fac_augm=rrij**expon
1688 e_augm=augm(itypi,itypj)*fac_augm
1689 evdwij=evdwij*eps2rt*eps3rt
1690 evdw=evdw+evdwij+e_augm
1692 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1693 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1694 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1695 & restyp(itypi),i,restyp(itypj),j,
1696 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1697 & chi1,chi2,chip1,chip2,
1698 & eps1,eps2rt**2,eps3rt**2,
1699 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1702 C Calculate gradient components.
1703 e1=e1*eps1*eps2rt**2*eps3rt**2
1704 fac=-expon*(e1+evdwij)*rij_shift
1706 fac=rij*fac-2*expon*rrij*e_augm
1707 C Calculate the radial part of the gradient
1711 C Calculate angular part of the gradient.
1717 C-----------------------------------------------------------------------------
1718 subroutine sc_angular
1719 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1720 C om12. Called by ebp, egb, and egbv.
1722 include 'COMMON.CALC'
1723 include 'COMMON.IOUNITS'
1727 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1728 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1729 om12=dxi*dxj+dyi*dyj+dzi*dzj
1731 C Calculate eps1(om12) and its derivative in om12
1732 faceps1=1.0D0-om12*chiom12
1733 faceps1_inv=1.0D0/faceps1
1734 eps1=dsqrt(faceps1_inv)
1735 C Following variable is eps1*deps1/dom12
1736 eps1_om12=faceps1_inv*chiom12
1741 c write (iout,*) "om12",om12," eps1",eps1
1742 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1747 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1748 sigsq=1.0D0-facsig*faceps1_inv
1749 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1750 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1751 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1757 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1758 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1760 C Calculate eps2 and its derivatives in om1, om2, and om12.
1763 chipom12=chip12*om12
1764 facp=1.0D0-om12*chipom12
1766 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1767 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1768 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1769 C Following variable is the square root of eps2
1770 eps2rt=1.0D0-facp1*facp_inv
1771 C Following three variables are the derivatives of the square root of eps
1772 C in om1, om2, and om12.
1773 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1774 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1775 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1776 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1777 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1778 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1779 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1780 c & " eps2rt_om12",eps2rt_om12
1781 C Calculate whole angle-dependent part of epsilon and contributions
1782 C to its derivatives
1785 C----------------------------------------------------------------------------
1787 implicit real*8 (a-h,o-z)
1788 include 'DIMENSIONS'
1789 include 'COMMON.CHAIN'
1790 include 'COMMON.DERIV'
1791 include 'COMMON.CALC'
1792 include 'COMMON.IOUNITS'
1793 double precision dcosom1(3),dcosom2(3)
1794 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1795 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1796 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1797 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1801 c eom12=evdwij*eps1_om12
1803 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1804 c & " sigder",sigder
1805 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1806 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1808 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1809 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1812 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1814 c write (iout,*) "gg",(gg(k),k=1,3)
1816 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1817 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1818 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1819 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1820 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1821 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1822 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1823 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1824 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1825 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1828 C Calculate the components of the gradient in DC and X
1832 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1836 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1837 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1841 C-----------------------------------------------------------------------
1842 subroutine e_softsphere(evdw)
1844 C This subroutine calculates the interaction energy of nonbonded side chains
1845 C assuming the LJ potential of interaction.
1847 implicit real*8 (a-h,o-z)
1848 include 'DIMENSIONS'
1849 parameter (accur=1.0d-10)
1850 include 'COMMON.GEO'
1851 include 'COMMON.VAR'
1852 include 'COMMON.LOCAL'
1853 include 'COMMON.CHAIN'
1854 include 'COMMON.DERIV'
1855 include 'COMMON.INTERACT'
1856 include 'COMMON.TORSION'
1857 include 'COMMON.SBRIDGE'
1858 include 'COMMON.NAMES'
1859 include 'COMMON.IOUNITS'
1860 include 'COMMON.CONTACTS'
1862 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1864 do i=iatsc_s,iatsc_e
1865 itypi=iabs(itype(i))
1866 if (itypi.eq.ntyp1) cycle
1867 itypi1=iabs(itype(i+1))
1872 C Calculate SC interaction energy.
1874 do iint=1,nint_gr(i)
1875 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1876 cd & 'iend=',iend(i,iint)
1877 do j=istart(i,iint),iend(i,iint)
1878 itypj=iabs(itype(j))
1879 if (itypj.eq.ntyp1) cycle
1883 rij=xj*xj+yj*yj+zj*zj
1884 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1885 r0ij=r0(itypi,itypj)
1887 c print *,i,j,r0ij,dsqrt(rij)
1888 if (rij.lt.r0ijsq) then
1889 evdwij=0.25d0*(rij-r0ijsq)**2
1897 C Calculate the components of the gradient in DC and X
1903 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1904 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1905 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1906 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1910 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1918 C--------------------------------------------------------------------------
1919 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1922 C Soft-sphere potential of p-p interaction
1924 implicit real*8 (a-h,o-z)
1925 include 'DIMENSIONS'
1926 include 'COMMON.CONTROL'
1927 include 'COMMON.IOUNITS'
1928 include 'COMMON.GEO'
1929 include 'COMMON.VAR'
1930 include 'COMMON.LOCAL'
1931 include 'COMMON.CHAIN'
1932 include 'COMMON.DERIV'
1933 include 'COMMON.INTERACT'
1934 include 'COMMON.CONTACTS'
1935 include 'COMMON.TORSION'
1936 include 'COMMON.VECTORS'
1937 include 'COMMON.FFIELD'
1939 cd write(iout,*) 'In EELEC_soft_sphere'
1946 do i=iatel_s,iatel_e
1947 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1951 xmedi=c(1,i)+0.5d0*dxi
1952 ymedi=c(2,i)+0.5d0*dyi
1953 zmedi=c(3,i)+0.5d0*dzi
1955 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1956 do j=ielstart(i),ielend(i)
1957 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1961 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1962 r0ij=rpp(iteli,itelj)
1967 xj=c(1,j)+0.5D0*dxj-xmedi
1968 yj=c(2,j)+0.5D0*dyj-ymedi
1969 zj=c(3,j)+0.5D0*dzj-zmedi
1970 rij=xj*xj+yj*yj+zj*zj
1971 if (rij.lt.r0ijsq) then
1972 evdw1ij=0.25d0*(rij-r0ijsq)**2
1980 C Calculate contributions to the Cartesian gradient.
1986 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1987 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1990 * Loop over residues i+1 thru j-1.
1994 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1999 cgrad do i=nnt,nct-1
2001 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2003 cgrad do j=i+1,nct-1
2005 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2011 c------------------------------------------------------------------------------
2012 subroutine vec_and_deriv
2013 implicit real*8 (a-h,o-z)
2014 include 'DIMENSIONS'
2018 include 'COMMON.IOUNITS'
2019 include 'COMMON.GEO'
2020 include 'COMMON.VAR'
2021 include 'COMMON.LOCAL'
2022 include 'COMMON.CHAIN'
2023 include 'COMMON.VECTORS'
2024 include 'COMMON.SETUP'
2025 include 'COMMON.TIME1'
2026 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2027 C Compute the local reference systems. For reference system (i), the
2028 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2029 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2031 do i=ivec_start,ivec_end
2035 if (i.eq.nres-1) then
2036 C Case of the last full residue
2037 C Compute the Z-axis
2038 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2039 costh=dcos(pi-theta(nres))
2040 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2044 C Compute the derivatives of uz
2046 uzder(2,1,1)=-dc_norm(3,i-1)
2047 uzder(3,1,1)= dc_norm(2,i-1)
2048 uzder(1,2,1)= dc_norm(3,i-1)
2050 uzder(3,2,1)=-dc_norm(1,i-1)
2051 uzder(1,3,1)=-dc_norm(2,i-1)
2052 uzder(2,3,1)= dc_norm(1,i-1)
2055 uzder(2,1,2)= dc_norm(3,i)
2056 uzder(3,1,2)=-dc_norm(2,i)
2057 uzder(1,2,2)=-dc_norm(3,i)
2059 uzder(3,2,2)= dc_norm(1,i)
2060 uzder(1,3,2)= dc_norm(2,i)
2061 uzder(2,3,2)=-dc_norm(1,i)
2063 C Compute the Y-axis
2066 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2068 C Compute the derivatives of uy
2071 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2072 & -dc_norm(k,i)*dc_norm(j,i-1)
2073 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2075 uyder(j,j,1)=uyder(j,j,1)-costh
2076 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2081 uygrad(l,k,j,i)=uyder(l,k,j)
2082 uzgrad(l,k,j,i)=uzder(l,k,j)
2086 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2087 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2088 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2089 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2092 C Compute the Z-axis
2093 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2094 costh=dcos(pi-theta(i+2))
2095 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2099 C Compute the derivatives of uz
2101 uzder(2,1,1)=-dc_norm(3,i+1)
2102 uzder(3,1,1)= dc_norm(2,i+1)
2103 uzder(1,2,1)= dc_norm(3,i+1)
2105 uzder(3,2,1)=-dc_norm(1,i+1)
2106 uzder(1,3,1)=-dc_norm(2,i+1)
2107 uzder(2,3,1)= dc_norm(1,i+1)
2110 uzder(2,1,2)= dc_norm(3,i)
2111 uzder(3,1,2)=-dc_norm(2,i)
2112 uzder(1,2,2)=-dc_norm(3,i)
2114 uzder(3,2,2)= dc_norm(1,i)
2115 uzder(1,3,2)= dc_norm(2,i)
2116 uzder(2,3,2)=-dc_norm(1,i)
2118 C Compute the Y-axis
2121 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2123 C Compute the derivatives of uy
2126 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2127 & -dc_norm(k,i)*dc_norm(j,i+1)
2128 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2130 uyder(j,j,1)=uyder(j,j,1)-costh
2131 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2136 uygrad(l,k,j,i)=uyder(l,k,j)
2137 uzgrad(l,k,j,i)=uzder(l,k,j)
2141 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2142 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2143 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2144 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2148 vbld_inv_temp(1)=vbld_inv(i+1)
2149 if (i.lt.nres-1) then
2150 vbld_inv_temp(2)=vbld_inv(i+2)
2152 vbld_inv_temp(2)=vbld_inv(i)
2157 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2158 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2163 #if defined(PARVEC) && defined(MPI)
2164 if (nfgtasks1.gt.1) then
2166 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2167 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2168 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2169 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2170 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2172 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2173 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2175 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2176 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2177 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2178 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2179 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2180 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2181 time_gather=time_gather+MPI_Wtime()-time00
2183 c if (fg_rank.eq.0) then
2184 c write (iout,*) "Arrays UY and UZ"
2186 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2193 C-----------------------------------------------------------------------------
2194 subroutine check_vecgrad
2195 implicit real*8 (a-h,o-z)
2196 include 'DIMENSIONS'
2197 include 'COMMON.IOUNITS'
2198 include 'COMMON.GEO'
2199 include 'COMMON.VAR'
2200 include 'COMMON.LOCAL'
2201 include 'COMMON.CHAIN'
2202 include 'COMMON.VECTORS'
2203 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2204 dimension uyt(3,maxres),uzt(3,maxres)
2205 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2206 double precision delta /1.0d-7/
2209 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2210 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2211 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2212 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2213 cd & (dc_norm(if90,i),if90=1,3)
2214 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2215 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2216 cd write(iout,'(a)')
2222 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2223 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2236 cd write (iout,*) 'i=',i
2238 erij(k)=dc_norm(k,i)
2242 dc_norm(k,i)=erij(k)
2244 dc_norm(j,i)=dc_norm(j,i)+delta
2245 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2247 c dc_norm(k,i)=dc_norm(k,i)/fac
2249 c write (iout,*) (dc_norm(k,i),k=1,3)
2250 c write (iout,*) (erij(k),k=1,3)
2253 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2254 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2255 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2256 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2258 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2259 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2260 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2263 dc_norm(k,i)=erij(k)
2266 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2267 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2268 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2269 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2270 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2271 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2272 cd write (iout,'(a)')
2277 C--------------------------------------------------------------------------
2278 subroutine set_matrices
2279 implicit real*8 (a-h,o-z)
2280 include 'DIMENSIONS'
2283 include "COMMON.SETUP"
2285 integer status(MPI_STATUS_SIZE)
2287 include 'COMMON.IOUNITS'
2288 include 'COMMON.GEO'
2289 include 'COMMON.VAR'
2290 include 'COMMON.LOCAL'
2291 include 'COMMON.CHAIN'
2292 include 'COMMON.DERIV'
2293 include 'COMMON.INTERACT'
2294 include 'COMMON.CONTACTS'
2295 include 'COMMON.TORSION'
2296 include 'COMMON.VECTORS'
2297 include 'COMMON.FFIELD'
2298 double precision auxvec(2),auxmat(2,2)
2300 C Compute the virtual-bond-torsional-angle dependent quantities needed
2301 C to calculate the el-loc multibody terms of various order.
2304 do i=ivec_start+2,ivec_end+2
2308 if (i .lt. nres+1) then
2345 if (i .gt. 3 .and. i .lt. nres+1) then
2346 obrot_der(1,i-2)=-sin1
2347 obrot_der(2,i-2)= cos1
2348 Ugder(1,1,i-2)= sin1
2349 Ugder(1,2,i-2)=-cos1
2350 Ugder(2,1,i-2)=-cos1
2351 Ugder(2,2,i-2)=-sin1
2354 obrot2_der(1,i-2)=-dwasin2
2355 obrot2_der(2,i-2)= dwacos2
2356 Ug2der(1,1,i-2)= dwasin2
2357 Ug2der(1,2,i-2)=-dwacos2
2358 Ug2der(2,1,i-2)=-dwacos2
2359 Ug2der(2,2,i-2)=-dwasin2
2361 obrot_der(1,i-2)=0.0d0
2362 obrot_der(2,i-2)=0.0d0
2363 Ugder(1,1,i-2)=0.0d0
2364 Ugder(1,2,i-2)=0.0d0
2365 Ugder(2,1,i-2)=0.0d0
2366 Ugder(2,2,i-2)=0.0d0
2367 obrot2_der(1,i-2)=0.0d0
2368 obrot2_der(2,i-2)=0.0d0
2369 Ug2der(1,1,i-2)=0.0d0
2370 Ug2der(1,2,i-2)=0.0d0
2371 Ug2der(2,1,i-2)=0.0d0
2372 Ug2der(2,2,i-2)=0.0d0
2374 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2375 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2376 iti = itortyp(itype(i-2))
2380 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2381 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2382 iti1 = itortyp(itype(i-1))
2386 cd write (iout,*) '*******i',i,' iti1',iti
2387 cd write (iout,*) 'b1',b1(:,iti)
2388 cd write (iout,*) 'b2',b2(:,iti)
2389 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2390 c if (i .gt. iatel_s+2) then
2391 if (i .gt. nnt+2) then
2392 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2393 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2394 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2396 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2397 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2398 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2399 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2400 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2411 DtUg2(l,k,i-2)=0.0d0
2415 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2416 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2418 muder(k,i-2)=Ub2der(k,i-2)
2420 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2421 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2422 if (itype(i-1).le.ntyp) then
2423 iti1 = itortyp(itype(i-1))
2431 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2433 cd write (iout,*) 'mu ',mu(:,i-2)
2434 cd write (iout,*) 'mu1',mu1(:,i-2)
2435 cd write (iout,*) 'mu2',mu2(:,i-2)
2436 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2438 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2439 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2440 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2441 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2442 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2443 C Vectors and matrices dependent on a single virtual-bond dihedral.
2444 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2445 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2446 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2447 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2448 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2449 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2450 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2451 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2452 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2455 C Matrices dependent on two consecutive virtual-bond dihedrals.
2456 C The order of matrices is from left to right.
2457 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2459 c do i=max0(ivec_start,2),ivec_end
2461 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2462 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2463 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2464 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2465 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2466 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2467 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2468 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2471 #if defined(MPI) && defined(PARMAT)
2473 c if (fg_rank.eq.0) then
2474 write (iout,*) "Arrays UG and UGDER before GATHER"
2476 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2477 & ((ug(l,k,i),l=1,2),k=1,2),
2478 & ((ugder(l,k,i),l=1,2),k=1,2)
2480 write (iout,*) "Arrays UG2 and UG2DER"
2482 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2483 & ((ug2(l,k,i),l=1,2),k=1,2),
2484 & ((ug2der(l,k,i),l=1,2),k=1,2)
2486 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2488 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2489 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2490 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2492 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2494 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2495 & costab(i),sintab(i),costab2(i),sintab2(i)
2497 write (iout,*) "Array MUDER"
2499 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2503 if (nfgtasks.gt.1) then
2505 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2506 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2507 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2509 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2510 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2512 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2515 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2516 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2518 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2519 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2521 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2522 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2524 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2525 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2527 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2528 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2529 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2530 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2531 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2532 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2533 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2534 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2535 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2536 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2537 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2538 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2539 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2541 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2542 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2544 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2545 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2547 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2548 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2550 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2551 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2553 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2554 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2556 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2557 & ivec_count(fg_rank1),
2558 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2560 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2561 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2563 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2564 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2566 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2567 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2569 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2570 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2572 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2573 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2575 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2576 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2578 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2579 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2581 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2582 & ivec_count(fg_rank1),
2583 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2585 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2586 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2588 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2589 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2591 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2592 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2594 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2595 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2597 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2598 & ivec_count(fg_rank1),
2599 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2601 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2602 & ivec_count(fg_rank1),
2603 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2605 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2606 & ivec_count(fg_rank1),
2607 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2608 & MPI_MAT2,FG_COMM1,IERR)
2609 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2610 & ivec_count(fg_rank1),
2611 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2612 & MPI_MAT2,FG_COMM1,IERR)
2615 c Passes matrix info through the ring
2618 if (irecv.lt.0) irecv=nfgtasks1-1
2621 if (inext.ge.nfgtasks1) inext=0
2623 c write (iout,*) "isend",isend," irecv",irecv
2625 lensend=lentyp(isend)
2626 lenrecv=lentyp(irecv)
2627 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2628 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2629 c & MPI_ROTAT1(lensend),inext,2200+isend,
2630 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2631 c & iprev,2200+irecv,FG_COMM,status,IERR)
2632 c write (iout,*) "Gather ROTAT1"
2634 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2635 c & MPI_ROTAT2(lensend),inext,3300+isend,
2636 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2637 c & iprev,3300+irecv,FG_COMM,status,IERR)
2638 c write (iout,*) "Gather ROTAT2"
2640 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2641 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2642 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2643 & iprev,4400+irecv,FG_COMM,status,IERR)
2644 c write (iout,*) "Gather ROTAT_OLD"
2646 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2647 & MPI_PRECOMP11(lensend),inext,5500+isend,
2648 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2649 & iprev,5500+irecv,FG_COMM,status,IERR)
2650 c write (iout,*) "Gather PRECOMP11"
2652 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2653 & MPI_PRECOMP12(lensend),inext,6600+isend,
2654 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2655 & iprev,6600+irecv,FG_COMM,status,IERR)
2656 c write (iout,*) "Gather PRECOMP12"
2658 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2660 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2661 & MPI_ROTAT2(lensend),inext,7700+isend,
2662 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2663 & iprev,7700+irecv,FG_COMM,status,IERR)
2664 c write (iout,*) "Gather PRECOMP21"
2666 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2667 & MPI_PRECOMP22(lensend),inext,8800+isend,
2668 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2669 & iprev,8800+irecv,FG_COMM,status,IERR)
2670 c write (iout,*) "Gather PRECOMP22"
2672 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2673 & MPI_PRECOMP23(lensend),inext,9900+isend,
2674 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2675 & MPI_PRECOMP23(lenrecv),
2676 & iprev,9900+irecv,FG_COMM,status,IERR)
2677 c write (iout,*) "Gather PRECOMP23"
2682 if (irecv.lt.0) irecv=nfgtasks1-1
2685 time_gather=time_gather+MPI_Wtime()-time00
2688 c if (fg_rank.eq.0) then
2689 write (iout,*) "Arrays UG and UGDER"
2691 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2692 & ((ug(l,k,i),l=1,2),k=1,2),
2693 & ((ugder(l,k,i),l=1,2),k=1,2)
2695 write (iout,*) "Arrays UG2 and UG2DER"
2697 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2698 & ((ug2(l,k,i),l=1,2),k=1,2),
2699 & ((ug2der(l,k,i),l=1,2),k=1,2)
2701 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2703 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2704 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2705 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2707 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2709 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2710 & costab(i),sintab(i),costab2(i),sintab2(i)
2712 write (iout,*) "Array MUDER"
2714 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2720 cd iti = itortyp(itype(i))
2723 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2724 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2729 C--------------------------------------------------------------------------
2730 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2732 C This subroutine calculates the average interaction energy and its gradient
2733 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2734 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2735 C The potential depends both on the distance of peptide-group centers and on
2736 C the orientation of the CA-CA virtual bonds.
2738 implicit real*8 (a-h,o-z)
2742 include 'DIMENSIONS'
2743 include 'COMMON.CONTROL'
2744 include 'COMMON.SETUP'
2745 include 'COMMON.IOUNITS'
2746 include 'COMMON.GEO'
2747 include 'COMMON.VAR'
2748 include 'COMMON.LOCAL'
2749 include 'COMMON.CHAIN'
2750 include 'COMMON.DERIV'
2751 include 'COMMON.INTERACT'
2752 include 'COMMON.CONTACTS'
2753 include 'COMMON.TORSION'
2754 include 'COMMON.VECTORS'
2755 include 'COMMON.FFIELD'
2756 include 'COMMON.TIME1'
2757 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2758 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2759 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2760 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2761 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2762 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2764 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2766 double precision scal_el /1.0d0/
2768 double precision scal_el /0.5d0/
2771 C 13-go grudnia roku pamietnego...
2772 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2773 & 0.0d0,1.0d0,0.0d0,
2774 & 0.0d0,0.0d0,1.0d0/
2775 cd write(iout,*) 'In EELEC'
2777 cd write(iout,*) 'Type',i
2778 cd write(iout,*) 'B1',B1(:,i)
2779 cd write(iout,*) 'B2',B2(:,i)
2780 cd write(iout,*) 'CC',CC(:,:,i)
2781 cd write(iout,*) 'DD',DD(:,:,i)
2782 cd write(iout,*) 'EE',EE(:,:,i)
2784 cd call check_vecgrad
2786 if (icheckgrad.eq.1) then
2788 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2790 dc_norm(k,i)=dc(k,i)*fac
2792 c write (iout,*) 'i',i,' fac',fac
2795 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2796 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2797 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2798 c call vec_and_deriv
2804 time_mat=time_mat+MPI_Wtime()-time01
2808 cd write (iout,*) 'i=',i
2810 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2813 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2814 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2827 cd print '(a)','Enter EELEC'
2828 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2830 gel_loc_loc(i)=0.0d0
2835 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2837 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2839 do i=iturn3_start,iturn3_end
2840 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2841 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2845 dx_normi=dc_norm(1,i)
2846 dy_normi=dc_norm(2,i)
2847 dz_normi=dc_norm(3,i)
2848 xmedi=c(1,i)+0.5d0*dxi
2849 ymedi=c(2,i)+0.5d0*dyi
2850 zmedi=c(3,i)+0.5d0*dzi
2852 call eelecij(i,i+2,ees,evdw1,eel_loc)
2853 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2854 num_cont_hb(i)=num_conti
2856 do i=iturn4_start,iturn4_end
2857 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2858 & .or. itype(i+3).eq.ntyp1
2859 & .or. itype(i+4).eq.ntyp1) cycle
2863 dx_normi=dc_norm(1,i)
2864 dy_normi=dc_norm(2,i)
2865 dz_normi=dc_norm(3,i)
2866 xmedi=c(1,i)+0.5d0*dxi
2867 ymedi=c(2,i)+0.5d0*dyi
2868 zmedi=c(3,i)+0.5d0*dzi
2869 num_conti=num_cont_hb(i)
2870 call eelecij(i,i+3,ees,evdw1,eel_loc)
2871 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2872 & call eturn4(i,eello_turn4)
2873 num_cont_hb(i)=num_conti
2876 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2878 do i=iatel_s,iatel_e
2879 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2883 dx_normi=dc_norm(1,i)
2884 dy_normi=dc_norm(2,i)
2885 dz_normi=dc_norm(3,i)
2886 xmedi=c(1,i)+0.5d0*dxi
2887 ymedi=c(2,i)+0.5d0*dyi
2888 zmedi=c(3,i)+0.5d0*dzi
2889 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2890 num_conti=num_cont_hb(i)
2891 do j=ielstart(i),ielend(i)
2892 c write (iout,*) i,j,itype(i),itype(j)
2893 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2894 call eelecij(i,j,ees,evdw1,eel_loc)
2896 num_cont_hb(i)=num_conti
2898 c write (iout,*) "Number of loop steps in EELEC:",ind
2900 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2901 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2903 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2904 ccc eel_loc=eel_loc+eello_turn3
2905 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2908 C-------------------------------------------------------------------------------
2909 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2910 implicit real*8 (a-h,o-z)
2911 include 'DIMENSIONS'
2915 include 'COMMON.CONTROL'
2916 include 'COMMON.IOUNITS'
2917 include 'COMMON.GEO'
2918 include 'COMMON.VAR'
2919 include 'COMMON.LOCAL'
2920 include 'COMMON.CHAIN'
2921 include 'COMMON.DERIV'
2922 include 'COMMON.INTERACT'
2923 include 'COMMON.CONTACTS'
2924 include 'COMMON.TORSION'
2925 include 'COMMON.VECTORS'
2926 include 'COMMON.FFIELD'
2927 include 'COMMON.TIME1'
2928 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2929 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2930 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2931 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2932 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2933 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2935 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2937 double precision scal_el /1.0d0/
2939 double precision scal_el /0.5d0/
2942 C 13-go grudnia roku pamietnego...
2943 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2944 & 0.0d0,1.0d0,0.0d0,
2945 & 0.0d0,0.0d0,1.0d0/
2946 c time00=MPI_Wtime()
2947 cd write (iout,*) "eelecij",i,j
2951 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2952 aaa=app(iteli,itelj)
2953 bbb=bpp(iteli,itelj)
2954 ael6i=ael6(iteli,itelj)
2955 ael3i=ael3(iteli,itelj)
2959 dx_normj=dc_norm(1,j)
2960 dy_normj=dc_norm(2,j)
2961 dz_normj=dc_norm(3,j)
2962 xj=c(1,j)+0.5D0*dxj-xmedi
2963 yj=c(2,j)+0.5D0*dyj-ymedi
2964 zj=c(3,j)+0.5D0*dzj-zmedi
2965 rij=xj*xj+yj*yj+zj*zj
2971 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2972 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2973 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2974 fac=cosa-3.0D0*cosb*cosg
2976 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2977 if (j.eq.i+2) ev1=scal_el*ev1
2982 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2985 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2986 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2989 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2990 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2991 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2992 cd & xmedi,ymedi,zmedi,xj,yj,zj
2994 if (energy_dec) then
2995 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2997 &,iteli,itelj,aaa,evdw1
2998 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3002 C Calculate contributions to the Cartesian gradient.
3005 facvdw=-6*rrmij*(ev1+evdwij)
3006 facel=-3*rrmij*(el1+eesij)
3012 * Radial derivatives. First process both termini of the fragment (i,j)
3018 c ghalf=0.5D0*ggg(k)
3019 c gelc(k,i)=gelc(k,i)+ghalf
3020 c gelc(k,j)=gelc(k,j)+ghalf
3022 c 9/28/08 AL Gradient compotents will be summed only at the end
3024 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3025 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3028 * Loop over residues i+1 thru j-1.
3032 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3039 c ghalf=0.5D0*ggg(k)
3040 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3041 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3043 c 9/28/08 AL Gradient compotents will be summed only at the end
3045 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3046 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3049 * Loop over residues i+1 thru j-1.
3053 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3060 fac=-3*rrmij*(facvdw+facvdw+facel)
3065 * Radial derivatives. First process both termini of the fragment (i,j)
3071 c ghalf=0.5D0*ggg(k)
3072 c gelc(k,i)=gelc(k,i)+ghalf
3073 c gelc(k,j)=gelc(k,j)+ghalf
3075 c 9/28/08 AL Gradient compotents will be summed only at the end
3077 gelc_long(k,j)=gelc(k,j)+ggg(k)
3078 gelc_long(k,i)=gelc(k,i)-ggg(k)
3081 * Loop over residues i+1 thru j-1.
3085 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3088 c 9/28/08 AL Gradient compotents will be summed only at the end
3093 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3094 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3100 ecosa=2.0D0*fac3*fac1+fac4
3103 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3104 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3106 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3107 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3109 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3110 cd & (dcosg(k),k=1,3)
3112 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3115 c ghalf=0.5D0*ggg(k)
3116 c gelc(k,i)=gelc(k,i)+ghalf
3117 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3118 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3119 c gelc(k,j)=gelc(k,j)+ghalf
3120 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3121 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3125 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3130 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3131 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3133 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3134 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3135 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3136 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3138 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3139 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3140 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3142 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3143 C energy of a peptide unit is assumed in the form of a second-order
3144 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3145 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3146 C are computed for EVERY pair of non-contiguous peptide groups.
3148 if (j.lt.nres-1) then
3159 muij(kkk)=mu(k,i)*mu(l,j)
3162 cd write (iout,*) 'EELEC: i',i,' j',j
3163 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3164 cd write(iout,*) 'muij',muij
3165 ury=scalar(uy(1,i),erij)
3166 urz=scalar(uz(1,i),erij)
3167 vry=scalar(uy(1,j),erij)
3168 vrz=scalar(uz(1,j),erij)
3169 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3170 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3171 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3172 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3173 fac=dsqrt(-ael6i)*r3ij
3178 cd write (iout,'(4i5,4f10.5)')
3179 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3180 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3181 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3182 cd & uy(:,j),uz(:,j)
3183 cd write (iout,'(4f10.5)')
3184 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3185 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3186 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3187 cd write (iout,'(9f10.5/)')
3188 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3189 C Derivatives of the elements of A in virtual-bond vectors
3190 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3192 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3193 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3194 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3195 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3196 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3197 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3198 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3199 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3200 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3201 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3202 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3203 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3205 C Compute radial contributions to the gradient
3223 C Add the contributions coming from er
3226 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3227 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3228 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3229 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3232 C Derivatives in DC(i)
3233 cgrad ghalf1=0.5d0*agg(k,1)
3234 cgrad ghalf2=0.5d0*agg(k,2)
3235 cgrad ghalf3=0.5d0*agg(k,3)
3236 cgrad ghalf4=0.5d0*agg(k,4)
3237 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3238 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3239 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3240 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3241 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3242 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3243 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3244 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3245 C Derivatives in DC(i+1)
3246 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3247 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3248 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3249 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3250 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3251 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3252 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3253 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3254 C Derivatives in DC(j)
3255 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3256 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3257 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3258 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3259 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3260 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3261 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3262 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3263 C Derivatives in DC(j+1) or DC(nres-1)
3264 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3265 & -3.0d0*vryg(k,3)*ury)
3266 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3267 & -3.0d0*vrzg(k,3)*ury)
3268 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3269 & -3.0d0*vryg(k,3)*urz)
3270 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3271 & -3.0d0*vrzg(k,3)*urz)
3272 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3274 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3287 aggi(k,l)=-aggi(k,l)
3288 aggi1(k,l)=-aggi1(k,l)
3289 aggj(k,l)=-aggj(k,l)
3290 aggj1(k,l)=-aggj1(k,l)
3293 if (j.lt.nres-1) then
3299 aggi(k,l)=-aggi(k,l)
3300 aggi1(k,l)=-aggi1(k,l)
3301 aggj(k,l)=-aggj(k,l)
3302 aggj1(k,l)=-aggj1(k,l)
3313 aggi(k,l)=-aggi(k,l)
3314 aggi1(k,l)=-aggi1(k,l)
3315 aggj(k,l)=-aggj(k,l)
3316 aggj1(k,l)=-aggj1(k,l)
3321 IF (wel_loc.gt.0.0d0) THEN
3322 C Contribution to the local-electrostatic energy coming from the i-j pair
3323 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3325 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3327 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3328 & 'eelloc',i,j,eel_loc_ij
3329 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3331 eel_loc=eel_loc+eel_loc_ij
3332 C Partial derivatives in virtual-bond dihedral angles gamma
3334 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3335 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3336 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3337 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3338 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3339 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3340 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3342 ggg(l)=agg(l,1)*muij(1)+
3343 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3344 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3345 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3346 cgrad ghalf=0.5d0*ggg(l)
3347 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3348 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3352 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3355 C Remaining derivatives of eello
3357 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3358 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3359 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3360 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3361 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3362 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3363 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3364 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3367 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3368 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3369 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3370 & .and. num_conti.le.maxconts) then
3371 c write (iout,*) i,j," entered corr"
3373 C Calculate the contact function. The ith column of the array JCONT will
3374 C contain the numbers of atoms that make contacts with the atom I (of numbers
3375 C greater than I). The arrays FACONT and GACONT will contain the values of
3376 C the contact function and its derivative.
3377 c r0ij=1.02D0*rpp(iteli,itelj)
3378 c r0ij=1.11D0*rpp(iteli,itelj)
3379 r0ij=2.20D0*rpp(iteli,itelj)
3380 c r0ij=1.55D0*rpp(iteli,itelj)
3381 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3382 if (fcont.gt.0.0D0) then
3383 num_conti=num_conti+1
3384 if (num_conti.gt.maxconts) then
3385 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3386 & ' will skip next contacts for this conf.'
3388 jcont_hb(num_conti,i)=j
3389 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3390 cd & " jcont_hb",jcont_hb(num_conti,i)
3391 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3392 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3393 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3395 d_cont(num_conti,i)=rij
3396 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3397 C --- Electrostatic-interaction matrix ---
3398 a_chuj(1,1,num_conti,i)=a22
3399 a_chuj(1,2,num_conti,i)=a23
3400 a_chuj(2,1,num_conti,i)=a32
3401 a_chuj(2,2,num_conti,i)=a33
3402 C --- Gradient of rij
3404 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3411 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3412 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3413 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3414 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3415 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3420 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3421 C Calculate contact energies
3423 wij=cosa-3.0D0*cosb*cosg
3426 c fac3=dsqrt(-ael6i)/r0ij**3
3427 fac3=dsqrt(-ael6i)*r3ij
3428 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3429 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3430 if (ees0tmp.gt.0) then
3431 ees0pij=dsqrt(ees0tmp)
3435 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3436 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3437 if (ees0tmp.gt.0) then
3438 ees0mij=dsqrt(ees0tmp)
3443 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3444 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3445 C Diagnostics. Comment out or remove after debugging!
3446 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3447 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3448 c ees0m(num_conti,i)=0.0D0
3450 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3451 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3452 C Angular derivatives of the contact function
3453 ees0pij1=fac3/ees0pij
3454 ees0mij1=fac3/ees0mij
3455 fac3p=-3.0D0*fac3*rrmij
3456 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3457 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3459 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3460 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3461 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3462 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3463 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3464 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3465 ecosap=ecosa1+ecosa2
3466 ecosbp=ecosb1+ecosb2
3467 ecosgp=ecosg1+ecosg2
3468 ecosam=ecosa1-ecosa2
3469 ecosbm=ecosb1-ecosb2
3470 ecosgm=ecosg1-ecosg2
3479 facont_hb(num_conti,i)=fcont
3480 fprimcont=fprimcont/rij
3481 cd facont_hb(num_conti,i)=1.0D0
3482 C Following line is for diagnostics.
3485 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3486 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3489 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3490 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3492 gggp(1)=gggp(1)+ees0pijp*xj
3493 gggp(2)=gggp(2)+ees0pijp*yj
3494 gggp(3)=gggp(3)+ees0pijp*zj
3495 gggm(1)=gggm(1)+ees0mijp*xj
3496 gggm(2)=gggm(2)+ees0mijp*yj
3497 gggm(3)=gggm(3)+ees0mijp*zj
3498 C Derivatives due to the contact function
3499 gacont_hbr(1,num_conti,i)=fprimcont*xj
3500 gacont_hbr(2,num_conti,i)=fprimcont*yj
3501 gacont_hbr(3,num_conti,i)=fprimcont*zj
3504 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3505 c following the change of gradient-summation algorithm.
3507 cgrad ghalfp=0.5D0*gggp(k)
3508 cgrad ghalfm=0.5D0*gggm(k)
3509 gacontp_hb1(k,num_conti,i)=!ghalfp
3510 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3511 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3512 gacontp_hb2(k,num_conti,i)=!ghalfp
3513 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3514 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3515 gacontp_hb3(k,num_conti,i)=gggp(k)
3516 gacontm_hb1(k,num_conti,i)=!ghalfm
3517 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3518 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3519 gacontm_hb2(k,num_conti,i)=!ghalfm
3520 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3521 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3522 gacontm_hb3(k,num_conti,i)=gggm(k)
3524 C Diagnostics. Comment out or remove after debugging!
3526 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3527 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3528 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3529 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3530 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3531 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3534 endif ! num_conti.le.maxconts
3537 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3540 ghalf=0.5d0*agg(l,k)
3541 aggi(l,k)=aggi(l,k)+ghalf
3542 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3543 aggj(l,k)=aggj(l,k)+ghalf
3546 if (j.eq.nres-1 .and. i.lt.j-2) then
3549 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3554 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3557 C-----------------------------------------------------------------------------
3558 subroutine eturn3(i,eello_turn3)
3559 C Third- and fourth-order contributions from turns
3560 implicit real*8 (a-h,o-z)
3561 include 'DIMENSIONS'
3562 include 'COMMON.IOUNITS'
3563 include 'COMMON.GEO'
3564 include 'COMMON.VAR'
3565 include 'COMMON.LOCAL'
3566 include 'COMMON.CHAIN'
3567 include 'COMMON.DERIV'
3568 include 'COMMON.INTERACT'
3569 include 'COMMON.CONTACTS'
3570 include 'COMMON.TORSION'
3571 include 'COMMON.VECTORS'
3572 include 'COMMON.FFIELD'
3573 include 'COMMON.CONTROL'
3575 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3576 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3577 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3578 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3579 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3580 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3581 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3584 c write (iout,*) "eturn3",i,j,j1,j2
3589 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3591 C Third-order contributions
3598 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3599 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3600 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3601 call transpose2(auxmat(1,1),auxmat1(1,1))
3602 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3603 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3604 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3605 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3606 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3607 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3608 cd & ' eello_turn3_num',4*eello_turn3_num
3609 C Derivatives in gamma(i)
3610 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3611 call transpose2(auxmat2(1,1),auxmat3(1,1))
3612 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3613 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3614 C Derivatives in gamma(i+1)
3615 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3616 call transpose2(auxmat2(1,1),auxmat3(1,1))
3617 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3618 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3619 & +0.5d0*(pizda(1,1)+pizda(2,2))
3620 C Cartesian derivatives
3622 c ghalf1=0.5d0*agg(l,1)
3623 c ghalf2=0.5d0*agg(l,2)
3624 c ghalf3=0.5d0*agg(l,3)
3625 c ghalf4=0.5d0*agg(l,4)
3626 a_temp(1,1)=aggi(l,1)!+ghalf1
3627 a_temp(1,2)=aggi(l,2)!+ghalf2
3628 a_temp(2,1)=aggi(l,3)!+ghalf3
3629 a_temp(2,2)=aggi(l,4)!+ghalf4
3630 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3631 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3632 & +0.5d0*(pizda(1,1)+pizda(2,2))
3633 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3634 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3635 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3636 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3637 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3638 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3639 & +0.5d0*(pizda(1,1)+pizda(2,2))
3640 a_temp(1,1)=aggj(l,1)!+ghalf1
3641 a_temp(1,2)=aggj(l,2)!+ghalf2
3642 a_temp(2,1)=aggj(l,3)!+ghalf3
3643 a_temp(2,2)=aggj(l,4)!+ghalf4
3644 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3645 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3646 & +0.5d0*(pizda(1,1)+pizda(2,2))
3647 a_temp(1,1)=aggj1(l,1)
3648 a_temp(1,2)=aggj1(l,2)
3649 a_temp(2,1)=aggj1(l,3)
3650 a_temp(2,2)=aggj1(l,4)
3651 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3652 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3653 & +0.5d0*(pizda(1,1)+pizda(2,2))
3657 C-------------------------------------------------------------------------------
3658 subroutine eturn4(i,eello_turn4)
3659 C Third- and fourth-order contributions from turns
3660 implicit real*8 (a-h,o-z)
3661 include 'DIMENSIONS'
3662 include 'COMMON.IOUNITS'
3663 include 'COMMON.GEO'
3664 include 'COMMON.VAR'
3665 include 'COMMON.LOCAL'
3666 include 'COMMON.CHAIN'
3667 include 'COMMON.DERIV'
3668 include 'COMMON.INTERACT'
3669 include 'COMMON.CONTACTS'
3670 include 'COMMON.TORSION'
3671 include 'COMMON.VECTORS'
3672 include 'COMMON.FFIELD'
3673 include 'COMMON.CONTROL'
3675 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3676 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3677 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3678 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3679 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3680 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3681 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3684 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3686 C Fourth-order contributions
3694 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3695 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3696 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3701 iti1=itortyp(itype(i+1))
3702 iti2=itortyp(itype(i+2))
3703 iti3=itortyp(itype(i+3))
3704 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3705 call transpose2(EUg(1,1,i+1),e1t(1,1))
3706 call transpose2(Eug(1,1,i+2),e2t(1,1))
3707 call transpose2(Eug(1,1,i+3),e3t(1,1))
3708 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3709 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3710 s1=scalar2(b1(1,iti2),auxvec(1))
3711 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3712 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3713 s2=scalar2(b1(1,iti1),auxvec(1))
3714 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3715 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3716 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3717 eello_turn4=eello_turn4-(s1+s2+s3)
3718 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3719 & 'eturn4',i,j,-(s1+s2+s3)
3720 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3721 cd & ' eello_turn4_num',8*eello_turn4_num
3722 C Derivatives in gamma(i)
3723 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3724 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3725 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3726 s1=scalar2(b1(1,iti2),auxvec(1))
3727 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3729 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3730 C Derivatives in gamma(i+1)
3731 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3732 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3733 s2=scalar2(b1(1,iti1),auxvec(1))
3734 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3735 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3736 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3737 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3738 C Derivatives in gamma(i+2)
3739 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3740 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3741 s1=scalar2(b1(1,iti2),auxvec(1))
3742 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3743 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3744 s2=scalar2(b1(1,iti1),auxvec(1))
3745 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3746 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3747 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3748 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3749 C Cartesian derivatives
3750 C Derivatives of this turn contributions in DC(i+2)
3751 if (j.lt.nres-1) then
3753 a_temp(1,1)=agg(l,1)
3754 a_temp(1,2)=agg(l,2)
3755 a_temp(2,1)=agg(l,3)
3756 a_temp(2,2)=agg(l,4)
3757 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3758 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3759 s1=scalar2(b1(1,iti2),auxvec(1))
3760 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3761 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3762 s2=scalar2(b1(1,iti1),auxvec(1))
3763 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3764 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3765 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3767 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3770 C Remaining derivatives of this turn contribution
3772 a_temp(1,1)=aggi(l,1)
3773 a_temp(1,2)=aggi(l,2)
3774 a_temp(2,1)=aggi(l,3)
3775 a_temp(2,2)=aggi(l,4)
3776 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3777 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3778 s1=scalar2(b1(1,iti2),auxvec(1))
3779 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3780 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3781 s2=scalar2(b1(1,iti1),auxvec(1))
3782 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3783 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3784 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3785 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3786 a_temp(1,1)=aggi1(l,1)
3787 a_temp(1,2)=aggi1(l,2)
3788 a_temp(2,1)=aggi1(l,3)
3789 a_temp(2,2)=aggi1(l,4)
3790 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3791 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3792 s1=scalar2(b1(1,iti2),auxvec(1))
3793 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3794 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3795 s2=scalar2(b1(1,iti1),auxvec(1))
3796 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3797 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3798 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3799 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3800 a_temp(1,1)=aggj(l,1)
3801 a_temp(1,2)=aggj(l,2)
3802 a_temp(2,1)=aggj(l,3)
3803 a_temp(2,2)=aggj(l,4)
3804 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3805 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3806 s1=scalar2(b1(1,iti2),auxvec(1))
3807 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3808 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3809 s2=scalar2(b1(1,iti1),auxvec(1))
3810 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3811 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3812 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3813 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3814 a_temp(1,1)=aggj1(l,1)
3815 a_temp(1,2)=aggj1(l,2)
3816 a_temp(2,1)=aggj1(l,3)
3817 a_temp(2,2)=aggj1(l,4)
3818 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3819 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3820 s1=scalar2(b1(1,iti2),auxvec(1))
3821 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3822 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3823 s2=scalar2(b1(1,iti1),auxvec(1))
3824 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3825 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3826 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3827 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3828 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3832 C-----------------------------------------------------------------------------
3833 subroutine vecpr(u,v,w)
3834 implicit real*8(a-h,o-z)
3835 dimension u(3),v(3),w(3)
3836 w(1)=u(2)*v(3)-u(3)*v(2)
3837 w(2)=-u(1)*v(3)+u(3)*v(1)
3838 w(3)=u(1)*v(2)-u(2)*v(1)
3841 C-----------------------------------------------------------------------------
3842 subroutine unormderiv(u,ugrad,unorm,ungrad)
3843 C This subroutine computes the derivatives of a normalized vector u, given
3844 C the derivatives computed without normalization conditions, ugrad. Returns
3847 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3848 double precision vec(3)
3849 double precision scalar
3851 c write (2,*) 'ugrad',ugrad
3854 vec(i)=scalar(ugrad(1,i),u(1))
3856 c write (2,*) 'vec',vec
3859 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3862 c write (2,*) 'ungrad',ungrad
3865 C-----------------------------------------------------------------------------
3866 subroutine escp_soft_sphere(evdw2,evdw2_14)
3868 C This subroutine calculates the excluded-volume interaction energy between
3869 C peptide-group centers and side chains and its gradient in virtual-bond and
3870 C side-chain vectors.
3872 implicit real*8 (a-h,o-z)
3873 include 'DIMENSIONS'
3874 include 'COMMON.GEO'
3875 include 'COMMON.VAR'
3876 include 'COMMON.LOCAL'
3877 include 'COMMON.CHAIN'
3878 include 'COMMON.DERIV'
3879 include 'COMMON.INTERACT'
3880 include 'COMMON.FFIELD'
3881 include 'COMMON.IOUNITS'
3882 include 'COMMON.CONTROL'
3887 cd print '(a)','Enter ESCP'
3888 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3889 do i=iatscp_s,iatscp_e
3890 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3892 xi=0.5D0*(c(1,i)+c(1,i+1))
3893 yi=0.5D0*(c(2,i)+c(2,i+1))
3894 zi=0.5D0*(c(3,i)+c(3,i+1))
3896 do iint=1,nscp_gr(i)
3898 do j=iscpstart(i,iint),iscpend(i,iint)
3899 if (itype(j).eq.ntyp1) cycle
3900 itypj=iabs(itype(j))
3901 C Uncomment following three lines for SC-p interactions
3905 C Uncomment following three lines for Ca-p interactions
3909 rij=xj*xj+yj*yj+zj*zj
3912 if (rij.lt.r0ijsq) then
3913 evdwij=0.25d0*(rij-r0ijsq)**2
3921 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3926 cgrad if (j.lt.i) then
3927 cd write (iout,*) 'j<i'
3928 C Uncomment following three lines for SC-p interactions
3930 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3933 cd write (iout,*) 'j>i'
3935 cgrad ggg(k)=-ggg(k)
3936 C Uncomment following line for SC-p interactions
3937 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3941 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3943 cgrad kstart=min0(i+1,j)
3944 cgrad kend=max0(i-1,j-1)
3945 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3946 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3947 cgrad do k=kstart,kend
3949 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3953 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3954 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3962 C-----------------------------------------------------------------------------
3963 subroutine escp(evdw2,evdw2_14)
3965 C This subroutine calculates the excluded-volume interaction energy between
3966 C peptide-group centers and side chains and its gradient in virtual-bond and
3967 C side-chain vectors.
3969 implicit real*8 (a-h,o-z)
3970 include 'DIMENSIONS'
3971 include 'COMMON.GEO'
3972 include 'COMMON.VAR'
3973 include 'COMMON.LOCAL'
3974 include 'COMMON.CHAIN'
3975 include 'COMMON.DERIV'
3976 include 'COMMON.INTERACT'
3977 include 'COMMON.FFIELD'
3978 include 'COMMON.IOUNITS'
3979 include 'COMMON.CONTROL'
3983 cd print '(a)','Enter ESCP'
3984 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3985 do i=iatscp_s,iatscp_e
3986 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3988 xi=0.5D0*(c(1,i)+c(1,i+1))
3989 yi=0.5D0*(c(2,i)+c(2,i+1))
3990 zi=0.5D0*(c(3,i)+c(3,i+1))
3992 do iint=1,nscp_gr(i)
3994 do j=iscpstart(i,iint),iscpend(i,iint)
3995 itypj=iabs(itype(j))
3996 if (itypj.eq.ntyp1) cycle
3997 C Uncomment following three lines for SC-p interactions
4001 C Uncomment following three lines for Ca-p interactions
4005 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4007 e1=fac*fac*aad(itypj,iteli)
4008 e2=fac*bad(itypj,iteli)
4009 if (iabs(j-i) .le. 2) then
4012 evdw2_14=evdw2_14+e1+e2
4016 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4017 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4020 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4022 fac=-(evdwij+e1)*rrij
4026 cgrad if (j.lt.i) then
4027 cd write (iout,*) 'j<i'
4028 C Uncomment following three lines for SC-p interactions
4030 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4033 cd write (iout,*) 'j>i'
4035 cgrad ggg(k)=-ggg(k)
4036 C Uncomment following line for SC-p interactions
4037 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4038 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4042 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4044 cgrad kstart=min0(i+1,j)
4045 cgrad kend=max0(i-1,j-1)
4046 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4047 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4048 cgrad do k=kstart,kend
4050 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4054 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4055 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4063 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4064 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4065 gradx_scp(j,i)=expon*gradx_scp(j,i)
4068 C******************************************************************************
4072 C To save time the factor EXPON has been extracted from ALL components
4073 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4076 C******************************************************************************
4079 C--------------------------------------------------------------------------
4080 subroutine edis(ehpb)
4082 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4084 implicit real*8 (a-h,o-z)
4085 include 'DIMENSIONS'
4086 include 'COMMON.SBRIDGE'
4087 include 'COMMON.CHAIN'
4088 include 'COMMON.DERIV'
4089 include 'COMMON.VAR'
4090 include 'COMMON.INTERACT'
4091 include 'COMMON.IOUNITS'
4092 include 'COMMON.CONTROL'
4098 C write (iout,*) ,"link_end",link_end,constr_dist
4099 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4100 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4101 if (link_end.eq.0) return
4102 do i=link_start,link_end
4103 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4104 C CA-CA distance used in regularization of structure.
4107 C iii and jjj point to the residues for which the distance is assigned.
4108 if (ii.gt.nres) then
4115 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4116 c & dhpb(i),dhpb1(i),forcon(i)
4117 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4118 C distance and angle dependent SS bond potential.
4119 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4120 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4121 if (.not.dyn_ss .and. i.le.nss) then
4122 C 15/02/13 CC dynamic SSbond - additional check
4123 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4124 & iabs(itype(jjj)).eq.1) then
4125 call ssbond_ene(iii,jjj,eij)
4128 cd write (iout,*) "eij",eij
4129 cd & ' waga=',waga,' fac=',fac
4130 else if (ii.gt.nres .and. jj.gt.nres) then
4131 c Restraints from contact prediction
4133 if (constr_dist.eq.11) then
4134 ehpb=ehpb+fordepth(i)**4.0d0
4135 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4136 fac=fordepth(i)**4.0d0
4137 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4138 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4139 & ehpb,fordepth(i),dd
4141 if (dhpb1(i).gt.0.0d0) then
4142 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4143 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4144 c write (iout,*) "beta nmr",
4145 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4149 C Get the force constant corresponding to this distance.
4151 C Calculate the contribution to energy.
4152 ehpb=ehpb+waga*rdis*rdis
4153 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4155 C Evaluate gradient.
4161 ggg(j)=fac*(c(j,jj)-c(j,ii))
4164 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4165 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4168 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4169 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4172 C Calculate the distance between the two points and its difference from the
4175 if (constr_dist.eq.11) then
4176 ehpb=ehpb+fordepth(i)**4.0d0
4177 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4178 fac=fordepth(i)**4.0d0
4179 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4180 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
4181 & ehpb,fordepth(i),dd
4183 if (dhpb1(i).gt.0.0d0) then
4184 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4185 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4186 c write (iout,*) "alph nmr",
4187 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4190 C Get the force constant corresponding to this distance.
4192 C Calculate the contribution to energy.
4193 ehpb=ehpb+waga*rdis*rdis
4194 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4196 C Evaluate gradient.
4202 ggg(j)=fac*(c(j,jj)-c(j,ii))
4204 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4205 C If this is a SC-SC distance, we need to calculate the contributions to the
4206 C Cartesian gradient in the SC vectors (ghpbx).
4209 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4210 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4213 cgrad do j=iii,jjj-1
4215 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4219 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4220 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4224 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4227 C--------------------------------------------------------------------------
4228 subroutine ssbond_ene(i,j,eij)
4230 C Calculate the distance and angle dependent SS-bond potential energy
4231 C using a free-energy function derived based on RHF/6-31G** ab initio
4232 C calculations of diethyl disulfide.
4234 C A. Liwo and U. Kozlowska, 11/24/03
4236 implicit real*8 (a-h,o-z)
4237 include 'DIMENSIONS'
4238 include 'COMMON.SBRIDGE'
4239 include 'COMMON.CHAIN'
4240 include 'COMMON.DERIV'
4241 include 'COMMON.LOCAL'
4242 include 'COMMON.INTERACT'
4243 include 'COMMON.VAR'
4244 include 'COMMON.IOUNITS'
4245 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4246 itypi=iabs(itype(i))
4250 dxi=dc_norm(1,nres+i)
4251 dyi=dc_norm(2,nres+i)
4252 dzi=dc_norm(3,nres+i)
4253 c dsci_inv=dsc_inv(itypi)
4254 dsci_inv=vbld_inv(nres+i)
4255 itypj=iabs(itype(j))
4256 c dscj_inv=dsc_inv(itypj)
4257 dscj_inv=vbld_inv(nres+j)
4261 dxj=dc_norm(1,nres+j)
4262 dyj=dc_norm(2,nres+j)
4263 dzj=dc_norm(3,nres+j)
4264 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4269 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4270 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4271 om12=dxi*dxj+dyi*dyj+dzi*dzj
4273 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4274 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4280 deltat12=om2-om1+2.0d0
4282 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4283 & +akct*deltad*deltat12
4284 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4285 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4286 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4287 c & " deltat12",deltat12," eij",eij
4288 ed=2*akcm*deltad+akct*deltat12
4290 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4291 eom1=-2*akth*deltat1-pom1-om2*pom2
4292 eom2= 2*akth*deltat2+pom1-om1*pom2
4295 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4296 ghpbx(k,i)=ghpbx(k,i)-ggk
4297 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4298 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4299 ghpbx(k,j)=ghpbx(k,j)+ggk
4300 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4301 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4302 ghpbc(k,i)=ghpbc(k,i)-ggk
4303 ghpbc(k,j)=ghpbc(k,j)+ggk
4306 C Calculate the components of the gradient in DC and X
4310 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4315 C--------------------------------------------------------------------------
4316 subroutine ebond(estr)
4318 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4320 implicit real*8 (a-h,o-z)
4321 include 'DIMENSIONS'
4322 include 'COMMON.LOCAL'
4323 include 'COMMON.GEO'
4324 include 'COMMON.INTERACT'
4325 include 'COMMON.DERIV'
4326 include 'COMMON.VAR'
4327 include 'COMMON.CHAIN'
4328 include 'COMMON.IOUNITS'
4329 include 'COMMON.NAMES'
4330 include 'COMMON.FFIELD'
4331 include 'COMMON.CONTROL'
4332 include 'COMMON.SETUP'
4333 double precision u(3),ud(3)
4336 do i=ibondp_start,ibondp_end
4337 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4338 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4340 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4341 & *dc(j,i-1)/vbld(i)
4343 if (energy_dec) write(iout,*)
4344 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4346 diff = vbld(i)-vbldp0
4347 if (energy_dec) write (iout,*)
4348 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4351 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4353 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4356 estr=0.5d0*AKP*estr+estr1
4358 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4360 do i=ibond_start,ibond_end
4362 if (iti.ne.10 .and. iti.ne.ntyp1) then
4365 diff=vbld(i+nres)-vbldsc0(1,iti)
4366 if (energy_dec) write (iout,*)
4367 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4368 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4369 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4371 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4375 diff=vbld(i+nres)-vbldsc0(j,iti)
4376 ud(j)=aksc(j,iti)*diff
4377 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4391 uprod2=uprod2*u(k)*u(k)
4395 usumsqder=usumsqder+ud(j)*uprod2
4397 estr=estr+uprod/usum
4399 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4407 C--------------------------------------------------------------------------
4408 subroutine ebend(etheta)
4410 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4411 C angles gamma and its derivatives in consecutive thetas and gammas.
4413 implicit real*8 (a-h,o-z)
4414 include 'DIMENSIONS'
4415 include 'COMMON.LOCAL'
4416 include 'COMMON.GEO'
4417 include 'COMMON.INTERACT'
4418 include 'COMMON.DERIV'
4419 include 'COMMON.VAR'
4420 include 'COMMON.CHAIN'
4421 include 'COMMON.IOUNITS'
4422 include 'COMMON.NAMES'
4423 include 'COMMON.FFIELD'
4424 include 'COMMON.CONTROL'
4425 common /calcthet/ term1,term2,termm,diffak,ratak,
4426 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4427 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4428 double precision y(2),z(2)
4430 c time11=dexp(-2*time)
4433 c write (*,'(a,i2)') 'EBEND ICG=',icg
4434 do i=ithet_start,ithet_end
4435 if (itype(i-1).eq.ntyp1) cycle
4436 C Zero the energy function and its derivative at 0 or pi.
4437 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4439 ichir1=isign(1,itype(i-2))
4440 ichir2=isign(1,itype(i))
4441 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4442 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4443 if (itype(i-1).eq.10) then
4444 itype1=isign(10,itype(i-2))
4445 ichir11=isign(1,itype(i-2))
4446 ichir12=isign(1,itype(i-2))
4447 itype2=isign(10,itype(i))
4448 ichir21=isign(1,itype(i))
4449 ichir22=isign(1,itype(i))
4452 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4455 if (phii.ne.phii) phii=150.0
4465 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4468 if (phii1.ne.phii1) phii1=150.0
4480 C Calculate the "mean" value of theta from the part of the distribution
4481 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4482 C In following comments this theta will be referred to as t_c.
4483 thet_pred_mean=0.0d0
4485 athetk=athet(k,it,ichir1,ichir2)
4486 bthetk=bthet(k,it,ichir1,ichir2)
4488 athetk=athet(k,itype1,ichir11,ichir12)
4489 bthetk=bthet(k,itype2,ichir21,ichir22)
4491 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4493 dthett=thet_pred_mean*ssd
4494 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4495 C Derivatives of the "mean" values in gamma1 and gamma2.
4496 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4497 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4498 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4499 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4501 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4502 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4503 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4504 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4506 if (theta(i).gt.pi-delta) then
4507 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4509 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4510 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4511 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4513 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4515 else if (theta(i).lt.delta) then
4516 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4517 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4518 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4520 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4521 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4524 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4527 etheta=etheta+ethetai
4528 do i=ithetaconstr_start,ithetaconstr_end
4529 itheta=itheta_constr(i)
4530 thetiii=theta(itori)
4531 difi=pinorm(thetiii-theta_constr0(i))
4532 if (difi.gt.theta_drange(i)) then
4533 difi=difi-theta_drange(i)
4534 ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
4535 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4536 & +for_thet_constr(i)*difi**3
4537 else if (difi.lt.-drange(i)) then
4539 ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
4540 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4541 & +for_thet_constr(i)*difi**3
4545 if (energy_dec) then
4546 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4547 & i,itheta,rad2deg*thetiii,
4548 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4549 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4550 & gloc(itheta+nphi-2,icg)
4553 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4555 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4556 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4557 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4559 C Ufff.... We've done all this!!!
4562 C---------------------------------------------------------------------------
4563 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4565 implicit real*8 (a-h,o-z)
4566 include 'DIMENSIONS'
4567 include 'COMMON.LOCAL'
4568 include 'COMMON.IOUNITS'
4569 common /calcthet/ term1,term2,termm,diffak,ratak,
4570 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4571 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4572 C Calculate the contributions to both Gaussian lobes.
4573 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4574 C The "polynomial part" of the "standard deviation" of this part of
4578 sig=sig*thet_pred_mean+polthet(j,it)
4580 C Derivative of the "interior part" of the "standard deviation of the"
4581 C gamma-dependent Gaussian lobe in t_c.
4582 sigtc=3*polthet(3,it)
4584 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4587 C Set the parameters of both Gaussian lobes of the distribution.
4588 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4589 fac=sig*sig+sigc0(it)
4592 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4593 sigsqtc=-4.0D0*sigcsq*sigtc
4594 c print *,i,sig,sigtc,sigsqtc
4595 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4596 sigtc=-sigtc/(fac*fac)
4597 C Following variable is sigma(t_c)**(-2)
4598 sigcsq=sigcsq*sigcsq
4600 sig0inv=1.0D0/sig0i**2
4601 delthec=thetai-thet_pred_mean
4602 delthe0=thetai-theta0i
4603 term1=-0.5D0*sigcsq*delthec*delthec
4604 term2=-0.5D0*sig0inv*delthe0*delthe0
4605 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4606 C NaNs in taking the logarithm. We extract the largest exponent which is added
4607 C to the energy (this being the log of the distribution) at the end of energy
4608 C term evaluation for this virtual-bond angle.
4609 if (term1.gt.term2) then
4611 term2=dexp(term2-termm)
4615 term1=dexp(term1-termm)
4618 C The ratio between the gamma-independent and gamma-dependent lobes of
4619 C the distribution is a Gaussian function of thet_pred_mean too.
4620 diffak=gthet(2,it)-thet_pred_mean
4621 ratak=diffak/gthet(3,it)**2
4622 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4623 C Let's differentiate it in thet_pred_mean NOW.
4625 C Now put together the distribution terms to make complete distribution.
4626 termexp=term1+ak*term2
4627 termpre=sigc+ak*sig0i
4628 C Contribution of the bending energy from this theta is just the -log of
4629 C the sum of the contributions from the two lobes and the pre-exponential
4630 C factor. Simple enough, isn't it?
4631 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4632 C NOW the derivatives!!!
4633 C 6/6/97 Take into account the deformation.
4634 E_theta=(delthec*sigcsq*term1
4635 & +ak*delthe0*sig0inv*term2)/termexp
4636 E_tc=((sigtc+aktc*sig0i)/termpre
4637 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4638 & aktc*term2)/termexp)
4641 c-----------------------------------------------------------------------------
4642 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4643 implicit real*8 (a-h,o-z)
4644 include 'DIMENSIONS'
4645 include 'COMMON.LOCAL'
4646 include 'COMMON.IOUNITS'
4647 common /calcthet/ term1,term2,termm,diffak,ratak,
4648 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4649 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4650 delthec=thetai-thet_pred_mean
4651 delthe0=thetai-theta0i
4652 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4653 t3 = thetai-thet_pred_mean
4657 t14 = t12+t6*sigsqtc
4659 t21 = thetai-theta0i
4665 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4666 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4667 & *(-t12*t9-ak*sig0inv*t27)
4671 C--------------------------------------------------------------------------
4672 subroutine ebend(etheta)
4674 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4675 C angles gamma and its derivatives in consecutive thetas and gammas.
4676 C ab initio-derived potentials from
4677 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4679 implicit real*8 (a-h,o-z)
4680 include 'DIMENSIONS'
4681 include 'COMMON.LOCAL'
4682 include 'COMMON.GEO'
4683 include 'COMMON.INTERACT'
4684 include 'COMMON.DERIV'
4685 include 'COMMON.VAR'
4686 include 'COMMON.CHAIN'
4687 include 'COMMON.IOUNITS'
4688 include 'COMMON.NAMES'
4689 include 'COMMON.FFIELD'
4690 include 'COMMON.CONTROL'
4691 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4692 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4693 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4694 & sinph1ph2(maxdouble,maxdouble)
4695 logical lprn /.false./, lprn1 /.false./
4697 do i=ithet_start,ithet_end
4698 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4699 &(itype(i).eq.ntyp1)) cycle
4700 C print *,i,theta(i)
4701 if (iabs(itype(i+1)).eq.20) iblock=2
4702 if (iabs(itype(i+1)).ne.20) iblock=1
4706 theti2=0.5d0*theta(i)
4707 ityp2=ithetyp((itype(i-1)))
4709 coskt(k)=dcos(k*theti2)
4710 sinkt(k)=dsin(k*theti2)
4714 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4717 if (phii.ne.phii) phii=150.0
4721 ityp1=ithetyp((itype(i-2)))
4722 C propagation of chirality for glycine type
4724 cosph1(k)=dcos(k*phii)
4725 sinph1(k)=dsin(k*phii)
4730 ityp1=ithetyp((itype(i-2)))
4735 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4738 if (phii1.ne.phii1) phii1=150.0
4743 ityp3=ithetyp((itype(i)))
4745 cosph2(k)=dcos(k*phii1)
4746 sinph2(k)=dsin(k*phii1)
4750 ityp3=ithetyp((itype(i)))
4756 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4759 ccl=cosph1(l)*cosph2(k-l)
4760 ssl=sinph1(l)*sinph2(k-l)
4761 scl=sinph1(l)*cosph2(k-l)
4762 csl=cosph1(l)*sinph2(k-l)
4763 cosph1ph2(l,k)=ccl-ssl
4764 cosph1ph2(k,l)=ccl+ssl
4765 sinph1ph2(l,k)=scl+csl
4766 sinph1ph2(k,l)=scl-csl
4770 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4771 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4772 write (iout,*) "coskt and sinkt"
4774 write (iout,*) k,coskt(k),sinkt(k)
4778 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4779 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4782 & write (iout,*) "k",k,"
4783 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4784 & " ethetai",ethetai
4787 write (iout,*) "cosph and sinph"
4789 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4791 write (iout,*) "cosph1ph2 and sinph2ph2"
4794 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4795 & sinph1ph2(l,k),sinph1ph2(k,l)
4798 write(iout,*) "ethetai",ethetai
4803 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4804 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4805 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4806 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4807 ethetai=ethetai+sinkt(m)*aux
4808 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4809 dephii=dephii+k*sinkt(m)*(
4810 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4811 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4812 dephii1=dephii1+k*sinkt(m)*(
4813 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4814 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4816 & write (iout,*) "m",m," k",k," bbthet",
4817 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4818 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4819 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4820 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4821 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4824 C print *,"cosph1", (cosph1(k), k=1,nsingle)
4825 C print *,"cosph2", (cosph2(k), k=1,nsingle)
4826 C print *,"sinph1", (sinph1(k), k=1,nsingle)
4827 C print *,"sinph2", (sinph2(k), k=1,nsingle)
4829 & write(iout,*) "ethetai",ethetai
4830 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4834 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4835 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4836 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4837 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4838 ethetai=ethetai+sinkt(m)*aux
4839 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4840 dephii=dephii+l*sinkt(m)*(
4841 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4842 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4843 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4844 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4845 dephii1=dephii1+(k-l)*sinkt(m)*(
4846 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4847 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4848 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4849 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4851 write (iout,*) "m",m," k",k," l",l," ffthet",
4852 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4853 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4854 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4855 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4856 & " ethetai",ethetai
4857 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4858 & cosph1ph2(k,l)*sinkt(m),
4859 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4865 C now we have the theta_constrains
4866 do i=ithetaconstr_start,ithetaconstr_end
4867 itheta=itheta_constr(i)
4868 thetiii=theta(itori)
4869 difi=pinorm(thetiii-theta_constr0(i))
4870 if (difi.gt.theta_drange(i)) then
4871 difi=difi-theta_drange(i)
4872 ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
4873 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4874 & +for_thet_constr(i)*difi**3
4875 else if (difi.lt.-drange(i)) then
4877 ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
4878 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4879 & +for_thet_constr(i)*difi**3
4883 if (energy_dec) then
4884 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4885 & i,itheta,rad2deg*thetiii,
4886 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4887 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4888 & gloc(itheta+nphi-2,icg)
4895 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4896 & i,theta(i)*rad2deg,phii*rad2deg,
4897 & phii1*rad2deg,ethetai
4899 etheta=etheta+ethetai
4900 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4901 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4902 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4908 c-----------------------------------------------------------------------------
4909 subroutine esc(escloc)
4910 C Calculate the local energy of a side chain and its derivatives in the
4911 C corresponding virtual-bond valence angles THETA and the spherical angles
4913 implicit real*8 (a-h,o-z)
4914 include 'DIMENSIONS'
4915 include 'COMMON.GEO'
4916 include 'COMMON.LOCAL'
4917 include 'COMMON.VAR'
4918 include 'COMMON.INTERACT'
4919 include 'COMMON.DERIV'
4920 include 'COMMON.CHAIN'
4921 include 'COMMON.IOUNITS'
4922 include 'COMMON.NAMES'
4923 include 'COMMON.FFIELD'
4924 include 'COMMON.CONTROL'
4925 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4926 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4927 common /sccalc/ time11,time12,time112,theti,it,nlobit
4930 c write (iout,'(a)') 'ESC'
4931 do i=loc_start,loc_end
4933 if (it.eq.ntyp1) cycle
4934 if (it.eq.10) goto 1
4935 nlobit=nlob(iabs(it))
4936 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4937 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4938 theti=theta(i+1)-pipol
4943 if (x(2).gt.pi-delta) then
4947 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4949 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4950 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4952 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4953 & ddersc0(1),dersc(1))
4954 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4955 & ddersc0(3),dersc(3))
4957 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4959 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4960 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4961 & dersc0(2),esclocbi,dersc02)
4962 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4964 call splinthet(x(2),0.5d0*delta,ss,ssd)
4969 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4971 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4972 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4974 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4976 c write (iout,*) escloci
4977 else if (x(2).lt.delta) then
4981 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4983 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4984 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4986 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4987 & ddersc0(1),dersc(1))
4988 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4989 & ddersc0(3),dersc(3))
4991 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4993 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4994 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4995 & dersc0(2),esclocbi,dersc02)
4996 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5001 call splinthet(x(2),0.5d0*delta,ss,ssd)
5003 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5005 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5006 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5008 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5009 c write (iout,*) escloci
5011 call enesc(x,escloci,dersc,ddummy,.false.)
5014 escloc=escloc+escloci
5015 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5016 & 'escloc',i,escloci
5017 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5019 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5021 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5022 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5027 C---------------------------------------------------------------------------
5028 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5029 implicit real*8 (a-h,o-z)
5030 include 'DIMENSIONS'
5031 include 'COMMON.GEO'
5032 include 'COMMON.LOCAL'
5033 include 'COMMON.IOUNITS'
5034 common /sccalc/ time11,time12,time112,theti,it,nlobit
5035 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5036 double precision contr(maxlob,-1:1)
5038 c write (iout,*) 'it=',it,' nlobit=',nlobit
5042 if (mixed) ddersc(j)=0.0d0
5046 C Because of periodicity of the dependence of the SC energy in omega we have
5047 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5048 C To avoid underflows, first compute & store the exponents.
5056 z(k)=x(k)-censc(k,j,it)
5061 Axk=Axk+gaussc(l,k,j,it)*z(l)
5067 expfac=expfac+Ax(k,j,iii)*z(k)
5075 C As in the case of ebend, we want to avoid underflows in exponentiation and
5076 C subsequent NaNs and INFs in energy calculation.
5077 C Find the largest exponent
5081 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5085 cd print *,'it=',it,' emin=',emin
5087 C Compute the contribution to SC energy and derivatives
5092 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5093 if(adexp.ne.adexp) adexp=1.0
5096 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5098 cd print *,'j=',j,' expfac=',expfac
5099 escloc_i=escloc_i+expfac
5101 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5105 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5106 & +gaussc(k,2,j,it))*expfac
5113 dersc(1)=dersc(1)/cos(theti)**2
5114 ddersc(1)=ddersc(1)/cos(theti)**2
5117 escloci=-(dlog(escloc_i)-emin)
5119 dersc(j)=dersc(j)/escloc_i
5123 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5128 C------------------------------------------------------------------------------
5129 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5130 implicit real*8 (a-h,o-z)
5131 include 'DIMENSIONS'
5132 include 'COMMON.GEO'
5133 include 'COMMON.LOCAL'
5134 include 'COMMON.IOUNITS'
5135 common /sccalc/ time11,time12,time112,theti,it,nlobit
5136 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5137 double precision contr(maxlob)
5148 z(k)=x(k)-censc(k,j,it)
5154 Axk=Axk+gaussc(l,k,j,it)*z(l)
5160 expfac=expfac+Ax(k,j)*z(k)
5165 C As in the case of ebend, we want to avoid underflows in exponentiation and
5166 C subsequent NaNs and INFs in energy calculation.
5167 C Find the largest exponent
5170 if (emin.gt.contr(j)) emin=contr(j)
5174 C Compute the contribution to SC energy and derivatives
5178 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5179 escloc_i=escloc_i+expfac
5181 dersc(k)=dersc(k)+Ax(k,j)*expfac
5183 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5184 & +gaussc(1,2,j,it))*expfac
5188 dersc(1)=dersc(1)/cos(theti)**2
5189 dersc12=dersc12/cos(theti)**2
5190 escloci=-(dlog(escloc_i)-emin)
5192 dersc(j)=dersc(j)/escloc_i
5194 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5198 c----------------------------------------------------------------------------------
5199 subroutine esc(escloc)
5200 C Calculate the local energy of a side chain and its derivatives in the
5201 C corresponding virtual-bond valence angles THETA and the spherical angles
5202 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5203 C added by Urszula Kozlowska. 07/11/2007
5205 implicit real*8 (a-h,o-z)
5206 include 'DIMENSIONS'
5207 include 'COMMON.GEO'
5208 include 'COMMON.LOCAL'
5209 include 'COMMON.VAR'
5210 include 'COMMON.SCROT'
5211 include 'COMMON.INTERACT'
5212 include 'COMMON.DERIV'
5213 include 'COMMON.CHAIN'
5214 include 'COMMON.IOUNITS'
5215 include 'COMMON.NAMES'
5216 include 'COMMON.FFIELD'
5217 include 'COMMON.CONTROL'
5218 include 'COMMON.VECTORS'
5219 double precision x_prime(3),y_prime(3),z_prime(3)
5220 & , sumene,dsc_i,dp2_i,x(65),
5221 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5222 & de_dxx,de_dyy,de_dzz,de_dt
5223 double precision s1_t,s1_6_t,s2_t,s2_6_t
5225 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5226 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5227 & dt_dCi(3),dt_dCi1(3)
5228 common /sccalc/ time11,time12,time112,theti,it,nlobit
5231 do i=loc_start,loc_end
5232 if (itype(i).eq.ntyp1) cycle
5233 costtab(i+1) =dcos(theta(i+1))
5234 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5235 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5236 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5237 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5238 cosfac=dsqrt(cosfac2)
5239 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5240 sinfac=dsqrt(sinfac2)
5242 if (it.eq.10) goto 1
5244 C Compute the axes of tghe local cartesian coordinates system; store in
5245 c x_prime, y_prime and z_prime
5252 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5253 C & dc_norm(3,i+nres)
5255 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5256 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5259 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5262 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5263 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5264 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5265 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5266 c & " xy",scalar(x_prime(1),y_prime(1)),
5267 c & " xz",scalar(x_prime(1),z_prime(1)),
5268 c & " yy",scalar(y_prime(1),y_prime(1)),
5269 c & " yz",scalar(y_prime(1),z_prime(1)),
5270 c & " zz",scalar(z_prime(1),z_prime(1))
5272 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5273 C to local coordinate system. Store in xx, yy, zz.
5279 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5280 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5281 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5288 C Compute the energy of the ith side cbain
5290 c write (2,*) "xx",xx," yy",yy," zz",zz
5293 x(j) = sc_parmin(j,it)
5296 Cc diagnostics - remove later
5298 yy1 = dsin(alph(2))*dcos(omeg(2))
5299 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5300 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5301 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5303 C," --- ", xx_w,yy_w,zz_w
5306 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5307 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5309 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5310 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5312 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5313 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5314 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5315 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5316 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5318 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5319 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5320 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5321 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5322 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5324 dsc_i = 0.743d0+x(61)
5326 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5327 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5328 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5329 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5330 s1=(1+x(63))/(0.1d0 + dscp1)
5331 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5332 s2=(1+x(65))/(0.1d0 + dscp2)
5333 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5334 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5335 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5336 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5338 c & dscp1,dscp2,sumene
5339 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5340 escloc = escloc + sumene
5341 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5346 C This section to check the numerical derivatives of the energy of ith side
5347 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5348 C #define DEBUG in the code to turn it on.
5350 write (2,*) "sumene =",sumene
5354 write (2,*) xx,yy,zz
5355 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5356 de_dxx_num=(sumenep-sumene)/aincr
5358 write (2,*) "xx+ sumene from enesc=",sumenep
5361 write (2,*) xx,yy,zz
5362 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5363 de_dyy_num=(sumenep-sumene)/aincr
5365 write (2,*) "yy+ sumene from enesc=",sumenep
5368 write (2,*) xx,yy,zz
5369 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5370 de_dzz_num=(sumenep-sumene)/aincr
5372 write (2,*) "zz+ sumene from enesc=",sumenep
5373 costsave=cost2tab(i+1)
5374 sintsave=sint2tab(i+1)
5375 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5376 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5377 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5378 de_dt_num=(sumenep-sumene)/aincr
5379 write (2,*) " t+ sumene from enesc=",sumenep
5380 cost2tab(i+1)=costsave
5381 sint2tab(i+1)=sintsave
5382 C End of diagnostics section.
5385 C Compute the gradient of esc
5387 c zz=zz*dsign(1.0,dfloat(itype(i)))
5388 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5389 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5390 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5391 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5392 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5393 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5394 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5395 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5396 pom1=(sumene3*sint2tab(i+1)+sumene1)
5397 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5398 pom2=(sumene4*cost2tab(i+1)+sumene2)
5399 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5400 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5401 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5402 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5404 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5405 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5406 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5408 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5409 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5410 & +(pom1+pom2)*pom_dx
5412 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5415 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5416 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5417 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5419 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5420 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5421 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5422 & +x(59)*zz**2 +x(60)*xx*zz
5423 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5424 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5425 & +(pom1-pom2)*pom_dy
5427 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5430 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5431 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5432 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5433 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5434 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5435 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5436 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5437 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5439 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5442 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5443 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5444 & +pom1*pom_dt1+pom2*pom_dt2
5446 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5451 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5452 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5453 cosfac2xx=cosfac2*xx
5454 sinfac2yy=sinfac2*yy
5456 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5458 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5460 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5461 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5462 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5463 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5464 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5465 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5466 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5467 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5468 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5469 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5473 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5474 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5475 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5476 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5479 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5480 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5481 dZZ_XYZ(k)=vbld_inv(i+nres)*
5482 & (z_prime(k)-zz*dC_norm(k,i+nres))
5484 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5485 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5489 dXX_Ctab(k,i)=dXX_Ci(k)
5490 dXX_C1tab(k,i)=dXX_Ci1(k)
5491 dYY_Ctab(k,i)=dYY_Ci(k)
5492 dYY_C1tab(k,i)=dYY_Ci1(k)
5493 dZZ_Ctab(k,i)=dZZ_Ci(k)
5494 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5495 dXX_XYZtab(k,i)=dXX_XYZ(k)
5496 dYY_XYZtab(k,i)=dYY_XYZ(k)
5497 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5501 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5502 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5503 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5504 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5505 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5507 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5508 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5509 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5510 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5511 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5512 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5513 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5514 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5516 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5517 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5519 C to check gradient call subroutine check_grad
5525 c------------------------------------------------------------------------------
5526 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5528 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5529 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5530 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5531 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5533 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5534 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5536 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5537 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5538 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5539 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5540 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5542 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5543 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5544 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5545 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5546 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5548 dsc_i = 0.743d0+x(61)
5550 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5551 & *(xx*cost2+yy*sint2))
5552 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5553 & *(xx*cost2-yy*sint2))
5554 s1=(1+x(63))/(0.1d0 + dscp1)
5555 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5556 s2=(1+x(65))/(0.1d0 + dscp2)
5557 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5558 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5559 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5564 c------------------------------------------------------------------------------
5565 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5567 C This procedure calculates two-body contact function g(rij) and its derivative:
5570 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5573 C where x=(rij-r0ij)/delta
5575 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5578 double precision rij,r0ij,eps0ij,fcont,fprimcont
5579 double precision x,x2,x4,delta
5583 if (x.lt.-1.0D0) then
5586 else if (x.le.1.0D0) then
5589 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5590 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5597 c------------------------------------------------------------------------------
5598 subroutine splinthet(theti,delta,ss,ssder)
5599 implicit real*8 (a-h,o-z)
5600 include 'DIMENSIONS'
5601 include 'COMMON.VAR'
5602 include 'COMMON.GEO'
5605 if (theti.gt.pipol) then
5606 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5608 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5613 c------------------------------------------------------------------------------
5614 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5616 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5617 double precision ksi,ksi2,ksi3,a1,a2,a3
5618 a1=fprim0*delta/(f1-f0)
5624 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5625 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5628 c------------------------------------------------------------------------------
5629 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5631 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5632 double precision ksi,ksi2,ksi3,a1,a2,a3
5637 a2=3*(f1x-f0x)-2*fprim0x*delta
5638 a3=fprim0x*delta-2*(f1x-f0x)
5639 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5642 C-----------------------------------------------------------------------------
5644 C-----------------------------------------------------------------------------
5645 subroutine etor(etors,edihcnstr)
5646 implicit real*8 (a-h,o-z)
5647 include 'DIMENSIONS'
5648 include 'COMMON.VAR'
5649 include 'COMMON.GEO'
5650 include 'COMMON.LOCAL'
5651 include 'COMMON.TORSION'
5652 include 'COMMON.INTERACT'
5653 include 'COMMON.DERIV'
5654 include 'COMMON.CHAIN'
5655 include 'COMMON.NAMES'
5656 include 'COMMON.IOUNITS'
5657 include 'COMMON.FFIELD'
5658 include 'COMMON.TORCNSTR'
5659 include 'COMMON.CONTROL'
5661 C Set lprn=.true. for debugging
5665 do i=iphi_start,iphi_end
5667 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5668 & .or. itype(i).eq.ntyp1) cycle
5669 itori=itortyp(itype(i-2))
5670 itori1=itortyp(itype(i-1))
5673 C Proline-Proline pair is a special case...
5674 if (itori.eq.3 .and. itori1.eq.3) then
5675 if (phii.gt.-dwapi3) then
5677 fac=1.0D0/(1.0D0-cosphi)
5678 etorsi=v1(1,3,3)*fac
5679 etorsi=etorsi+etorsi
5680 etors=etors+etorsi-v1(1,3,3)
5681 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5682 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5685 v1ij=v1(j+1,itori,itori1)
5686 v2ij=v2(j+1,itori,itori1)
5689 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5690 if (energy_dec) etors_ii=etors_ii+
5691 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5692 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5696 v1ij=v1(j,itori,itori1)
5697 v2ij=v2(j,itori,itori1)
5700 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5701 if (energy_dec) etors_ii=etors_ii+
5702 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5703 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5706 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5709 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5710 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5711 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5712 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5713 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5715 ! 6/20/98 - dihedral angle constraints
5718 itori=idih_constr(i)
5721 if (difi.gt.drange(i)) then
5723 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5724 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5725 else if (difi.lt.-drange(i)) then
5727 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
5728 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5730 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5731 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5733 ! write (iout,*) 'edihcnstr',edihcnstr
5736 c------------------------------------------------------------------------------
5737 subroutine etor_d(etors_d)
5741 c----------------------------------------------------------------------------
5743 subroutine etor(etors,edihcnstr)
5744 implicit real*8 (a-h,o-z)
5745 include 'DIMENSIONS'
5746 include 'COMMON.VAR'
5747 include 'COMMON.GEO'
5748 include 'COMMON.LOCAL'
5749 include 'COMMON.TORSION'
5750 include 'COMMON.INTERACT'
5751 include 'COMMON.DERIV'
5752 include 'COMMON.CHAIN'
5753 include 'COMMON.NAMES'
5754 include 'COMMON.IOUNITS'
5755 include 'COMMON.FFIELD'
5756 include 'COMMON.TORCNSTR'
5757 include 'COMMON.CONTROL'
5759 C Set lprn=.true. for debugging
5763 do i=iphi_start,iphi_end
5764 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5765 & .or. itype(i).eq.ntyp1) cycle
5767 if (iabs(itype(i)).eq.20) then
5772 itori=itortyp(itype(i-2))
5773 itori1=itortyp(itype(i-1))
5776 C Regular cosine and sine terms
5777 do j=1,nterm(itori,itori1,iblock)
5778 v1ij=v1(j,itori,itori1,iblock)
5779 v2ij=v2(j,itori,itori1,iblock)
5782 etors=etors+v1ij*cosphi+v2ij*sinphi
5783 if (energy_dec) etors_ii=etors_ii+
5784 & v1ij*cosphi+v2ij*sinphi
5785 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5789 C E = SUM ----------------------------------- - v1
5790 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5792 cosphi=dcos(0.5d0*phii)
5793 sinphi=dsin(0.5d0*phii)
5794 do j=1,nlor(itori,itori1,iblock)
5795 vl1ij=vlor1(j,itori,itori1)
5796 vl2ij=vlor2(j,itori,itori1)
5797 vl3ij=vlor3(j,itori,itori1)
5798 pom=vl2ij*cosphi+vl3ij*sinphi
5799 pom1=1.0d0/(pom*pom+1.0d0)
5800 etors=etors+vl1ij*pom1
5801 if (energy_dec) etors_ii=etors_ii+
5804 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5806 C Subtract the constant term
5807 etors=etors-v0(itori,itori1,iblock)
5808 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5809 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5811 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5812 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5813 & (v1(j,itori,itori1,iblock),j=1,6),
5814 & (v2(j,itori,itori1,iblock),j=1,6)
5815 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5816 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5818 ! 6/20/98 - dihedral angle constraints
5820 c do i=1,ndih_constr
5821 do i=idihconstr_start,idihconstr_end
5822 itori=idih_constr(i)
5824 difi=pinorm(phii-phi0(i))
5825 if (difi.gt.drange(i)) then
5827 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5828 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5829 else if (difi.lt.-drange(i)) then
5831 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5832 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5836 if (energy_dec) then
5837 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
5838 & i,itori,rad2deg*phii,
5839 & rad2deg*phi0(i), rad2deg*drange(i),
5840 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5843 cd write (iout,*) 'edihcnstr',edihcnstr
5846 c----------------------------------------------------------------------------
5847 subroutine etor_d(etors_d)
5848 C 6/23/01 Compute double torsional energy
5849 implicit real*8 (a-h,o-z)
5850 include 'DIMENSIONS'
5851 include 'COMMON.VAR'
5852 include 'COMMON.GEO'
5853 include 'COMMON.LOCAL'
5854 include 'COMMON.TORSION'
5855 include 'COMMON.INTERACT'
5856 include 'COMMON.DERIV'
5857 include 'COMMON.CHAIN'
5858 include 'COMMON.NAMES'
5859 include 'COMMON.IOUNITS'
5860 include 'COMMON.FFIELD'
5861 include 'COMMON.TORCNSTR'
5863 C Set lprn=.true. for debugging
5867 c write(iout,*) "a tu??"
5868 do i=iphid_start,iphid_end
5869 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5870 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5871 itori=itortyp(itype(i-2))
5872 itori1=itortyp(itype(i-1))
5873 itori2=itortyp(itype(i))
5879 if (iabs(itype(i+1)).eq.20) iblock=2
5881 C Regular cosine and sine terms
5882 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5883 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5884 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5885 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5886 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5887 cosphi1=dcos(j*phii)
5888 sinphi1=dsin(j*phii)
5889 cosphi2=dcos(j*phii1)
5890 sinphi2=dsin(j*phii1)
5891 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5892 & v2cij*cosphi2+v2sij*sinphi2
5893 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5894 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5896 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5898 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5899 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5900 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5901 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5902 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5903 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5904 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5905 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5906 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5907 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5908 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5909 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5910 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5911 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5914 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5915 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5920 c------------------------------------------------------------------------------
5921 subroutine eback_sc_corr(esccor)
5922 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5923 c conformational states; temporarily implemented as differences
5924 c between UNRES torsional potentials (dependent on three types of
5925 c residues) and the torsional potentials dependent on all 20 types
5926 c of residues computed from AM1 energy surfaces of terminally-blocked
5927 c amino-acid residues.
5928 implicit real*8 (a-h,o-z)
5929 include 'DIMENSIONS'
5930 include 'COMMON.VAR'
5931 include 'COMMON.GEO'
5932 include 'COMMON.LOCAL'
5933 include 'COMMON.TORSION'
5934 include 'COMMON.SCCOR'
5935 include 'COMMON.INTERACT'
5936 include 'COMMON.DERIV'
5937 include 'COMMON.CHAIN'
5938 include 'COMMON.NAMES'
5939 include 'COMMON.IOUNITS'
5940 include 'COMMON.FFIELD'
5941 include 'COMMON.CONTROL'
5943 C Set lprn=.true. for debugging
5946 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5948 do i=itau_start,itau_end
5949 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5951 isccori=isccortyp(itype(i-2))
5952 isccori1=isccortyp(itype(i-1))
5953 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5955 do intertyp=1,3 !intertyp
5956 cc Added 09 May 2012 (Adasko)
5957 cc Intertyp means interaction type of backbone mainchain correlation:
5958 c 1 = SC...Ca...Ca...Ca
5959 c 2 = Ca...Ca...Ca...SC
5960 c 3 = SC...Ca...Ca...SCi
5962 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5963 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5964 & (itype(i-1).eq.ntyp1)))
5965 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5966 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5967 & .or.(itype(i).eq.ntyp1)))
5968 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5969 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5970 & (itype(i-3).eq.ntyp1)))) cycle
5971 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5972 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5974 do j=1,nterm_sccor(isccori,isccori1)
5975 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5976 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5977 cosphi=dcos(j*tauangle(intertyp,i))
5978 sinphi=dsin(j*tauangle(intertyp,i))
5979 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5980 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5982 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
5983 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5985 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5986 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5987 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5988 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5989 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5995 c----------------------------------------------------------------------------
5996 subroutine multibody(ecorr)
5997 C This subroutine calculates multi-body contributions to energy following
5998 C the idea of Skolnick et al. If side chains I and J make a contact and
5999 C at the same time side chains I+1 and J+1 make a contact, an extra
6000 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6001 implicit real*8 (a-h,o-z)
6002 include 'DIMENSIONS'
6003 include 'COMMON.IOUNITS'
6004 include 'COMMON.DERIV'
6005 include 'COMMON.INTERACT'
6006 include 'COMMON.CONTACTS'
6007 double precision gx(3),gx1(3)
6010 C Set lprn=.true. for debugging
6014 write (iout,'(a)') 'Contact function values:'
6016 write (iout,'(i2,20(1x,i2,f10.5))')
6017 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6032 num_conti=num_cont(i)
6033 num_conti1=num_cont(i1)
6038 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6039 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6040 cd & ' ishift=',ishift
6041 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6042 C The system gains extra energy.
6043 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6044 endif ! j1==j+-ishift
6053 c------------------------------------------------------------------------------
6054 double precision function esccorr(i,j,k,l,jj,kk)
6055 implicit real*8 (a-h,o-z)
6056 include 'DIMENSIONS'
6057 include 'COMMON.IOUNITS'
6058 include 'COMMON.DERIV'
6059 include 'COMMON.INTERACT'
6060 include 'COMMON.CONTACTS'
6061 double precision gx(3),gx1(3)
6066 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6067 C Calculate the multi-body contribution to energy.
6068 C Calculate multi-body contributions to the gradient.
6069 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6070 cd & k,l,(gacont(m,kk,k),m=1,3)
6072 gx(m) =ekl*gacont(m,jj,i)
6073 gx1(m)=eij*gacont(m,kk,k)
6074 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6075 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6076 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6077 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6081 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6086 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6092 c------------------------------------------------------------------------------
6093 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6094 C This subroutine calculates multi-body contributions to hydrogen-bonding
6095 implicit real*8 (a-h,o-z)
6096 include 'DIMENSIONS'
6097 include 'COMMON.IOUNITS'
6100 parameter (max_cont=maxconts)
6101 parameter (max_dim=26)
6102 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6103 double precision zapas(max_dim,maxconts,max_fg_procs),
6104 & zapas_recv(max_dim,maxconts,max_fg_procs)
6105 common /przechowalnia/ zapas
6106 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6107 & status_array(MPI_STATUS_SIZE,maxconts*2)
6109 include 'COMMON.SETUP'
6110 include 'COMMON.FFIELD'
6111 include 'COMMON.DERIV'
6112 include 'COMMON.INTERACT'
6113 include 'COMMON.CONTACTS'
6114 include 'COMMON.CONTROL'
6115 include 'COMMON.LOCAL'
6116 double precision gx(3),gx1(3),time00
6119 C Set lprn=.true. for debugging
6124 if (nfgtasks.le.1) goto 30
6126 write (iout,'(a)') 'Contact function values before RECEIVE:'
6128 write (iout,'(2i3,50(1x,i2,f5.2))')
6129 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6130 & j=1,num_cont_hb(i))
6134 do i=1,ntask_cont_from
6137 do i=1,ntask_cont_to
6140 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6142 C Make the list of contacts to send to send to other procesors
6143 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6145 do i=iturn3_start,iturn3_end
6146 c write (iout,*) "make contact list turn3",i," num_cont",
6148 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6150 do i=iturn4_start,iturn4_end
6151 c write (iout,*) "make contact list turn4",i," num_cont",
6153 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6157 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6159 do j=1,num_cont_hb(i)
6162 iproc=iint_sent_local(k,jjc,ii)
6163 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6164 if (iproc.gt.0) then
6165 ncont_sent(iproc)=ncont_sent(iproc)+1
6166 nn=ncont_sent(iproc)
6168 zapas(2,nn,iproc)=jjc
6169 zapas(3,nn,iproc)=facont_hb(j,i)
6170 zapas(4,nn,iproc)=ees0p(j,i)
6171 zapas(5,nn,iproc)=ees0m(j,i)
6172 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6173 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6174 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6175 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6176 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6177 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6178 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6179 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6180 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6181 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6182 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6183 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6184 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6185 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6186 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6187 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6188 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6189 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6190 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6191 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6192 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6199 & "Numbers of contacts to be sent to other processors",
6200 & (ncont_sent(i),i=1,ntask_cont_to)
6201 write (iout,*) "Contacts sent"
6202 do ii=1,ntask_cont_to
6204 iproc=itask_cont_to(ii)
6205 write (iout,*) nn," contacts to processor",iproc,
6206 & " of CONT_TO_COMM group"
6208 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6216 CorrelID1=nfgtasks+fg_rank+1
6218 C Receive the numbers of needed contacts from other processors
6219 do ii=1,ntask_cont_from
6220 iproc=itask_cont_from(ii)
6222 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6223 & FG_COMM,req(ireq),IERR)
6225 c write (iout,*) "IRECV ended"
6227 C Send the number of contacts needed by other processors
6228 do ii=1,ntask_cont_to
6229 iproc=itask_cont_to(ii)
6231 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6232 & FG_COMM,req(ireq),IERR)
6234 c write (iout,*) "ISEND ended"
6235 c write (iout,*) "number of requests (nn)",ireq
6238 & call MPI_Waitall(ireq,req,status_array,ierr)
6240 c & "Numbers of contacts to be received from other processors",
6241 c & (ncont_recv(i),i=1,ntask_cont_from)
6245 do ii=1,ntask_cont_from
6246 iproc=itask_cont_from(ii)
6248 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6249 c & " of CONT_TO_COMM group"
6253 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6254 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6255 c write (iout,*) "ireq,req",ireq,req(ireq)
6258 C Send the contacts to processors that need them
6259 do ii=1,ntask_cont_to
6260 iproc=itask_cont_to(ii)
6262 c write (iout,*) nn," contacts to processor",iproc,
6263 c & " of CONT_TO_COMM group"
6266 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6267 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6268 c write (iout,*) "ireq,req",ireq,req(ireq)
6270 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6274 c write (iout,*) "number of requests (contacts)",ireq
6275 c write (iout,*) "req",(req(i),i=1,4)
6278 & call MPI_Waitall(ireq,req,status_array,ierr)
6279 do iii=1,ntask_cont_from
6280 iproc=itask_cont_from(iii)
6283 write (iout,*) "Received",nn," contacts from processor",iproc,
6284 & " of CONT_FROM_COMM group"
6287 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6292 ii=zapas_recv(1,i,iii)
6293 c Flag the received contacts to prevent double-counting
6294 jj=-zapas_recv(2,i,iii)
6295 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6297 nnn=num_cont_hb(ii)+1
6300 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6301 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6302 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6303 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6304 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6305 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6306 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6307 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6308 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6309 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6310 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6311 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6312 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6313 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6314 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6315 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6316 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6317 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6318 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6319 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6320 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6321 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6322 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6323 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6328 write (iout,'(a)') 'Contact function values after receive:'
6330 write (iout,'(2i3,50(1x,i3,f5.2))')
6331 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6332 & j=1,num_cont_hb(i))
6339 write (iout,'(a)') 'Contact function values:'
6341 write (iout,'(2i3,50(1x,i3,f5.2))')
6342 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6343 & j=1,num_cont_hb(i))
6347 C Remove the loop below after debugging !!!
6354 C Calculate the local-electrostatic correlation terms
6355 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6357 num_conti=num_cont_hb(i)
6358 num_conti1=num_cont_hb(i+1)
6365 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6366 c & ' jj=',jj,' kk=',kk
6367 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6368 & .or. j.lt.0 .and. j1.gt.0) .and.
6369 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6370 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6371 C The system gains extra energy.
6372 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6373 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6374 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6376 else if (j1.eq.j) then
6377 C Contacts I-J and I-(J+1) occur simultaneously.
6378 C The system loses extra energy.
6379 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6384 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6385 c & ' jj=',jj,' kk=',kk
6387 C Contacts I-J and (I+1)-J occur simultaneously.
6388 C The system loses extra energy.
6389 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6396 c------------------------------------------------------------------------------
6397 subroutine add_hb_contact(ii,jj,itask)
6398 implicit real*8 (a-h,o-z)
6399 include "DIMENSIONS"
6400 include "COMMON.IOUNITS"
6403 parameter (max_cont=maxconts)
6404 parameter (max_dim=26)
6405 include "COMMON.CONTACTS"
6406 double precision zapas(max_dim,maxconts,max_fg_procs),
6407 & zapas_recv(max_dim,maxconts,max_fg_procs)
6408 common /przechowalnia/ zapas
6409 integer i,j,ii,jj,iproc,itask(4),nn
6410 c write (iout,*) "itask",itask
6413 if (iproc.gt.0) then
6414 do j=1,num_cont_hb(ii)
6416 c write (iout,*) "i",ii," j",jj," jjc",jjc
6418 ncont_sent(iproc)=ncont_sent(iproc)+1
6419 nn=ncont_sent(iproc)
6420 zapas(1,nn,iproc)=ii
6421 zapas(2,nn,iproc)=jjc
6422 zapas(3,nn,iproc)=facont_hb(j,ii)
6423 zapas(4,nn,iproc)=ees0p(j,ii)
6424 zapas(5,nn,iproc)=ees0m(j,ii)
6425 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6426 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6427 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6428 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6429 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6430 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6431 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6432 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6433 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6434 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6435 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6436 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6437 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6438 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6439 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6440 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6441 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6442 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6443 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6444 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6445 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6453 c------------------------------------------------------------------------------
6454 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6456 C This subroutine calculates multi-body contributions to hydrogen-bonding
6457 implicit real*8 (a-h,o-z)
6458 include 'DIMENSIONS'
6459 include 'COMMON.IOUNITS'
6462 parameter (max_cont=maxconts)
6463 parameter (max_dim=70)
6464 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6465 double precision zapas(max_dim,maxconts,max_fg_procs),
6466 & zapas_recv(max_dim,maxconts,max_fg_procs)
6467 common /przechowalnia/ zapas
6468 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6469 & status_array(MPI_STATUS_SIZE,maxconts*2)
6471 include 'COMMON.SETUP'
6472 include 'COMMON.FFIELD'
6473 include 'COMMON.DERIV'
6474 include 'COMMON.LOCAL'
6475 include 'COMMON.INTERACT'
6476 include 'COMMON.CONTACTS'
6477 include 'COMMON.CHAIN'
6478 include 'COMMON.CONTROL'
6479 double precision gx(3),gx1(3)
6480 integer num_cont_hb_old(maxres)
6482 double precision eello4,eello5,eelo6,eello_turn6
6483 external eello4,eello5,eello6,eello_turn6
6484 C Set lprn=.true. for debugging
6489 num_cont_hb_old(i)=num_cont_hb(i)
6493 if (nfgtasks.le.1) goto 30
6495 write (iout,'(a)') 'Contact function values before RECEIVE:'
6497 write (iout,'(2i3,50(1x,i2,f5.2))')
6498 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6499 & j=1,num_cont_hb(i))
6503 do i=1,ntask_cont_from
6506 do i=1,ntask_cont_to
6509 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6511 C Make the list of contacts to send to send to other procesors
6512 do i=iturn3_start,iturn3_end
6513 c write (iout,*) "make contact list turn3",i," num_cont",
6515 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6517 do i=iturn4_start,iturn4_end
6518 c write (iout,*) "make contact list turn4",i," num_cont",
6520 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6524 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6526 do j=1,num_cont_hb(i)
6529 iproc=iint_sent_local(k,jjc,ii)
6530 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6531 if (iproc.ne.0) then
6532 ncont_sent(iproc)=ncont_sent(iproc)+1
6533 nn=ncont_sent(iproc)
6535 zapas(2,nn,iproc)=jjc
6536 zapas(3,nn,iproc)=d_cont(j,i)
6540 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6545 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6553 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6564 & "Numbers of contacts to be sent to other processors",
6565 & (ncont_sent(i),i=1,ntask_cont_to)
6566 write (iout,*) "Contacts sent"
6567 do ii=1,ntask_cont_to
6569 iproc=itask_cont_to(ii)
6570 write (iout,*) nn," contacts to processor",iproc,
6571 & " of CONT_TO_COMM group"
6573 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6581 CorrelID1=nfgtasks+fg_rank+1
6583 C Receive the numbers of needed contacts from other processors
6584 do ii=1,ntask_cont_from
6585 iproc=itask_cont_from(ii)
6587 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6588 & FG_COMM,req(ireq),IERR)
6590 c write (iout,*) "IRECV ended"
6592 C Send the number of contacts needed by other processors
6593 do ii=1,ntask_cont_to
6594 iproc=itask_cont_to(ii)
6596 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6597 & FG_COMM,req(ireq),IERR)
6599 c write (iout,*) "ISEND ended"
6600 c write (iout,*) "number of requests (nn)",ireq
6603 & call MPI_Waitall(ireq,req,status_array,ierr)
6605 c & "Numbers of contacts to be received from other processors",
6606 c & (ncont_recv(i),i=1,ntask_cont_from)
6610 do ii=1,ntask_cont_from
6611 iproc=itask_cont_from(ii)
6613 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6614 c & " of CONT_TO_COMM group"
6618 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6619 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6620 c write (iout,*) "ireq,req",ireq,req(ireq)
6623 C Send the contacts to processors that need them
6624 do ii=1,ntask_cont_to
6625 iproc=itask_cont_to(ii)
6627 c write (iout,*) nn," contacts to processor",iproc,
6628 c & " of CONT_TO_COMM group"
6631 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6632 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6633 c write (iout,*) "ireq,req",ireq,req(ireq)
6635 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6639 c write (iout,*) "number of requests (contacts)",ireq
6640 c write (iout,*) "req",(req(i),i=1,4)
6643 & call MPI_Waitall(ireq,req,status_array,ierr)
6644 do iii=1,ntask_cont_from
6645 iproc=itask_cont_from(iii)
6648 write (iout,*) "Received",nn," contacts from processor",iproc,
6649 & " of CONT_FROM_COMM group"
6652 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6657 ii=zapas_recv(1,i,iii)
6658 c Flag the received contacts to prevent double-counting
6659 jj=-zapas_recv(2,i,iii)
6660 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6662 nnn=num_cont_hb(ii)+1
6665 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6669 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6674 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6682 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6691 write (iout,'(a)') 'Contact function values after receive:'
6693 write (iout,'(2i3,50(1x,i3,5f6.3))')
6694 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6695 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6702 write (iout,'(a)') 'Contact function values:'
6704 write (iout,'(2i3,50(1x,i2,5f6.3))')
6705 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6706 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6712 C Remove the loop below after debugging !!!
6719 C Calculate the dipole-dipole interaction energies
6720 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6721 do i=iatel_s,iatel_e+1
6722 num_conti=num_cont_hb(i)
6731 C Calculate the local-electrostatic correlation terms
6732 c write (iout,*) "gradcorr5 in eello5 before loop"
6734 c write (iout,'(i5,3f10.5)')
6735 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6737 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6738 c write (iout,*) "corr loop i",i
6740 num_conti=num_cont_hb(i)
6741 num_conti1=num_cont_hb(i+1)
6748 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6749 c & ' jj=',jj,' kk=',kk
6750 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6751 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6752 & .or. j.lt.0 .and. j1.gt.0) .and.
6753 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6754 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6755 C The system gains extra energy.
6757 sqd1=dsqrt(d_cont(jj,i))
6758 sqd2=dsqrt(d_cont(kk,i1))
6759 sred_geom = sqd1*sqd2
6760 IF (sred_geom.lt.cutoff_corr) THEN
6761 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6763 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6764 cd & ' jj=',jj,' kk=',kk
6765 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6766 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6768 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6769 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6772 cd write (iout,*) 'sred_geom=',sred_geom,
6773 cd & ' ekont=',ekont,' fprim=',fprimcont,
6774 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6775 cd write (iout,*) "g_contij",g_contij
6776 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6777 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6778 call calc_eello(i,jp,i+1,jp1,jj,kk)
6779 if (wcorr4.gt.0.0d0)
6780 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6781 if (energy_dec.and.wcorr4.gt.0.0d0)
6782 1 write (iout,'(a6,4i5,0pf7.3)')
6783 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6784 c write (iout,*) "gradcorr5 before eello5"
6786 c write (iout,'(i5,3f10.5)')
6787 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6789 if (wcorr5.gt.0.0d0)
6790 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6791 c write (iout,*) "gradcorr5 after eello5"
6793 c write (iout,'(i5,3f10.5)')
6794 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6796 if (energy_dec.and.wcorr5.gt.0.0d0)
6797 1 write (iout,'(a6,4i5,0pf7.3)')
6798 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6799 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6800 cd write(2,*)'ijkl',i,jp,i+1,jp1
6801 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6802 & .or. wturn6.eq.0.0d0))then
6803 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6804 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6805 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6806 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6807 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6808 cd & 'ecorr6=',ecorr6
6809 cd write (iout,'(4e15.5)') sred_geom,
6810 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6811 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6812 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6813 else if (wturn6.gt.0.0d0
6814 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6815 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6816 eturn6=eturn6+eello_turn6(i,jj,kk)
6817 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6818 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6819 cd write (2,*) 'multibody_eello:eturn6',eturn6
6828 num_cont_hb(i)=num_cont_hb_old(i)
6830 c write (iout,*) "gradcorr5 in eello5"
6832 c write (iout,'(i5,3f10.5)')
6833 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6837 c------------------------------------------------------------------------------
6838 subroutine add_hb_contact_eello(ii,jj,itask)
6839 implicit real*8 (a-h,o-z)
6840 include "DIMENSIONS"
6841 include "COMMON.IOUNITS"
6844 parameter (max_cont=maxconts)
6845 parameter (max_dim=70)
6846 include "COMMON.CONTACTS"
6847 double precision zapas(max_dim,maxconts,max_fg_procs),
6848 & zapas_recv(max_dim,maxconts,max_fg_procs)
6849 common /przechowalnia/ zapas
6850 integer i,j,ii,jj,iproc,itask(4),nn
6851 c write (iout,*) "itask",itask
6854 if (iproc.gt.0) then
6855 do j=1,num_cont_hb(ii)
6857 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6859 ncont_sent(iproc)=ncont_sent(iproc)+1
6860 nn=ncont_sent(iproc)
6861 zapas(1,nn,iproc)=ii
6862 zapas(2,nn,iproc)=jjc
6863 zapas(3,nn,iproc)=d_cont(j,ii)
6867 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6872 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6880 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6892 c------------------------------------------------------------------------------
6893 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6894 implicit real*8 (a-h,o-z)
6895 include 'DIMENSIONS'
6896 include 'COMMON.IOUNITS'
6897 include 'COMMON.DERIV'
6898 include 'COMMON.INTERACT'
6899 include 'COMMON.CONTACTS'
6900 double precision gx(3),gx1(3)
6910 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6911 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6912 C Following 4 lines for diagnostics.
6917 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6918 c & 'Contacts ',i,j,
6919 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6920 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6922 C Calculate the multi-body contribution to energy.
6923 c ecorr=ecorr+ekont*ees
6924 C Calculate multi-body contributions to the gradient.
6925 coeffpees0pij=coeffp*ees0pij
6926 coeffmees0mij=coeffm*ees0mij
6927 coeffpees0pkl=coeffp*ees0pkl
6928 coeffmees0mkl=coeffm*ees0mkl
6930 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6931 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6932 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6933 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6934 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6935 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6936 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6937 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6938 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6939 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6940 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6941 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6942 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6943 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6944 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6945 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6946 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6947 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6948 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6949 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6950 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6951 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6952 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6953 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6954 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6959 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6960 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6961 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6962 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6967 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6968 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6969 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6970 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6973 c write (iout,*) "ehbcorr",ekont*ees
6978 C---------------------------------------------------------------------------
6979 subroutine dipole(i,j,jj)
6980 implicit real*8 (a-h,o-z)
6981 include 'DIMENSIONS'
6982 include 'COMMON.IOUNITS'
6983 include 'COMMON.CHAIN'
6984 include 'COMMON.FFIELD'
6985 include 'COMMON.DERIV'
6986 include 'COMMON.INTERACT'
6987 include 'COMMON.CONTACTS'
6988 include 'COMMON.TORSION'
6989 include 'COMMON.VAR'
6990 include 'COMMON.GEO'
6991 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6993 iti1 = itortyp(itype(i+1))
6994 if (j.lt.nres-1) then
6995 itj1 = itortyp(itype(j+1))
7000 dipi(iii,1)=Ub2(iii,i)
7001 dipderi(iii)=Ub2der(iii,i)
7002 dipi(iii,2)=b1(iii,iti1)
7003 dipj(iii,1)=Ub2(iii,j)
7004 dipderj(iii)=Ub2der(iii,j)
7005 dipj(iii,2)=b1(iii,itj1)
7009 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7012 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7019 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7023 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7028 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7029 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7031 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7033 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7035 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7040 C---------------------------------------------------------------------------
7041 subroutine calc_eello(i,j,k,l,jj,kk)
7043 C This subroutine computes matrices and vectors needed to calculate
7044 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7046 implicit real*8 (a-h,o-z)
7047 include 'DIMENSIONS'
7048 include 'COMMON.IOUNITS'
7049 include 'COMMON.CHAIN'
7050 include 'COMMON.DERIV'
7051 include 'COMMON.INTERACT'
7052 include 'COMMON.CONTACTS'
7053 include 'COMMON.TORSION'
7054 include 'COMMON.VAR'
7055 include 'COMMON.GEO'
7056 include 'COMMON.FFIELD'
7057 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7058 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7061 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7062 cd & ' jj=',jj,' kk=',kk
7063 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7064 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7065 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7068 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7069 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7072 call transpose2(aa1(1,1),aa1t(1,1))
7073 call transpose2(aa2(1,1),aa2t(1,1))
7076 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7077 & aa1tder(1,1,lll,kkk))
7078 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7079 & aa2tder(1,1,lll,kkk))
7083 C parallel orientation of the two CA-CA-CA frames.
7085 iti=itortyp(itype(i))
7089 itk1=itortyp(itype(k+1))
7090 itj=itortyp(itype(j))
7091 if (l.lt.nres-1) then
7092 itl1=itortyp(itype(l+1))
7096 C A1 kernel(j+1) A2T
7098 cd write (iout,'(3f10.5,5x,3f10.5)')
7099 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7101 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7102 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7103 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7104 C Following matrices are needed only for 6-th order cumulants
7105 IF (wcorr6.gt.0.0d0) THEN
7106 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7107 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7108 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7109 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7110 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7111 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7112 & ADtEAderx(1,1,1,1,1,1))
7114 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7115 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7116 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7117 & ADtEA1derx(1,1,1,1,1,1))
7119 C End 6-th order cumulants
7122 cd write (2,*) 'In calc_eello6'
7124 cd write (2,*) 'iii=',iii
7126 cd write (2,*) 'kkk=',kkk
7128 cd write (2,'(3(2f10.5),5x)')
7129 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7134 call transpose2(EUgder(1,1,k),auxmat(1,1))
7135 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7136 call transpose2(EUg(1,1,k),auxmat(1,1))
7137 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7138 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7142 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7143 & EAEAderx(1,1,lll,kkk,iii,1))
7147 C A1T kernel(i+1) A2
7148 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7149 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7150 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7151 C Following matrices are needed only for 6-th order cumulants
7152 IF (wcorr6.gt.0.0d0) THEN
7153 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7154 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7155 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7156 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7157 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7158 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7159 & ADtEAderx(1,1,1,1,1,2))
7160 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7161 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7162 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7163 & ADtEA1derx(1,1,1,1,1,2))
7165 C End 6-th order cumulants
7166 call transpose2(EUgder(1,1,l),auxmat(1,1))
7167 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7168 call transpose2(EUg(1,1,l),auxmat(1,1))
7169 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7170 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7174 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7175 & EAEAderx(1,1,lll,kkk,iii,2))
7180 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7181 C They are needed only when the fifth- or the sixth-order cumulants are
7183 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7184 call transpose2(AEA(1,1,1),auxmat(1,1))
7185 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7186 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7187 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7188 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7189 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7190 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7191 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7192 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7193 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7194 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7195 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7196 call transpose2(AEA(1,1,2),auxmat(1,1))
7197 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7198 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7199 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7200 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7201 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7202 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7203 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7204 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7205 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7206 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7207 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7208 C Calculate the Cartesian derivatives of the vectors.
7212 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7213 call matvec2(auxmat(1,1),b1(1,iti),
7214 & AEAb1derx(1,lll,kkk,iii,1,1))
7215 call matvec2(auxmat(1,1),Ub2(1,i),
7216 & AEAb2derx(1,lll,kkk,iii,1,1))
7217 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7218 & AEAb1derx(1,lll,kkk,iii,2,1))
7219 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7220 & AEAb2derx(1,lll,kkk,iii,2,1))
7221 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7222 call matvec2(auxmat(1,1),b1(1,itj),
7223 & AEAb1derx(1,lll,kkk,iii,1,2))
7224 call matvec2(auxmat(1,1),Ub2(1,j),
7225 & AEAb2derx(1,lll,kkk,iii,1,2))
7226 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7227 & AEAb1derx(1,lll,kkk,iii,2,2))
7228 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7229 & AEAb2derx(1,lll,kkk,iii,2,2))
7236 C Antiparallel orientation of the two CA-CA-CA frames.
7238 iti=itortyp(itype(i))
7242 itk1=itortyp(itype(k+1))
7243 itl=itortyp(itype(l))
7244 itj=itortyp(itype(j))
7245 if (j.lt.nres-1) then
7246 itj1=itortyp(itype(j+1))
7250 C A2 kernel(j-1)T A1T
7251 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7252 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7253 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7254 C Following matrices are needed only for 6-th order cumulants
7255 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7256 & j.eq.i+4 .and. l.eq.i+3)) THEN
7257 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7258 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7259 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7260 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7261 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7262 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7263 & ADtEAderx(1,1,1,1,1,1))
7264 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7265 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7266 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7267 & ADtEA1derx(1,1,1,1,1,1))
7269 C End 6-th order cumulants
7270 call transpose2(EUgder(1,1,k),auxmat(1,1))
7271 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7272 call transpose2(EUg(1,1,k),auxmat(1,1))
7273 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7274 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7278 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7279 & EAEAderx(1,1,lll,kkk,iii,1))
7283 C A2T kernel(i+1)T A1
7284 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7285 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7286 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7287 C Following matrices are needed only for 6-th order cumulants
7288 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7289 & j.eq.i+4 .and. l.eq.i+3)) THEN
7290 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7291 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7292 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7293 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7294 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7295 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7296 & ADtEAderx(1,1,1,1,1,2))
7297 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7298 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7299 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7300 & ADtEA1derx(1,1,1,1,1,2))
7302 C End 6-th order cumulants
7303 call transpose2(EUgder(1,1,j),auxmat(1,1))
7304 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7305 call transpose2(EUg(1,1,j),auxmat(1,1))
7306 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7307 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7311 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7312 & EAEAderx(1,1,lll,kkk,iii,2))
7317 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7318 C They are needed only when the fifth- or the sixth-order cumulants are
7320 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7321 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7322 call transpose2(AEA(1,1,1),auxmat(1,1))
7323 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7324 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7325 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7326 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7327 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7328 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7329 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7330 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7331 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7332 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7333 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7334 call transpose2(AEA(1,1,2),auxmat(1,1))
7335 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7336 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7337 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7338 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7339 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7340 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7341 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7342 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7343 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7344 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7345 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7346 C Calculate the Cartesian derivatives of the vectors.
7350 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7351 call matvec2(auxmat(1,1),b1(1,iti),
7352 & AEAb1derx(1,lll,kkk,iii,1,1))
7353 call matvec2(auxmat(1,1),Ub2(1,i),
7354 & AEAb2derx(1,lll,kkk,iii,1,1))
7355 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7356 & AEAb1derx(1,lll,kkk,iii,2,1))
7357 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7358 & AEAb2derx(1,lll,kkk,iii,2,1))
7359 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7360 call matvec2(auxmat(1,1),b1(1,itl),
7361 & AEAb1derx(1,lll,kkk,iii,1,2))
7362 call matvec2(auxmat(1,1),Ub2(1,l),
7363 & AEAb2derx(1,lll,kkk,iii,1,2))
7364 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7365 & AEAb1derx(1,lll,kkk,iii,2,2))
7366 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7367 & AEAb2derx(1,lll,kkk,iii,2,2))
7376 C---------------------------------------------------------------------------
7377 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7378 & KK,KKderg,AKA,AKAderg,AKAderx)
7382 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7383 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7384 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7389 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7391 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7394 cd if (lprn) write (2,*) 'In kernel'
7396 cd if (lprn) write (2,*) 'kkk=',kkk
7398 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7399 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7401 cd write (2,*) 'lll=',lll
7402 cd write (2,*) 'iii=1'
7404 cd write (2,'(3(2f10.5),5x)')
7405 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7408 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7409 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7411 cd write (2,*) 'lll=',lll
7412 cd write (2,*) 'iii=2'
7414 cd write (2,'(3(2f10.5),5x)')
7415 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7422 C---------------------------------------------------------------------------
7423 double precision function eello4(i,j,k,l,jj,kk)
7424 implicit real*8 (a-h,o-z)
7425 include 'DIMENSIONS'
7426 include 'COMMON.IOUNITS'
7427 include 'COMMON.CHAIN'
7428 include 'COMMON.DERIV'
7429 include 'COMMON.INTERACT'
7430 include 'COMMON.CONTACTS'
7431 include 'COMMON.TORSION'
7432 include 'COMMON.VAR'
7433 include 'COMMON.GEO'
7434 double precision pizda(2,2),ggg1(3),ggg2(3)
7435 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7439 cd print *,'eello4:',i,j,k,l,jj,kk
7440 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7441 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7442 cold eij=facont_hb(jj,i)
7443 cold ekl=facont_hb(kk,k)
7445 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7446 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7447 gcorr_loc(k-1)=gcorr_loc(k-1)
7448 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7450 gcorr_loc(l-1)=gcorr_loc(l-1)
7451 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7453 gcorr_loc(j-1)=gcorr_loc(j-1)
7454 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7459 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7460 & -EAEAderx(2,2,lll,kkk,iii,1)
7461 cd derx(lll,kkk,iii)=0.0d0
7465 cd gcorr_loc(l-1)=0.0d0
7466 cd gcorr_loc(j-1)=0.0d0
7467 cd gcorr_loc(k-1)=0.0d0
7469 cd write (iout,*)'Contacts have occurred for peptide groups',
7470 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7471 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7472 if (j.lt.nres-1) then
7479 if (l.lt.nres-1) then
7487 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7488 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7489 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7490 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7491 cgrad ghalf=0.5d0*ggg1(ll)
7492 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7493 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7494 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7495 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7496 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7497 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7498 cgrad ghalf=0.5d0*ggg2(ll)
7499 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7500 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7501 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7502 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7503 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7504 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7508 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7513 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7518 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7523 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7527 cd write (2,*) iii,gcorr_loc(iii)
7530 cd write (2,*) 'ekont',ekont
7531 cd write (iout,*) 'eello4',ekont*eel4
7534 C---------------------------------------------------------------------------
7535 double precision function eello5(i,j,k,l,jj,kk)
7536 implicit real*8 (a-h,o-z)
7537 include 'DIMENSIONS'
7538 include 'COMMON.IOUNITS'
7539 include 'COMMON.CHAIN'
7540 include 'COMMON.DERIV'
7541 include 'COMMON.INTERACT'
7542 include 'COMMON.CONTACTS'
7543 include 'COMMON.TORSION'
7544 include 'COMMON.VAR'
7545 include 'COMMON.GEO'
7546 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7547 double precision ggg1(3),ggg2(3)
7548 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7553 C /l\ / \ \ / \ / \ / C
7554 C / \ / \ \ / \ / \ / C
7555 C j| o |l1 | o | o| o | | o |o C
7556 C \ |/k\| |/ \| / |/ \| |/ \| C
7557 C \i/ \ / \ / / \ / \ C
7559 C (I) (II) (III) (IV) C
7561 C eello5_1 eello5_2 eello5_3 eello5_4 C
7563 C Antiparallel chains C
7566 C /j\ / \ \ / \ / \ / C
7567 C / \ / \ \ / \ / \ / C
7568 C j1| o |l | o | o| o | | o |o C
7569 C \ |/k\| |/ \| / |/ \| |/ \| C
7570 C \i/ \ / \ / / \ / \ C
7572 C (I) (II) (III) (IV) C
7574 C eello5_1 eello5_2 eello5_3 eello5_4 C
7576 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7578 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7579 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7584 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7586 itk=itortyp(itype(k))
7587 itl=itortyp(itype(l))
7588 itj=itortyp(itype(j))
7593 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7594 cd & eel5_3_num,eel5_4_num)
7598 derx(lll,kkk,iii)=0.0d0
7602 cd eij=facont_hb(jj,i)
7603 cd ekl=facont_hb(kk,k)
7605 cd write (iout,*)'Contacts have occurred for peptide groups',
7606 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7608 C Contribution from the graph I.
7609 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7610 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7611 call transpose2(EUg(1,1,k),auxmat(1,1))
7612 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7613 vv(1)=pizda(1,1)-pizda(2,2)
7614 vv(2)=pizda(1,2)+pizda(2,1)
7615 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7616 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7617 C Explicit gradient in virtual-dihedral angles.
7618 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7619 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7620 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7621 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7622 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7623 vv(1)=pizda(1,1)-pizda(2,2)
7624 vv(2)=pizda(1,2)+pizda(2,1)
7625 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7626 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7627 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7628 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7629 vv(1)=pizda(1,1)-pizda(2,2)
7630 vv(2)=pizda(1,2)+pizda(2,1)
7632 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7633 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7634 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7636 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7637 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7638 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7640 C Cartesian gradient
7644 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(1,2)+pizda(2,1)
7648 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7649 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7656 C Contribution from graph II
7657 call transpose2(EE(1,1,itk),auxmat(1,1))
7658 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7659 vv(1)=pizda(1,1)+pizda(2,2)
7660 vv(2)=pizda(2,1)-pizda(1,2)
7661 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7662 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7663 C Explicit gradient in virtual-dihedral angles.
7664 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7665 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7666 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7667 vv(1)=pizda(1,1)+pizda(2,2)
7668 vv(2)=pizda(2,1)-pizda(1,2)
7670 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7671 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7672 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7674 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7675 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7676 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7678 C Cartesian gradient
7682 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7684 vv(1)=pizda(1,1)+pizda(2,2)
7685 vv(2)=pizda(2,1)-pizda(1,2)
7686 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7687 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7688 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7696 C Parallel orientation
7697 C Contribution from graph III
7698 call transpose2(EUg(1,1,l),auxmat(1,1))
7699 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7700 vv(1)=pizda(1,1)-pizda(2,2)
7701 vv(2)=pizda(1,2)+pizda(2,1)
7702 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7703 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7704 C Explicit gradient in virtual-dihedral angles.
7705 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7706 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7707 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7708 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7709 vv(1)=pizda(1,1)-pizda(2,2)
7710 vv(2)=pizda(1,2)+pizda(2,1)
7711 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7712 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7713 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7714 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7715 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7716 vv(1)=pizda(1,1)-pizda(2,2)
7717 vv(2)=pizda(1,2)+pizda(2,1)
7718 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7719 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7720 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7721 C Cartesian gradient
7725 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7727 vv(1)=pizda(1,1)-pizda(2,2)
7728 vv(2)=pizda(1,2)+pizda(2,1)
7729 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7730 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7731 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7736 C Contribution from graph IV
7738 call transpose2(EE(1,1,itl),auxmat(1,1))
7739 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7740 vv(1)=pizda(1,1)+pizda(2,2)
7741 vv(2)=pizda(2,1)-pizda(1,2)
7742 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7743 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7744 C Explicit gradient in virtual-dihedral angles.
7745 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7746 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7747 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7748 vv(1)=pizda(1,1)+pizda(2,2)
7749 vv(2)=pizda(2,1)-pizda(1,2)
7750 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7751 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7752 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7753 C Cartesian gradient
7757 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7759 vv(1)=pizda(1,1)+pizda(2,2)
7760 vv(2)=pizda(2,1)-pizda(1,2)
7761 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7762 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7763 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7768 C Antiparallel orientation
7769 C Contribution from graph III
7771 call transpose2(EUg(1,1,j),auxmat(1,1))
7772 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7773 vv(1)=pizda(1,1)-pizda(2,2)
7774 vv(2)=pizda(1,2)+pizda(2,1)
7775 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7776 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7777 C Explicit gradient in virtual-dihedral angles.
7778 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7779 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7780 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7781 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7782 vv(1)=pizda(1,1)-pizda(2,2)
7783 vv(2)=pizda(1,2)+pizda(2,1)
7784 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7785 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7786 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7787 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7788 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7789 vv(1)=pizda(1,1)-pizda(2,2)
7790 vv(2)=pizda(1,2)+pizda(2,1)
7791 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7792 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7793 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7794 C Cartesian gradient
7798 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7800 vv(1)=pizda(1,1)-pizda(2,2)
7801 vv(2)=pizda(1,2)+pizda(2,1)
7802 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7803 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7804 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7809 C Contribution from graph IV
7811 call transpose2(EE(1,1,itj),auxmat(1,1))
7812 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7813 vv(1)=pizda(1,1)+pizda(2,2)
7814 vv(2)=pizda(2,1)-pizda(1,2)
7815 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7816 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7817 C Explicit gradient in virtual-dihedral angles.
7818 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7819 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7820 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7821 vv(1)=pizda(1,1)+pizda(2,2)
7822 vv(2)=pizda(2,1)-pizda(1,2)
7823 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7824 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7825 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7826 C Cartesian gradient
7830 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7832 vv(1)=pizda(1,1)+pizda(2,2)
7833 vv(2)=pizda(2,1)-pizda(1,2)
7834 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7835 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7836 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7842 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7843 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7844 cd write (2,*) 'ijkl',i,j,k,l
7845 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7846 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7848 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7849 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7850 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7851 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7852 if (j.lt.nres-1) then
7859 if (l.lt.nres-1) then
7869 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7870 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7871 C summed up outside the subrouine as for the other subroutines
7872 C handling long-range interactions. The old code is commented out
7873 C with "cgrad" to keep track of changes.
7875 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7876 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7877 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7878 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7879 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7880 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7881 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7882 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7883 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7884 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7886 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7887 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7888 cgrad ghalf=0.5d0*ggg1(ll)
7890 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7891 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7892 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7893 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7894 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7895 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7896 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7897 cgrad ghalf=0.5d0*ggg2(ll)
7899 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
7900 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7901 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
7902 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7903 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7904 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7909 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7910 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7915 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7916 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7922 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7927 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7931 cd write (2,*) iii,g_corr5_loc(iii)
7934 cd write (2,*) 'ekont',ekont
7935 cd write (iout,*) 'eello5',ekont*eel5
7938 c--------------------------------------------------------------------------
7939 double precision function eello6(i,j,k,l,jj,kk)
7940 implicit real*8 (a-h,o-z)
7941 include 'DIMENSIONS'
7942 include 'COMMON.IOUNITS'
7943 include 'COMMON.CHAIN'
7944 include 'COMMON.DERIV'
7945 include 'COMMON.INTERACT'
7946 include 'COMMON.CONTACTS'
7947 include 'COMMON.TORSION'
7948 include 'COMMON.VAR'
7949 include 'COMMON.GEO'
7950 include 'COMMON.FFIELD'
7951 double precision ggg1(3),ggg2(3)
7952 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7957 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7965 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7966 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7970 derx(lll,kkk,iii)=0.0d0
7974 cd eij=facont_hb(jj,i)
7975 cd ekl=facont_hb(kk,k)
7981 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7982 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7983 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7984 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7985 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7986 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7988 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7989 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7990 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7991 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7992 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7993 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7997 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7999 C If turn contributions are considered, they will be handled separately.
8000 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8001 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8002 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8003 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8004 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8005 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8006 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8008 if (j.lt.nres-1) then
8015 if (l.lt.nres-1) then
8023 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8024 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8025 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8026 cgrad ghalf=0.5d0*ggg1(ll)
8028 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8029 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8030 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8031 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8032 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8033 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8034 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8035 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8036 cgrad ghalf=0.5d0*ggg2(ll)
8037 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8039 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8040 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8041 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8042 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8043 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8044 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8049 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8050 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8055 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8056 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8062 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8067 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8071 cd write (2,*) iii,g_corr6_loc(iii)
8074 cd write (2,*) 'ekont',ekont
8075 cd write (iout,*) 'eello6',ekont*eel6
8078 c--------------------------------------------------------------------------
8079 double precision function eello6_graph1(i,j,k,l,imat,swap)
8080 implicit real*8 (a-h,o-z)
8081 include 'DIMENSIONS'
8082 include 'COMMON.IOUNITS'
8083 include 'COMMON.CHAIN'
8084 include 'COMMON.DERIV'
8085 include 'COMMON.INTERACT'
8086 include 'COMMON.CONTACTS'
8087 include 'COMMON.TORSION'
8088 include 'COMMON.VAR'
8089 include 'COMMON.GEO'
8090 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8094 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8096 C Parallel Antiparallel C
8102 C \ j|/k\| / \ |/k\|l / C
8107 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8108 itk=itortyp(itype(k))
8109 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8110 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8111 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8112 call transpose2(EUgC(1,1,k),auxmat(1,1))
8113 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8114 vv1(1)=pizda1(1,1)-pizda1(2,2)
8115 vv1(2)=pizda1(1,2)+pizda1(2,1)
8116 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8117 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8118 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8119 s5=scalar2(vv(1),Dtobr2(1,i))
8120 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8121 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8122 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8123 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8124 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8125 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8126 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8127 & +scalar2(vv(1),Dtobr2der(1,i)))
8128 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8129 vv1(1)=pizda1(1,1)-pizda1(2,2)
8130 vv1(2)=pizda1(1,2)+pizda1(2,1)
8131 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8132 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8134 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8135 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8136 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8137 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8138 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8140 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8141 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8142 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8143 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8144 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8146 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8147 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8148 vv1(1)=pizda1(1,1)-pizda1(2,2)
8149 vv1(2)=pizda1(1,2)+pizda1(2,1)
8150 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8151 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8152 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8153 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8162 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8163 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8164 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8165 call transpose2(EUgC(1,1,k),auxmat(1,1))
8166 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8168 vv1(1)=pizda1(1,1)-pizda1(2,2)
8169 vv1(2)=pizda1(1,2)+pizda1(2,1)
8170 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8171 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8172 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8173 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8174 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8175 s5=scalar2(vv(1),Dtobr2(1,i))
8176 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8182 c----------------------------------------------------------------------------
8183 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8184 implicit real*8 (a-h,o-z)
8185 include 'DIMENSIONS'
8186 include 'COMMON.IOUNITS'
8187 include 'COMMON.CHAIN'
8188 include 'COMMON.DERIV'
8189 include 'COMMON.INTERACT'
8190 include 'COMMON.CONTACTS'
8191 include 'COMMON.TORSION'
8192 include 'COMMON.VAR'
8193 include 'COMMON.GEO'
8195 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8196 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8199 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8201 C Parallel Antiparallel C
8207 C \ j|/k\| \ |/k\|l C
8212 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8213 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8214 C AL 7/4/01 s1 would occur in the sixth-order moment,
8215 C but not in a cluster cumulant
8217 s1=dip(1,jj,i)*dip(1,kk,k)
8219 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8220 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8221 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8222 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8223 call transpose2(EUg(1,1,k),auxmat(1,1))
8224 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8225 vv(1)=pizda(1,1)-pizda(2,2)
8226 vv(2)=pizda(1,2)+pizda(2,1)
8227 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8228 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8230 eello6_graph2=-(s1+s2+s3+s4)
8232 eello6_graph2=-(s2+s3+s4)
8235 C Derivatives in gamma(i-1)
8238 s1=dipderg(1,jj,i)*dip(1,kk,k)
8240 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8241 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8242 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8243 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8245 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8247 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8249 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8251 C Derivatives in gamma(k-1)
8253 s1=dip(1,jj,i)*dipderg(1,kk,k)
8255 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8256 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8257 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8258 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8259 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8260 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8261 vv(1)=pizda(1,1)-pizda(2,2)
8262 vv(2)=pizda(1,2)+pizda(2,1)
8263 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8265 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8267 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8269 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8270 C Derivatives in gamma(j-1) or gamma(l-1)
8273 s1=dipderg(3,jj,i)*dip(1,kk,k)
8275 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8276 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8277 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8278 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8279 vv(1)=pizda(1,1)-pizda(2,2)
8280 vv(2)=pizda(1,2)+pizda(2,1)
8281 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8284 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8286 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8289 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8290 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8292 C Derivatives in gamma(l-1) or gamma(j-1)
8295 s1=dip(1,jj,i)*dipderg(3,kk,k)
8297 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8298 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8299 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8300 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8301 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8302 vv(1)=pizda(1,1)-pizda(2,2)
8303 vv(2)=pizda(1,2)+pizda(2,1)
8304 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8307 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8309 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8312 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8313 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8315 C Cartesian derivatives.
8317 write (2,*) 'In eello6_graph2'
8319 write (2,*) 'iii=',iii
8321 write (2,*) 'kkk=',kkk
8323 write (2,'(3(2f10.5),5x)')
8324 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8334 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8336 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8339 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8341 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8342 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8344 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8345 call transpose2(EUg(1,1,k),auxmat(1,1))
8346 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8348 vv(1)=pizda(1,1)-pizda(2,2)
8349 vv(2)=pizda(1,2)+pizda(2,1)
8350 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8351 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8353 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8355 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8358 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8360 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8367 c----------------------------------------------------------------------------
8368 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8369 implicit real*8 (a-h,o-z)
8370 include 'DIMENSIONS'
8371 include 'COMMON.IOUNITS'
8372 include 'COMMON.CHAIN'
8373 include 'COMMON.DERIV'
8374 include 'COMMON.INTERACT'
8375 include 'COMMON.CONTACTS'
8376 include 'COMMON.TORSION'
8377 include 'COMMON.VAR'
8378 include 'COMMON.GEO'
8379 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8383 C Parallel Antiparallel C
8389 C j|/k\| / |/k\|l / C
8394 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8396 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8397 C energy moment and not to the cluster cumulant.
8398 iti=itortyp(itype(i))
8399 if (j.lt.nres-1) then
8400 itj1=itortyp(itype(j+1))
8404 itk=itortyp(itype(k))
8405 itk1=itortyp(itype(k+1))
8406 if (l.lt.nres-1) then
8407 itl1=itortyp(itype(l+1))
8412 s1=dip(4,jj,i)*dip(4,kk,k)
8414 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8415 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8416 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8417 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8418 call transpose2(EE(1,1,itk),auxmat(1,1))
8419 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8420 vv(1)=pizda(1,1)+pizda(2,2)
8421 vv(2)=pizda(2,1)-pizda(1,2)
8422 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8423 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8424 cd & "sum",-(s2+s3+s4)
8426 eello6_graph3=-(s1+s2+s3+s4)
8428 eello6_graph3=-(s2+s3+s4)
8431 C Derivatives in gamma(k-1)
8432 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8433 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8434 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8435 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8436 C Derivatives in gamma(l-1)
8437 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8438 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8439 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8440 vv(1)=pizda(1,1)+pizda(2,2)
8441 vv(2)=pizda(2,1)-pizda(1,2)
8442 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8443 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8444 C Cartesian derivatives.
8450 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8452 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8455 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8457 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8458 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8460 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8461 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8463 vv(1)=pizda(1,1)+pizda(2,2)
8464 vv(2)=pizda(2,1)-pizda(1,2)
8465 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8467 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8469 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8472 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8474 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8476 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8482 c----------------------------------------------------------------------------
8483 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8484 implicit real*8 (a-h,o-z)
8485 include 'DIMENSIONS'
8486 include 'COMMON.IOUNITS'
8487 include 'COMMON.CHAIN'
8488 include 'COMMON.DERIV'
8489 include 'COMMON.INTERACT'
8490 include 'COMMON.CONTACTS'
8491 include 'COMMON.TORSION'
8492 include 'COMMON.VAR'
8493 include 'COMMON.GEO'
8494 include 'COMMON.FFIELD'
8495 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8496 & auxvec1(2),auxmat1(2,2)
8498 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8500 C Parallel Antiparallel C
8506 C \ j|/k\| \ |/k\|l C
8511 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8513 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8514 C energy moment and not to the cluster cumulant.
8515 cd write (2,*) 'eello_graph4: wturn6',wturn6
8516 iti=itortyp(itype(i))
8517 itj=itortyp(itype(j))
8518 if (j.lt.nres-1) then
8519 itj1=itortyp(itype(j+1))
8523 itk=itortyp(itype(k))
8524 if (k.lt.nres-1) then
8525 itk1=itortyp(itype(k+1))
8529 itl=itortyp(itype(l))
8530 if (l.lt.nres-1) then
8531 itl1=itortyp(itype(l+1))
8535 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8536 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8537 cd & ' itl',itl,' itl1',itl1
8540 s1=dip(3,jj,i)*dip(3,kk,k)
8542 s1=dip(2,jj,j)*dip(2,kk,l)
8545 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8546 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8548 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8549 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8551 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8552 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8554 call transpose2(EUg(1,1,k),auxmat(1,1))
8555 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8556 vv(1)=pizda(1,1)-pizda(2,2)
8557 vv(2)=pizda(2,1)+pizda(1,2)
8558 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8559 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8561 eello6_graph4=-(s1+s2+s3+s4)
8563 eello6_graph4=-(s2+s3+s4)
8565 C Derivatives in gamma(i-1)
8569 s1=dipderg(2,jj,i)*dip(3,kk,k)
8571 s1=dipderg(4,jj,j)*dip(2,kk,l)
8574 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8576 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8577 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8579 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8580 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8582 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8583 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8584 cd write (2,*) 'turn6 derivatives'
8586 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8588 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8592 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8594 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8598 C Derivatives in gamma(k-1)
8601 s1=dip(3,jj,i)*dipderg(2,kk,k)
8603 s1=dip(2,jj,j)*dipderg(4,kk,l)
8606 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8607 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8609 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8610 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8612 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8613 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8615 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8616 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8617 vv(1)=pizda(1,1)-pizda(2,2)
8618 vv(2)=pizda(2,1)+pizda(1,2)
8619 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8620 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8622 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8624 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8628 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8630 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8633 C Derivatives in gamma(j-1) or gamma(l-1)
8634 if (l.eq.j+1 .and. l.gt.1) then
8635 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8636 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8637 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8638 vv(1)=pizda(1,1)-pizda(2,2)
8639 vv(2)=pizda(2,1)+pizda(1,2)
8640 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8641 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8642 else if (j.gt.1) then
8643 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8644 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8645 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8646 vv(1)=pizda(1,1)-pizda(2,2)
8647 vv(2)=pizda(2,1)+pizda(1,2)
8648 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8649 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8650 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8652 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8655 C Cartesian derivatives.
8662 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8664 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8668 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8670 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8674 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8676 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8678 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8679 & b1(1,itj1),auxvec(1))
8680 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8682 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8683 & b1(1,itl1),auxvec(1))
8684 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8686 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8688 vv(1)=pizda(1,1)-pizda(2,2)
8689 vv(2)=pizda(2,1)+pizda(1,2)
8690 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8692 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8694 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8697 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8700 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8703 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8705 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8711 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8716 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8726 c----------------------------------------------------------------------------
8727 double precision function eello_turn6(i,jj,kk)
8728 implicit real*8 (a-h,o-z)
8729 include 'DIMENSIONS'
8730 include 'COMMON.IOUNITS'
8731 include 'COMMON.CHAIN'
8732 include 'COMMON.DERIV'
8733 include 'COMMON.INTERACT'
8734 include 'COMMON.CONTACTS'
8735 include 'COMMON.TORSION'
8736 include 'COMMON.VAR'
8737 include 'COMMON.GEO'
8738 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8739 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8741 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8742 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8743 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8744 C the respective energy moment and not to the cluster cumulant.
8753 iti=itortyp(itype(i))
8754 itk=itortyp(itype(k))
8755 itk1=itortyp(itype(k+1))
8756 itl=itortyp(itype(l))
8757 itj=itortyp(itype(j))
8758 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8759 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8760 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8765 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8767 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8771 derx_turn(lll,kkk,iii)=0.0d0
8778 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8780 cd write (2,*) 'eello6_5',eello6_5
8782 call transpose2(AEA(1,1,1),auxmat(1,1))
8783 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8784 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8785 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8787 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8788 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8789 s2 = scalar2(b1(1,itk),vtemp1(1))
8791 call transpose2(AEA(1,1,2),atemp(1,1))
8792 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8793 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8794 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8796 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8797 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8798 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8800 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8801 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8802 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8803 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8804 ss13 = scalar2(b1(1,itk),vtemp4(1))
8805 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8807 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8813 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8814 C Derivatives in gamma(i+2)
8818 call transpose2(AEA(1,1,1),auxmatd(1,1))
8819 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8820 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8821 call transpose2(AEAderg(1,1,2),atempd(1,1))
8822 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8823 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8825 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8826 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8827 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8833 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8834 C Derivatives in gamma(i+3)
8836 call transpose2(AEA(1,1,1),auxmatd(1,1))
8837 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8838 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8839 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8841 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8842 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8843 s2d = scalar2(b1(1,itk),vtemp1d(1))
8845 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8846 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8848 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8850 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8851 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8852 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8860 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8861 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8863 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8864 & -0.5d0*ekont*(s2d+s12d)
8866 C Derivatives in gamma(i+4)
8867 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8868 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8869 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8871 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8872 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8873 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8881 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8883 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8885 C Derivatives in gamma(i+5)
8887 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8888 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8889 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8891 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8892 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8893 s2d = scalar2(b1(1,itk),vtemp1d(1))
8895 call transpose2(AEA(1,1,2),atempd(1,1))
8896 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8897 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8899 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8900 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8902 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8903 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8904 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8912 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8913 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8915 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8916 & -0.5d0*ekont*(s2d+s12d)
8918 C Cartesian derivatives
8923 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8924 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8925 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8927 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8928 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8930 s2d = scalar2(b1(1,itk),vtemp1d(1))
8932 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8933 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8934 s8d = -(atempd(1,1)+atempd(2,2))*
8935 & scalar2(cc(1,1,itl),vtemp2(1))
8937 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8939 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8940 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8947 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8950 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8954 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8955 & - 0.5d0*(s8d+s12d)
8957 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8966 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8968 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8969 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8970 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8971 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8972 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8974 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8975 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8976 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8980 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8981 cd & 16*eel_turn6_num
8983 if (j.lt.nres-1) then
8990 if (l.lt.nres-1) then
8998 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8999 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9000 cgrad ghalf=0.5d0*ggg1(ll)
9002 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9003 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9004 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9005 & +ekont*derx_turn(ll,2,1)
9006 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9007 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9008 & +ekont*derx_turn(ll,4,1)
9009 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9010 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9011 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9012 cgrad ghalf=0.5d0*ggg2(ll)
9014 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9015 & +ekont*derx_turn(ll,2,2)
9016 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9017 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9018 & +ekont*derx_turn(ll,4,2)
9019 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9020 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9021 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9026 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9031 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9037 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9042 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9046 cd write (2,*) iii,g_corr6_loc(iii)
9048 eello_turn6=ekont*eel_turn6
9049 cd write (2,*) 'ekont',ekont
9050 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9054 C-----------------------------------------------------------------------------
9055 double precision function scalar(u,v)
9056 !DIR$ INLINEALWAYS scalar
9058 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9061 double precision u(3),v(3)
9062 cd double precision sc
9070 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9073 crc-------------------------------------------------
9074 SUBROUTINE MATVEC2(A1,V1,V2)
9075 !DIR$ INLINEALWAYS MATVEC2
9077 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9079 implicit real*8 (a-h,o-z)
9080 include 'DIMENSIONS'
9081 DIMENSION A1(2,2),V1(2),V2(2)
9085 c 3 VI=VI+A1(I,K)*V1(K)
9089 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9090 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9095 C---------------------------------------
9096 SUBROUTINE MATMAT2(A1,A2,A3)
9098 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9100 implicit real*8 (a-h,o-z)
9101 include 'DIMENSIONS'
9102 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9103 c DIMENSION AI3(2,2)
9107 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9113 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9114 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9115 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9116 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9124 c-------------------------------------------------------------------------
9125 double precision function scalar2(u,v)
9126 !DIR$ INLINEALWAYS scalar2
9128 double precision u(2),v(2)
9131 scalar2=u(1)*v(1)+u(2)*v(2)
9135 C-----------------------------------------------------------------------------
9137 subroutine transpose2(a,at)
9138 !DIR$ INLINEALWAYS transpose2
9140 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9143 double precision a(2,2),at(2,2)
9150 c--------------------------------------------------------------------------
9151 subroutine transpose(n,a,at)
9154 double precision a(n,n),at(n,n)
9162 C---------------------------------------------------------------------------
9163 subroutine prodmat3(a1,a2,kk,transp,prod)
9164 !DIR$ INLINEALWAYS prodmat3
9166 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9170 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9172 crc double precision auxmat(2,2),prod_(2,2)
9175 crc call transpose2(kk(1,1),auxmat(1,1))
9176 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9177 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9179 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9180 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9181 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9182 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9183 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9184 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9185 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9186 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9189 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9190 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9192 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9193 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9194 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9195 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9196 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9197 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9198 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9199 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9202 c call transpose2(a2(1,1),a2t(1,1))
9205 crc print *,((prod_(i,j),i=1,2),j=1,2)
9206 crc print *,((prod(i,j),i=1,2),j=1,2)